home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d3xx / d386 / xlispstat.lha / XLispStat / src3.lzh / Mac / macstuff.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-07-30  |  11.3 KB  |  555 lines
  1. /* macstuff.c - macintosh interface routines for xlisp-stat */
  2.  
  3. #ifdef MPWC
  4. # include <Windows.h>    /* pulls in MacTypes, QuickDraw.h */
  5. # include <Events.h>
  6. # include <Menus.h>
  7. # include <Files.h>
  8. # include <ToolUtils.h>
  9. # include <TextEdit.h>
  10. # include <OSUtils.h>
  11. # include <Memory.h>
  12. # include <OSEvents.h>
  13. # include <Fonts.h>
  14. # include <SegLoad.h>
  15. # include <SysEqu.h>
  16. # include "xmath.h"
  17. # include "xlisp.h"
  18. # include "version.h"
  19. # define arrow qd.arrow
  20. # define RETURNCHAR '\n'
  21. # ifdef mc68881
  22. #  ifndef _MC68881_
  23. #   define _MC68881_
  24. #  endif _MC68881_
  25. # else
  26. #  ifdef _MC68881_
  27. #   undef _MC68881_
  28. #  endif _MC68881_
  29. # endif mc68881
  30. #else
  31. # include <WindowMgr.h>    /* pulls in MacTypes, QuickDraw.h */
  32. # include <EventMgr.h>
  33. # include <MenuMgr.h>
  34. # include <ToolBoxUtil.h>
  35. # include <OSUtil.h>
  36. # include "xmath.h"
  37. # include "xlisp.h"
  38. # include <unix.h>
  39. # include "version.h"
  40. # define RETURNCHAR '\r'
  41. #endif MPWC
  42.  
  43. # define TTYRETURN TtyPutc(RETURNCHAR);
  44.  
  45. # include "TransEdit.h"
  46.  
  47.  
  48. /* resource numbers */
  49. # define    ttyWindRes        1001
  50. # define GC_CURS_RES 1800
  51.  
  52. /* external variables */
  53. extern FILE *tfp;
  54. extern int xldebug;
  55. extern LVAL xlenv, xlfenv, s_input_stream;
  56. extern int in_send;
  57. extern long time_stamp;
  58.  
  59. /* external functions */
  60. extern int getttyline();
  61. extern unsigned long time();
  62. extern char buf[];
  63.  
  64. /* forward declarations */
  65. static background_tasks();
  66. #ifdef DODO
  67. static event_hook();
  68. #endif DODO
  69.  
  70. /* local variables */
  71. WindowPtr    ttyWind;
  72. static LVAL input_stream;
  73.  
  74. osinit(name)
  75.   char *name;
  76. {
  77.   long size;
  78.   
  79.   if (GetApplLimit() - GetZone() < 1200000)
  80.     SetApplLimit(GetApplLimit() - 2048);
  81.   else
  82.     SetApplLimit(GetApplLimit() - 32768);
  83.   
  84.   MaxApplZone();
  85.  
  86.   SkelInit ();
  87.  
  88. #ifdef THINK_C
  89.   Stdio_MacInit(true);
  90.   Click_On(false);
  91. #endif THINK_C
  92.  
  93. #ifdef _MC68881_
  94.   check_MC68881();
  95. #endif _MC68881_
  96.   
  97.   get_default_volume();
  98.   
  99.   if (ttyWind == nil) {
  100.     Rect r;
  101.     SetRect(&r, 10, 40, 500, 320);
  102.     make_listener_window(r);
  103.   }
  104. #ifdef MPWC
  105.   MaxMem(&size);
  106.   unload_segments(TRUE);
  107.   MaxMem(&size);
  108. #endif MPWC
  109.   /*SkelEventHook(event_hook);*/
  110.   SkelBackground(background_tasks);
  111.   TtyPrint(name);
  112.   sprintf(buf, "XLISP-STAT version %s, Copyright (c) 1989, by Luke Tierney.",
  113.           XLISPSTAT_VERSION);
  114.   TTYRETURN
  115.   TtyPrint(buf);
  116.   TTYRETURN
  117.   TtyPrint("Several files will be loaded; this may take a few minutes.");
  118.   TTYRETURN
  119.   TTYRETURN
  120.   TTYRETURN
  121. }
  122.  
  123. osfinish()
  124. {
  125.   while(! ClobberEWindows())    /* deal with any open edit windows */
  126.     SysBeep(10);
  127.   SkelClobber ();                /* throw away windows and menus */
  128. }
  129.  
  130. oserror(msg)
  131. {
  132.   char line[100],*p;
  133.   sprintf(line,"error: %s\n",msg);
  134.   for (p = line; *p != '\0'; ++p)
  135.   ostputc(*p);
  136. }
  137.  
  138. FILE *osaopen(name,mode)
  139.   char *name,*mode;
  140. {
  141. #ifdef MPWC
  142.   short vref;
  143.   
  144.   if (mode[0] == 'w' || mode[0] == 'a') {
  145.     /*** this may need to be cleaned up to catch errors and handle append mode ***/
  146.     GetVol(buf, &vref);
  147.     CtoPstr(name);
  148.     Create(name, vref, '????', 'TEXT');
  149.     PtoCstr(name);
  150.   }
  151. #endif
  152.   return (fopen(name,mode));
  153. }
  154.  
  155. FILE *osbopen(name,mode)
  156.   char *name,*mode;
  157. {
  158.   char nmode[4];
  159.   strcpy(nmode,mode); strcat(nmode,"b");
  160.   return (fopen(name,nmode));
  161. }
  162.  
  163. int osclose(fp)
  164.   FILE *fp;
  165. {
  166.   return (fclose(fp));
  167. }
  168.  
  169. int osagetc(fp)
  170.   FILE *fp;
  171. {
  172.   return (getc(fp));
  173. }
  174.  
  175. int osbgetc(fp)
  176.   FILE *fp;
  177. {
  178.   return (getc(fp));
  179. }
  180.  
  181. int osaputc(ch,fp)
  182.   int ch; FILE *fp;
  183. {
  184.   return (putc(ch,fp));
  185. }
  186.  
  187. int osbputc(ch,fp)
  188.   int ch; FILE *fp;
  189. {
  190.   return (putc(ch,fp));
  191. }
  192.  
  193. int ostgetc()
  194. {
  195.   int ch;
  196.  
  197.   while (! ustreamp(input_stream) || (ch = xlgetc(input_stream)) == EOF)
  198.     waitforline();
  199.   if (tfp) osaputc(ch, tfp);
  200.   return (filter_char(ch));
  201. }
  202.  
  203. filter_char(c)
  204.     int c;
  205. {
  206. #ifndef MPWC
  207.   if (c == '\r') c = '\n';
  208. #endif MPWC
  209.   return(c);
  210. }
  211.  
  212. int ostputc(ch)
  213.   int ch;
  214. {
  215. #ifndef MPWC
  216.   ch = (ch == '\n') ? '\r' : ch;;
  217. #endif MPWC
  218.   if (tfp) osaputc(ch, tfp);
  219.   TtyPutc(ch);
  220.   return (1);
  221. }
  222.  
  223. /* oscheck - check for control characters during execution */
  224. /* command-period is the interrupt for the mac             */
  225. oscheck()
  226. {
  227.   EventRecord theEvent;
  228.   char c;
  229.   static EventRecord lastEvent;
  230.   
  231.   if (EventAvail(autoKeyMask, &theEvent))
  232.     if (theEvent.when == lastEvent.when) {
  233.       GetNextEvent(autoKeyMask, &theEvent);
  234.       c = theEvent.message & charCodeMask;
  235.       if ((theEvent.modifiers & cmdKey) && (c == '.')) {
  236.         FlushEvents (everyEvent - diskMask, 0 );      
  237.         xltoplevel();
  238.       }
  239.     }
  240.   else lastEvent = theEvent;
  241. }
  242.  
  243. /* osflush - flush the input line buffer */
  244. osflush()
  245. {
  246.   ostputc(RETURNCHAR);
  247.   while (ustreamp(input_stream) && xlgetc(input_stream) != EOF)
  248.     ;
  249. }
  250.  
  251. ossymbols()
  252. {
  253.   statsymbols();
  254. }
  255.  
  256. osfinit()
  257. {
  258.   statfinit();
  259.   warn_low_memory(250000);
  260. }
  261.  
  262. osreset()
  263. {
  264.   in_send = FALSE;
  265.   StGWResetBuffer();
  266. }
  267.  
  268. /*
  269.   Show a window if it's not visible.  Select the window FIRST, then
  270.   show it, so that it comes up in front.  Otherwise it will be drawn
  271.   in back then brought to the front, which is ugly.
  272. */
  273.  
  274. MyShowWindow (wind)
  275.   WindowPeek wind;
  276. {
  277.   SelectWindow ((WindowPtr) wind);
  278.   ShowWindow ((WindowPtr) wind);
  279. }
  280.  
  281. waitforline()
  282. {
  283.   SkelMain ();
  284.   unload_segments(FALSE);
  285. }
  286.     
  287. getttyline(s)
  288.     LVAL s;
  289. {
  290.   input_stream = getvalue(s_input_stream);
  291.   SkelWhoa();
  292. }
  293.  
  294. static background_tasks()
  295. {
  296.   LVAL task, queue, oldenv, oldfenv;
  297.     
  298.   queue = getvalue(xlenter("*EVENT-QUEUE*"));
  299.   if (consp(queue)) {
  300.   
  301.     /* set the lexical environment to null */
  302.     xlstkcheck(2);
  303.     xlsave(oldenv);
  304.     xlsave(oldfenv);
  305.     oldenv = xlenv; xlenv = NIL;
  306.     oldfenv = xlfenv; xlfenv = NIL;
  307.  
  308.     task = car(queue);
  309.       setvalue(xlenter("*EVENT-QUEUE*"), cdr(queue));
  310.       xleval(task);
  311.  
  312.     /* reset the environment */
  313.     xlenv = oldenv;
  314.     xlfenv = oldfenv;
  315.     xlpopn(2);
  316.   }
  317.   unload_segments(FALSE);
  318. }
  319.  
  320. set_gc_cursor(on)
  321.     int on;
  322. {
  323.   static Cursor;
  324.   CursHandle c;
  325.   
  326.   if (on && (c = GetCursor(GC_CURS_RES)) != NIL) SetCursor(*c);
  327.   else {
  328.     SetCursor(&arrow);
  329.     oscheck();
  330.     warn_low_memory(75000);
  331.   }
  332. }
  333.  
  334. #ifdef OPTIMIZE
  335. extern xsbracket_search();                /* optimize.c */
  336. #endif OPTIMIZE
  337. extern init_objects();                    /* objectinit.c */
  338. extern ivector();                         /* linalg.c */
  339. extern crludcmp();                        /* ludecomp.c */
  340. extern choldecomp();                      /* cholesky.c */
  341. extern qrdecomp();                        /* qrdecomp.c */
  342. extern svdcmp();                          /* svdecomp.c */
  343. extern iview_hist_allocate();             /* xshistogram.c */
  344. extern iview_list_allocate();             /* xsnamelist.c */
  345. extern iview_scatmat_allocate();          /* xsscatmat.c */
  346. extern iview_spin_allocate();             /* xsspin.c */
  347. extern GetDialogItemData();               /* dialogs1.c */
  348. extern doDialog();                        /* dialogs2.c */
  349. extern check_point_list();                /* dialogs3.c */
  350. extern xsmenu_isnew();                    /* menus.c */
  351. extern matrixp();                         /* matrices1.c */
  352. extern xsmakesweepmatrix();               /* matrices2.c */
  353. extern xsrbinomialcdf();                  /* ddistributions.c */
  354. extern xsrnormalcdf();                    /* distributions.c */
  355. extern betabase();                        /* betabase.c */
  356. extern xlinit();                          /* xlinit.c */
  357. extern iview_plot2d_add_points();         /* xsscatterplot.c */
  358. /*extern atof(); */                           /* unix library */
  359. extern numergrad();                       /* derivatives.c */
  360. extern evalfront();                       /* functions.c */
  361. extern lowess();                          /* lowess.c */
  362. extern xscall_cfun();                     /* macdynload.c */
  363. extern cfft();                            /* cfft.c */
  364.  
  365. static unload_segments(initial)
  366.     int initial;
  367. {
  368.   if (xldebug != 0) return;
  369. #ifdef MPWC
  370.   if (! (initial && is_small_machine()) && (FreeMem() > 200000)) return;
  371. #else
  372.   if (FreeMem() > 200000) return;
  373. #endif MPWC
  374.   if (in_send) return;
  375.  
  376. #ifdef THINK_C
  377. #ifdef _MC68881_
  378.   UnloadSeg(_exp);
  379. #else
  380.   UnloadSeg(exp);
  381. #endif
  382. #ifdef OPTIMIZE
  383.   UnloadSeg(xsbracket_search);
  384. #endif OPTIMIZE
  385.   UnloadSeg(init_objects);
  386.   UnloadSeg(ivector);
  387.   UnloadSeg(crludcmp);
  388.   UnloadSeg(choldecomp);
  389.   UnloadSeg(qrdecomp);
  390.   UnloadSeg(svdcmp);
  391.   UnloadSeg(iview_hist_allocate);
  392.   UnloadSeg(iview_list_allocate);
  393.   UnloadSeg(iview_scatmat_allocate);
  394.   UnloadSeg(iview_spin_allocate);
  395.   UnloadSeg(GetDialogItemData);
  396.   UnloadSeg(doDialog);
  397.   UnloadSeg(check_point_list);
  398.   UnloadSeg(xsmenu_isnew);
  399.   UnloadSeg(matrixp);
  400.   UnloadSeg(xsmakesweepmatrix);
  401.   UnloadSeg(xsrbinomialcdf);
  402.   UnloadSeg(xsrnormalcdf);
  403.   UnloadSeg(betabase);
  404.   UnloadSeg(xlinit);
  405.   UnloadSeg(iview_plot2d_add_points);
  406.   UnloadSeg(atof);
  407.   UnloadSeg(Stdio_MacInit);
  408.   UnloadSeg(numergrad);
  409.   UnloadSeg(evalfront);
  410.   UnloadSeg(xscall_cfun);
  411.   UnloadSeg(cfft);
  412. #endif THINK_C
  413. #ifdef MPWC
  414.   UnloadSeg(init_objects);
  415.   UnloadSeg(ivector);
  416.   UnloadSeg(crludcmp);
  417.   UnloadSeg(choldecomp);
  418.   UnloadSeg(qrdecomp);
  419.   UnloadSeg(svdcmp);
  420.   UnloadSeg(iview_hist_allocate);
  421.   UnloadSeg(iview_list_allocate);
  422.   UnloadSeg(iview_scatmat_allocate);
  423.   UnloadSeg(iview_spin_allocate);
  424.   UnloadSeg(GetDialogItemData);
  425.   UnloadSeg(doDialog);
  426.   UnloadSeg(check_point_list);
  427.   UnloadSeg(xsmenu_isnew);
  428.   UnloadSeg(matrixp);
  429.   UnloadSeg(xsmakesweepmatrix);
  430.   UnloadSeg(xsrbinomialcdf);
  431.   UnloadSeg(xsrnormalcdf);
  432.   UnloadSeg(betabase);
  433.   if (! initial) UnloadSeg(xlinit);
  434.   UnloadSeg(iview_plot2d_add_points);
  435.   UnloadSeg(numergrad);
  436.   UnloadSeg(evalfront);
  437.   UnloadSeg(lowess);
  438.   UnloadSeg(xscall_cfun);
  439.   UnloadSeg(cfft);
  440. #endif MPWC
  441. }
  442.  
  443. #ifdef DODO
  444. static event_hook(theEvent)
  445.     EventRecord    *theEvent;
  446. {
  447.   GrafPtr port;
  448.   
  449.   switch(theEvent->what) {
  450.   case mouseDown: 
  451.     if (FindWindow (theEvent->where, &port) == inMenuBar) unload_segments(FALSE);
  452.     break;
  453.   case keyDown:
  454.   case autoKey:
  455.     if (theEvent->modifiers & cmdKey) unload_segments(FALSE);
  456.     break;
  457.   }
  458.   return(FALSE);
  459. }
  460. #endif DODO
  461.  
  462. max(x, y)
  463.     int x, y;
  464. {
  465.   return((x > y) ? x : y);
  466. }
  467.  
  468. min(x, y)
  469.     int x, y;
  470. {
  471.   return((x < y) ? x : y);
  472. }
  473.  
  474. is_small_machine() { return(FreeMem() < 600000); }
  475.  
  476. #define TIMEGAP 120L
  477. #ifdef MPWC
  478. #define WARNSTRING "\pMemory is down to %ldK. \nClose plots and \"undef\" variables."
  479. #else
  480. #define WARNSTRING "\pMemory is down to %ldK. \rClose plots and \"undef\" variables."
  481. #endif MPWC
  482. unsigned long time();
  483.  
  484. static warn_low_memory(space)
  485.     long space;
  486. {
  487.   char s[100];
  488.   unsigned long tm;
  489.   static unsigned long old_tm = 0L;
  490.   static int inited = FALSE;
  491.   long free;
  492.   
  493.   if (FreeMem() < space) {
  494.     MaxMem(&free);
  495.     free = FreeMem();
  496.     if (free < space) {
  497.       tm = time((unsigned long *) NULL);
  498.       if (! inited || tm > old_tm + TIMEGAP) {
  499.         old_tm = tm;
  500.         sprintf(s, WARNSTRING, free / 1000);
  501.         (void) FakeAlert (s, "\p", "\p", "\p", 1, 1, "\pOK", "\p", "\p");
  502.       }
  503.       inited = TRUE;
  504.     }
  505.   }
  506. }
  507.  
  508. maximum_memory()
  509. {
  510.   long size;
  511.   MaxMem(&size);
  512. }
  513.  
  514. #ifdef _MC68881_
  515. static check_MC68881()
  516. {
  517.   SysEnvRec r;
  518.  
  519.   SysEnvirons(1, &r);
  520.   if (! r.hasFPU) {
  521.     FakeAlert ("\pThis version requres the MC68881", "\p", "\p", "\p",
  522.                1, 1, "\pOK", "\p", "\p");
  523.     exit();
  524.   }
  525. }
  526. #endif _MC68881_
  527.  
  528. unsigned long ticks_per_second() { return((unsigned long) 60); }
  529.  
  530. unsigned long run_tick_count()
  531. {
  532.   return((unsigned long) TickCount());
  533. }
  534.  
  535. unsigned long real_tick_count() 
  536. {
  537.   return((unsigned long) (60 * (time((unsigned long *) NULL) - time_stamp)));
  538. }
  539.  
  540. /* thee ought to be a sensible way to do this, but I can't figure it out yet */
  541. get_directory(s)
  542.     char *s;
  543. {
  544.   strcpy(s, "");
  545. }
  546.  
  547. #ifdef MPWC
  548. #undef SysBeep
  549. SYSBEEPMPW(x)
  550.     int x;
  551. {
  552.   SysBeep(x);
  553. }
  554. #endif MPWC
  555.