home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / xlisp_21 / xlisp.mac < prev    next >
Text File  |  1993-10-23  |  27KB  |  1,392 lines
  1. From sce!mitel!uunet!datapg!com50!pai!erc Tue Nov 14 08:51:33 EST 1989
  2. Article: 753 of comp.lang.scheme
  3. Path: cognos!sce!mitel!uunet!datapg!com50!pai!erc
  4. From: erc@pai.UUCP (Eric Johnson)
  5. Newsgroups: comp.lang.scheme,comp.sys.mac
  6. Subject: Re: How to build xscheme for the mac
  7. Summary: Hope this helps...
  8. Keywords: xscheme, mac
  9. Message-ID: <742@pai.UUCP>
  10. Date: 11 Nov 89 18:55:05 GMT
  11. References: <2091@cunixc.cc.columbia.edu>
  12. Organization: Prime Automation, Inc., Burnsville, MN
  13. Lines: 1374
  14. Xref: cognos comp.lang.scheme:753 comp.sys.mac:33459
  15.  
  16. In article <2091@cunixc.cc.columbia.edu>, puglia@cunixc.cc.columbia.edu (Paul Puglia) writes:
  17. > How does you build xscheme on a macintosh ? I have a copy of 
  18. > the xscheme sources compiles fine on a unix machine, and works
  19. > great on a pc with turbo c.  When I tried to compile it on a 
  20. > friends mac II using his copy of lightspeed c. I have no luck. 
  21. > Could someone please describe the procedure to compile this program, and
  22. > comment on if anything else is need to compile xscheme. I know that you 
  23. > need some resource to compile xlisp on a mac. Do you need the same sort of 
  24. > stuff for xscheme
  25. > Thanks in advance
  26. > Paul Puglia
  27. > Dept of Civil Engineering 
  28. > Columbia University
  29.  
  30.  
  31.  
  32. Porting Xlisp/XScheme:
  33.  
  34. Awhile back, while I was taking an AI course, I was spending a lot of time
  35. trekking to campus and using their LISP system.  To avoid travel time (and
  36. to work on LISP at any hour I wanted), I got into porting XLisp. In looking at 
  37. the code, I'd say XLisp and XScheme are two of the most portable C programs
  38. I have ever seen.  Now, I've spent most of my time on XLisp, so your
  39. mileage may vary, but...
  40.  
  41. XLisp seems to place most Operating System (OS)-dependent features in 
  42. separate files, named dosstuff.c, osptrs.h, osdefs.h.  On UNIX, the "stuff:
  43. file is called unixstuf.c and on the Mac its called macstuff.c (all file
  44. names are <= 8 chars for MS-DOS).  The mac version also has a resource
  45. compiler file (that is, a file you run through the resource compiler to
  46. generate a resource file).
  47.  
  48. I assume (hope) XScheme is similiar.  Below, I placed all my Mac-related
  49. files from XLisp (2.0, I think).  The XScheme stuff should be similiar.
  50. I hope these help.  (Note: I don't have the full sources around now, just
  51. the Mac and UNIX-specific files.)  (Note2: Two extra files, macfun.c and
  52. macinit.c are below, its been so long that I'm not sure if these are extras
  53. or necessary--Sorry.)
  54.  
  55. I'm placing these files here in hopes they can help you with your porting.  I
  56. do know that binary executable versions of XScheme are available on the
  57. BIX bulletin board (Byte magazine Information eXchange)--see Byte mag
  58. for details.  Getting the binaries would solve all the Mac porting
  59. problems in one fell swoop.
  60.  
  61. Anyway, hope this helps,
  62. -Eric
  63.  
  64.  
  65. ======================== macfun.c =============================================
  66.  
  67. /* macfun.c - macintosh user interface functions for xlisp */
  68.  
  69. #include <Quickdraw.h>
  70. #include <WindowMgr.h>
  71. #include <MemoryMgr.h>
  72. #include "xlisp.h"
  73.  
  74. /* external variables */
  75. extern GrafPtr cwindow,gwindow;
  76.  
  77. /* forward declarations */
  78. FORWARD LVAL do_0();
  79. FORWARD LVAL do_1();
  80. FORWARD LVAL do_2();
  81.  
  82. /* xptsize - set the command window point size */
  83. LVAL xptsize()
  84. {
  85.     LVAL val;
  86.     val = xlgafixnum();
  87.     xllastarg();
  88.     TextSize((int)getfixnum(val));
  89.     InvalRect(&cwindow->portRect);
  90.     SetupScreen();
  91.     return (NIL);
  92. }
  93.  
  94. /* xhidepen - hide the pen */
  95. LVAL xhidepen()
  96. {
  97.     return (do_0('H'));
  98. }
  99.  
  100. /* xshowpen - show the pen */
  101. LVAL xshowpen()
  102. {
  103.     return (do_0('S'));
  104. }
  105.  
  106. /* xgetpen - get the pen position */
  107. LVAL xgetpen()
  108. {
  109.     LVAL val;
  110.     Point p;
  111.     xllastarg();
  112.     SetPort(gwindow);
  113.     GetPen(&p);
  114.     SetPort(cwindow);
  115.     xlsave1(val);
  116.     val = consa(NIL);
  117.     rplaca(val,cvfixnum((FIXTYPE)p.h));
  118.     rplacd(val,cvfixnum((FIXTYPE)p.v));
  119.     xlpop();
  120.     return (val);
  121. }
  122.  
  123. /* xpenmode - set the pen mode */
  124. LVAL xpenmode()
  125. {
  126.     return (do_1('M'));
  127. }
  128.  
  129. /* xpensize - set the pen size */
  130. LVAL xpensize()
  131. {
  132.     return (do_2('S'));
  133. }
  134.  
  135. /* xpenpat - set the pen pattern */
  136. LVAL xpenpat()
  137. {
  138.     LVAL plist;
  139.     char pat[8],i;
  140.     plist = xlgalist();
  141.     xllastarg();
  142.     for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
  143.     if (fixp(car(plist)))
  144.         pat[i] = getfixnum(car(plist));
  145.     SetPort(gwindow);
  146.     PenPat(pat);
  147.     SetPort(cwindow);
  148.     return (NIL);
  149. }
  150.  
  151. /* xpennormal - set the pen to normal */
  152. LVAL xpennormal()
  153. {
  154.     xllastarg();
  155.     SetPort(gwindow);
  156.     PenNormal();
  157.     SetPort(cwindow);
  158.     return (NIL);
  159. }
  160.  
  161. /* xmoveto - Move to a screen location */
  162. LVAL xmoveto()
  163. {
  164.     return (do_2('m'));
  165. }
  166.  
  167. /* xmove - Move in a specified direction */
  168. LVAL xmove()
  169. {
  170.     return (do_2('M'));
  171. }
  172.  
  173. /* xlineto - draw a Line to a screen location */
  174. LVAL xlineto()
  175. {
  176.     return (do_2('l'));
  177. }
  178.  
  179. /* xline - draw a Line in a specified direction */
  180. LVAL xline()
  181. {
  182.     return (do_2('L'));
  183. }
  184.  
  185. /* xshowgraphics - show the graphics window */
  186. LVAL xshowgraphics()
  187. {
  188.     xllastarg();
  189.     scrsplit(1);
  190.     return (NIL);
  191. }
  192.  
  193. /* xhidegraphics - hide the graphics window */
  194. LVAL xhidegraphics()
  195. {
  196.     xllastarg();
  197.     scrsplit(0);
  198.     return (NIL);
  199. }
  200.  
  201. /* xcleargraphics - clear the graphics window */
  202. LVAL xcleargraphics()
  203. {
  204.     xllastarg();
  205.     SetPort(gwindow);
  206.     EraseRect(&gwindow->portRect);
  207.     SetPort(cwindow);
  208.     return (NIL);
  209. }
  210.  
  211. /* do_0 - Handle commands that require no arguments */
  212. LOCAL LVAL do_0(fcn)
  213.   int fcn;
  214. {
  215.     xllastarg();
  216.     SetPort(gwindow);
  217.     switch (fcn) {
  218.     case 'H':    HidePen(); break;
  219.     case 'S':    ShowPen(); break;
  220.     }
  221.     SetPort(cwindow);
  222.     return (NIL);
  223. }
  224.  
  225. /* do_1 - Handle commands that require one integer argument */
  226. LOCAL LVAL do_1(fcn)
  227.   int fcn;
  228. {
  229.     int x;
  230.     x = getnumber();
  231.     xllastarg();
  232.     SetPort(gwindow);
  233.     switch (fcn) {
  234.     case 'M':    PenMode(x); break;
  235.     }
  236.     SetPort(cwindow);
  237.     return (NIL);
  238. }
  239.  
  240. /* do_2 - Handle commands that require two integer arguments */
  241. LOCAL LVAL do_2(fcn)
  242.   int fcn;
  243. {
  244.     int h,v;
  245.     h = getnumber();
  246.     v = getnumber();
  247.     xllastarg();
  248.     SetPort(gwindow);
  249.     switch (fcn) {
  250.     case 'l':    LineTo(h,v); break;
  251.     case 'L':    Line(h,v);   break;
  252.     case 'm':   MoveTo(h,v); break;
  253.     case 'M':    Move(h,v);   break;
  254.     case 'S':    PenSize(h,v);break;
  255.     }
  256.     SetPort(cwindow);
  257.     return (NIL);
  258. }
  259.  
  260. /* getnumber - get an integer parameter */
  261. LOCAL int getnumber()
  262. {
  263.     LVAL num;
  264.     num = xlgafixnum();
  265.     return ((int)getfixnum(num));
  266. }
  267.  
  268. /* xtool - call the toolbox */
  269. LVAL xtool()
  270. {
  271.     LVAL val;
  272.     int trap;
  273.  
  274.     trap = getnumber();
  275. /*
  276.  
  277.     asm {
  278.     move.l    args(A6),D0
  279.     beq    L2
  280. L1:    move.l    D0,A0
  281.     move.l    2(A0),A1
  282.     move.w    4(A1),-(A7)
  283.     move.l    6(A0),D0
  284.     bne    L1
  285. L2:    lea    L3,A0
  286.     move.w    trap(A6),(A0)
  287. L3:    dc.w    0xA000
  288.     clr.l    val(A6)
  289.     }
  290. */
  291.  
  292.     return (val);
  293. }
  294.  
  295. /* xtool16 - call the toolbox with a 16 bit result */
  296. LVAL xtool16()
  297. {
  298.     int trap,val;
  299.  
  300.     trap = getnumber();
  301. /*
  302.  
  303.     asm {
  304.     clr.w    -(A7)
  305.     move.l    args(A6),D0
  306.     beq    L2
  307. L1:    move.l    D0,A0
  308.     move.l    2(A0),A1
  309.     move.w    4(A1),-(A7)
  310.     move.l    6(A0),D0
  311.     bne    L1
  312. L2:    lea    L3,A0
  313.     move.w    trap(A6),(A0)
  314. L3:    dc.w    0xA000
  315.     move.w    (A7)+,val(A6)
  316.     }
  317. */
  318.  
  319.     return (cvfixnum((FIXTYPE)val));
  320. }
  321.  
  322. /* xtool32 - call the toolbox with a 32 bit result */
  323. LVAL xtool32()
  324. {
  325.     int trap;
  326.     long val;
  327.  
  328.     trap = getnumber();
  329. /*
  330.  
  331.     asm {
  332.     clr.l    -(A7)
  333.     move.l    args(A6),D0
  334.     beq    L2
  335. L1:    move.l    D0,A0
  336.     move.l    2(A0),A1
  337.     move.w    4(A1),-(A7)
  338.     move.l    6(A0),D0
  339.     bne    L1
  340. L2:    lea    L3,A0
  341.     move.w    trap(A6),(A0)
  342. L3:    dc.w    0xA000
  343.     move.l    (A7)+,val(A6)
  344.     }
  345. */
  346.  
  347.     return (cvfixnum((FIXTYPE)val));
  348. }
  349.  
  350. /* xnewhandle - allocate a new handle */
  351. LVAL xnewhandle()
  352. {
  353.     LVAL num;
  354.     long size;
  355.     num = xlgafixnum(); size = getfixnum(num);
  356.     xllastarg();
  357.     return (cvfixnum((FIXTYPE)NewHandle(size)));
  358. }
  359.  
  360. /* xnewptr - allocate memory */
  361. LVAL xnewptr()
  362. {
  363.     LVAL num;
  364.     long size;
  365.     num = xlgafixnum(); size = getfixnum(num);
  366.     xllastarg();
  367.     return (cvfixnum((FIXTYPE)NewPtr(size)));
  368. }
  369.     
  370. /* xhiword - return the high order 16 bits of an integer */
  371. LVAL xhiword()
  372. {
  373.     unsigned int val;
  374.     val = (unsigned int)(getnumber() >> 16);
  375.     xllastarg();
  376.     return (cvfixnum((FIXTYPE)val));
  377. }
  378.  
  379. /* xloword - return the low order 16 bits of an integer */
  380. LVAL xloword()
  381. {
  382.     unsigned int val;
  383.     val = (unsigned int)getnumber();
  384.     xllastarg();
  385.     return (cvfixnum((FIXTYPE)val));
  386. }
  387.  
  388. /* xrdnohang - get the next character in the look-ahead buffer */
  389. LVAL xrdnohang()
  390. {
  391.     int ch;
  392.     xllastarg();
  393.     if ((ch = scrnextc()) == EOF)
  394.     return (NIL);
  395.     return (cvfixnum((FIXTYPE)ch));
  396. }
  397.  
  398. /* ossymbols - enter important symbols */
  399. ossymbols()
  400. {
  401.     LVAL sym;
  402.  
  403.     /* setup globals for the window handles */
  404.     sym = xlenter("*COMMAND-WINDOW*");
  405.     setvalue(sym,cvfixnum((FIXTYPE)cwindow));
  406.     sym = xlenter("*GRAPHICS-WINDOW*");
  407.     setvalue(sym,cvfixnum((FIXTYPE)gwindow));
  408. }
  409.  
  410.  
  411. ======================== macint.c =============================================
  412.  
  413. /* macint.c - macintosh interface routines for xlisp */
  414.  
  415. #include <MacTypes.h>
  416. #include <Quickdraw.h>  
  417. #include <WindowMgr.h>
  418. #include <EventMgr.h>
  419. #include <DialogMgr.h>
  420. #include <MenuMgr.h>
  421. #include <PackageMgr.h>
  422. #include <StdFilePkg.h>
  423. #include <MemoryMgr.h>
  424. #include <DeskMgr.h>
  425. #include <FontMgr.h>
  426. #include <ControlMgr.h>
  427. #include <SegmentLdr.h>
  428. #include <FileMgr.h>
  429.  
  430. /* program limits */
  431. #define SCRH        40    /* maximum screen height */
  432. #define SCRW        100    /* maximum screen width */
  433. #define CHARMAX     100    /* maximum number of buffered characters */
  434. #define TIMEON        40    /* cursor on time */
  435. #define TIMEOFF        20    /* cursor off time */
  436.  
  437. /* useful definitions */
  438. #define MenuBarHeight    20
  439. #define TitleBarHeight    20
  440. #define SBarWidth    16
  441. #define MinWidth    80
  442. #define MinHeight    40
  443. #define ScreenMargin    2
  444. #define TextMargin    4
  445. #define GHeight        232
  446.  
  447. /* menu id's */
  448. #define appleID        1
  449. #define fileID        256
  450. #define editID        257
  451. #define controlID    258
  452.  
  453. /* externals */
  454. extern char *s_unbound;
  455. extern char *PtoCstr();
  456.  
  457. /* screen dimensions */
  458. int screenWidth;
  459. int screenHeight;
  460.  
  461. /* command window (normal screen) */
  462. int nHorizontal,nVertical,nWidth,nHeight;
  463.  
  464. /* command window (split screen) */
  465. int sHorizontal,sVertical,sWidth,sHeight;
  466.  
  467. /* graphics window */
  468. int gHorizontal,gVertical,gWidth,gHeight;
  469.  
  470. /* menu handles */
  471. MenuHandle appleMenu;
  472. MenuHandle fileMenu;
  473. MenuHandle editMenu;
  474. MenuHandle controlMenu;
  475.  
  476. /* misc variables */
  477. OSType filetypes[] = { 'TEXT' };
  478.  
  479. /* font information */
  480. int tmargin,lmargin;
  481. int xinc,yinc;
  482.  
  483. /* command window */
  484. WindowRecord cwrecord;
  485. WindowPtr cwindow;
  486.  
  487. /* graphics window */
  488. WindowRecord gwrecord;
  489. WindowPtr gwindow;
  490.  
  491. /* window mode */
  492. int splitmode;
  493.  
  494. /* cursor variables */
  495. long cursortime;
  496. int cursorstate;
  497. int x,y;
  498.  
  499. /* screen buffer */
  500. char screen[SCRH*SCRW],*topline,*curline;
  501. int scrh,scrw;
  502.  
  503. /* type ahead buffer */
  504. char charbuf[CHARMAX],*inptr,*outptr;
  505. int charcnt;
  506.  
  507. macinit()
  508. {
  509.     /* initialize the toolbox */
  510.     InitGraf(&thePort);
  511.     InitFonts();
  512.     InitWindows();
  513.     InitMenus();
  514.     TEInit();
  515.     InitDialogs(0L);
  516.     InitCursor();
  517.  
  518.     /* setup the menu bar */
  519.     SetupMenus();
  520.  
  521.     /* get the size of the screen */
  522.     screenWidth  = screenBits.bounds.right  - screenBits.bounds.left;
  523.     screenHeight = screenBits.bounds.bottom - screenBits.bounds.top;
  524.  
  525.     /* Create the graphics and control windows */
  526.     gwindow = GetNewWindow(129,&gwrecord,-1L);
  527.     cwindow = GetNewWindow(128,&cwrecord,-1L);
  528.  
  529.     /* establish the command window as the current port */
  530.     SetPort(cwindow);
  531.  
  532.     /* compute the size of the normal command window */
  533.     nHorizontal = ScreenMargin;
  534.     nVertical = MenuBarHeight + TitleBarHeight + ScreenMargin - 2;
  535.     nWidth = screenWidth - (ScreenMargin * 2) - 1;
  536.     nHeight = screenHeight - MenuBarHeight - TitleBarHeight - (ScreenMargin * 2);
  537.  
  538.     /* compute the size of the split command window */
  539.     sHorizontal = nHorizontal;
  540.     sVertical = nVertical + GHeight + 1;
  541.     sWidth = nWidth;
  542.     sHeight = nHeight - GHeight - 1;
  543.  
  544.     /* compute the size of the graphics window */
  545.     gHorizontal = nHorizontal;
  546.     gVertical = MenuBarHeight + ScreenMargin;
  547.     gWidth = screenWidth - (ScreenMargin * 2);
  548.     gHeight = GHeight;
  549.  
  550.     /* move and size the graphics window */
  551.     MoveWindow(gwindow,gHorizontal,gVertical,0);
  552.     SizeWindow(gwindow,gWidth,gHeight,0);
  553.  
  554.     /* setup the font, size and writing mode for the command window */
  555.     TextFont(monaco); TextSize(9); TextMode(srcCopy);
  556.  
  557.     /* setup command mode */
  558.     scrsplit(FALSE);
  559.  
  560.     /* disable the Cursor */
  561.     cursorstate = -1;
  562.  
  563.     /* setup the input ring buffer */
  564.     inptr = outptr = charbuf;
  565.     charcnt = 0;
  566.     
  567.     /* lock the font in memory */
  568.     SetFontLock(-1);
  569. }
  570.  
  571. SetupMenus()
  572. {
  573.     appleMenu = GetMenu(appleID);    /* setup the apple menu */
  574.     AddResMenu(appleMenu,'DRVR');
  575.     InsertMenu(appleMenu,0);
  576.     fileMenu = GetMenu(fileID);        /* setup the file menu */
  577.     InsertMenu(fileMenu,0);
  578.     editMenu = GetMenu(editID);        /* setup the edit menu */
  579.     InsertMenu(editMenu,0);
  580.     controlMenu = GetMenu(controlID);    /* setup the control menu */
  581.     InsertMenu(controlMenu,0);
  582.     DrawMenuBar();
  583. }
  584.  
  585. int scrgetc()
  586. {
  587.     CursorOn();
  588.     while (charcnt == 0)
  589.     DoEvent();
  590.     CursorOff();
  591.     return (scrnextc());
  592. }
  593.  
  594. int scrnextc()
  595. {
  596.     int ch;
  597.     if (charcnt > 0) {
  598.     ch = *outptr++; charcnt--;
  599.     if (outptr >= &charbuf[CHARMAX])
  600.         outptr = charbuf;
  601.     }
  602.     else {
  603.     charcnt = 0;
  604.     ch = -1;
  605.     }
  606.     return (ch);
  607. }
  608.  
  609. scrputc(ch)
  610.   int ch;
  611. {
  612.     switch (ch) {
  613.     case '\r':
  614.     x = 0;
  615.     break;
  616.     case '\n':
  617.     nextline(&curline);
  618.     if (++y >= scrh) {
  619.         y = scrh - 1;
  620.         scrollup();
  621.     }
  622.     break;
  623.     case '\t':
  624.     do { scrputc(' '); } while (x & 7);
  625.     break;
  626.     case '\010':
  627.     if (x) x--;
  628.     break;
  629.     default:
  630.     if (ch >= 0x20 && ch < 0x7F) {
  631.         scrposition(x,y);
  632.         DrawChar(ch);
  633.         curline[x] = ch;
  634.         if (++x >= scrw) {
  635.         nextline(&curline);
  636.         if (++y >= scrh) {
  637.             y = scrh - 1;
  638.             scrollup();
  639.         }
  640.         x = 0;
  641.         }
  642.     }
  643.     break;
  644.     }
  645. }
  646.  
  647. scrdelete()
  648. {
  649.     scrputc('\010');
  650.     scrputc(' ');
  651.     scrputc('\010');
  652. }
  653.  
  654. scrclear()
  655. {
  656.     curline = screen;
  657.     for (y = 0; y < SCRH; y++)
  658.     for (x = 0; x < SCRW; x++)
  659.         *curline++ = ' ';
  660.     topline = curline = screen;
  661.     x = y = 0;
  662. }
  663.  
  664. scrflush()
  665. {
  666.     inptr = outptr = charbuf;
  667.     charcnt = -1;
  668.     osflush();
  669. }
  670.  
  671. scrposition(x,y)
  672.   int x,y;
  673. {
  674.     MoveTo((x * xinc) + lmargin,(y * yinc) + tmargin);
  675. }
  676.  
  677. DoEvent()
  678. {
  679.     EventRecord myEvent;
  680.     
  681.     SystemTask();
  682.     CursorUpdate();
  683.  
  684.     while (GetNextEvent(everyEvent,&myEvent))
  685.     switch (myEvent.what) {
  686.         case mouseDown:
  687.         DoMouseDown(&myEvent);
  688.         break;
  689.         case keyDown:
  690.         case autoKey:
  691.         DoKeyPress(&myEvent);
  692.         break;
  693.         case activateEvt:
  694.         DoActivate(&myEvent);
  695.         break;
  696.         case updateEvt:
  697.         DoUpdate(&myEvent);
  698.         break;
  699.         }
  700. }
  701.  
  702. DoMouseDown(myEvent)
  703.   EventRecord *myEvent;
  704. {
  705.     WindowPtr whichWindow;
  706.  
  707.     switch (FindWindow(myEvent->where,&whichWindow)) {
  708.     case inMenuBar:
  709.     DoMenuClick(myEvent);
  710.     break;
  711.     case inSysWindow:
  712.     SystemClick(myEvent,whichWindow);
  713.     break;
  714.     case inDrag:
  715.     DoDrag(myEvent,whichWindow);
  716.     break;
  717.     case inGoAway:
  718.     DoGoAway(myEvent,whichWindow);
  719.     break;
  720.     case inGrow:
  721.     DoGrow(myEvent,whichWindow);
  722.     break;
  723.     case inContent:
  724.     DoContent(myEvent,whichWindow);
  725.     break;
  726.     }
  727. }
  728.  
  729. DoMenuClick(myEvent)
  730.   EventRecord *myEvent;
  731. {
  732.     long choice;
  733.     if (choice = MenuSelect(myEvent->where))
  734.     DoCommand(choice);
  735. }
  736.  
  737. DoDrag(myEvent,whichWindow)
  738.   EventRecord *myEvent;
  739.   WindowPtr whichWindow;
  740. {
  741.     Rect dragRect;
  742.     SetRect(&dragRect,0,MenuBarHeight,screenWidth,screenHeight);
  743.     InsetRect(&dragRect,ScreenMargin,ScreenMargin);
  744.     DragWindow(whichWindow,myEvent->where,&dragRect);
  745. }
  746.  
  747. DoGoAway(myEvent,whichWindow)
  748.   EventRecord *myEvent;
  749.   WindowPtr whichWindow;
  750. {
  751.     if (TrackGoAway(whichWindow,myEvent->where))
  752.     wrapup();
  753. }
  754.  
  755. DoGrow(myEvent,whichWindow)
  756.   EventRecord *myEvent;
  757.   WindowPtr whichWindow;
  758. {
  759.     Rect sizeRect;
  760.     long newSize;
  761.     if (whichWindow != FrontWindow() && whichWindow != gwindow)
  762.     SelectWindow(whichWindow);
  763.     else {
  764.     SetRect(&sizeRect,MinWidth,MinHeight,screenWidth,screenHeight-MenuBarHeight);
  765.     newSize = GrowWindow(whichWindow,myEvent->where,&sizeRect);
  766.     if (newSize) {
  767.         EraseRect(&whichWindow->portRect);
  768.         SizeWindow(whichWindow,LoWord(newSize),HiWord(newSize),-1);
  769.         InvalRect(&whichWindow->portRect);
  770.         SetupScreen();
  771.         scrflush();
  772.     }
  773.     }
  774. }
  775.  
  776. DoContent(myEvent,whichWindow)
  777.   EventRecord *myEvent;
  778.   WindowPtr whichWindow;
  779. {
  780.     if (whichWindow != FrontWindow() && whichWindow != gwindow)
  781.     SelectWindow(whichWindow);
  782. }
  783.  
  784. DoKeyPress(myEvent)
  785.   EventRecord *myEvent;
  786. {
  787.     long choice;
  788.     
  789.     if (FrontWindow() == cwindow) {
  790.     if (myEvent->modifiers & 0x100) {
  791.         if (choice = MenuKey((char)myEvent->message))
  792.         DoCommand(choice);
  793.     }
  794.     else {
  795.         if (charcnt < CHARMAX) {
  796.         *inptr++ = myEvent->message & 0xFF; charcnt++;
  797.         if (inptr >= &charbuf[CHARMAX])
  798.             inptr = charbuf;
  799.         }
  800.     }
  801.     }
  802. }
  803.  
  804. DoActivate(myEvent)
  805.   EventRecord *myEvent;
  806. {
  807.     WindowPtr whichWindow;
  808.     whichWindow = (WindowPtr)myEvent->message;
  809.     SetPort(whichWindow);
  810.     if (whichWindow == cwindow)
  811.     DrawGrowIcon(whichWindow);
  812. }
  813.  
  814. DoUpdate(myEvent)
  815.   EventRecord *myEvent;
  816. {
  817.     WindowPtr whichWindow;
  818.     GrafPtr savePort;
  819.     GetPort(&savePort);
  820.     whichWindow = (WindowPtr)myEvent->message;
  821.     SetPort(whichWindow);
  822.     BeginUpdate(whichWindow);
  823.     EraseRect(&whichWindow->portRect);
  824.     if (whichWindow == cwindow) {
  825.     DrawGrowIcon(whichWindow);
  826.     RedrawScreen();
  827.     }
  828.     EndUpdate(whichWindow);
  829.     SetPort(savePort);
  830. }
  831.  
  832. DoCommand(choice)
  833.   long choice;
  834. {
  835.     int theMenu,theItem;
  836.     
  837.     /* decode the menu choice */
  838.     theMenu = HiWord(choice);
  839.     theItem = LoWord(choice);
  840.     
  841.     CursorOff();
  842.     HiliteMenu(theMenu);
  843.     switch (theMenu) {
  844.     case appleID:
  845.     DoAppleMenu(theItem);
  846.     break;
  847.     case fileID:
  848.     DoFileMenu(theItem);
  849.     break;
  850.     case editID:
  851.     DoEditMenu(theItem);
  852.     break;
  853.     case controlID:
  854.     DoControlMenu(theItem);
  855.     break;
  856.     }
  857.     HiliteMenu(0);
  858.     CursorOn();
  859. }
  860.  
  861. pascal aboutfilter(theDialog,theEvent,itemHit)
  862.   DialogPtr theDialog; EventRecord *theEvent; int *itemHit;
  863. {
  864.     return (theEvent->what == mouseDown ? -1 : 0);
  865. }
  866.  
  867. DoAppleMenu(theItem)
  868.   int theItem;
  869. {
  870.     DialogRecord mydialog;
  871.     char name[256];
  872.     GrafPtr gp;
  873.     int n;
  874.  
  875.     switch (theItem) {
  876.     case 1:
  877.     GetNewDialog(129,&mydialog,-1L);
  878.     ModalDialog(aboutfilter,&n);
  879.     CloseDialog(&mydialog);
  880.     break;
  881.     default:
  882.     GetItem(appleMenu,theItem,name);
  883.     GetPort(&gp);
  884.     OpenDeskAcc(name);
  885.     SetPort(gp);
  886.     break;
  887.     }
  888. }
  889.  
  890. pascal int filefilter(pblock)
  891.   ParmBlkPtr pblock;
  892. {
  893.     unsigned char *p; int len;
  894.     p = pblock->fileParam.ioNamePtr; len = *p++ &0xFF;
  895.     return (len >= 4 && strncmp(p+len-4,".lsp",4) == 0 ? 0 : -1);
  896. }
  897.  
  898. DoFileMenu(theItem)
  899.   int theItem;
  900. {
  901.     SFReply loadfile;
  902.     Point p;
  903.  
  904.     switch (theItem) {
  905.     case 1:    /* load */
  906.     case 2:    /* load noisily */
  907.     p.h = 100; p.v = 100;
  908.     SFGetFile(p,"\P",filefilter,-1,filetypes,0L,&loadfile);
  909.     if (loadfile.good) {
  910.         HiliteMenu(0);
  911.         SetVol(0L,loadfile.vRefNum);
  912.         if (xlload(PtoCstr(loadfile.fName),1,(theItem == 1 ? 0 : 1)))
  913.         scrflush();
  914.         else
  915.         xlabort("load error");
  916.     }
  917.     break;
  918.     case 4:    /* quit */
  919.     wrapup();
  920.     }
  921. }
  922.  
  923. DoEditMenu(theItem)
  924.   int theItem;
  925. {
  926.     switch (theItem) {
  927.     case 1:    /* undo */
  928.     case 3:    /* cut */
  929.     case 4:    /* copy */
  930.     case 5:    /* paste */
  931.     case 6:    /* clear */
  932.     SystemEdit(theItem-1);
  933.     break;
  934.     }
  935. }
  936.  
  937. DoControlMenu(theItem)
  938.   int theItem;
  939. {
  940.     scrflush();
  941.     HiliteMenu(0);
  942.     switch (theItem) {
  943.     case 1:    /* break */
  944.     xlbreak("user break",s_unbound);
  945.     break;
  946.     case 2:    /* continue */
  947.     xlcontinue();
  948.     break;
  949.     case 3:    /* clean-up error */
  950.     xlcleanup();
  951.     break;
  952.     case 4:    /* Cancel input */
  953.     xlabort("input canceled");
  954.     break;
  955.     case 5:    /* Top Level */
  956.     xltoplevel();
  957.     break;
  958.     case 7:    /* split screen */
  959.     scrsplit(splitmode ? FALSE : TRUE);
  960.     break;
  961.     }
  962. }
  963.  
  964. scrsplit(split)
  965.   int split;
  966. {
  967.     ShowHide(cwindow,0);
  968.     if (split) {
  969.     CheckItem(controlMenu,7,-1);
  970.     ShowHide(gwindow,-1);
  971.     MoveWindow(cwindow,sHorizontal,sVertical,-1);
  972.     SizeWindow(cwindow,sWidth,sHeight,-1);
  973.     InvalRect(&cwindow->portRect);
  974.     SetupScreen();
  975.     }
  976.     else {
  977.     CheckItem(controlMenu,7,0);
  978.     ShowHide(gwindow,0);
  979.     MoveWindow(cwindow,nHorizontal,nVertical,-1);
  980.     SizeWindow(cwindow,nWidth,nHeight,-1);
  981.     InvalRect(&cwindow->portRect);
  982.     SetupScreen();
  983.     }
  984.     ShowHide(cwindow,-1);
  985.     splitmode = split;
  986. }
  987.  
  988. SetupScreen()
  989. {
  990.     FontInfo info;
  991.     Rect *pRect;
  992.  
  993.     /* get font information */
  994.     GetFontInfo(&info);
  995.  
  996.     /* compute the top and bottom margins */
  997.     tmargin = TextMargin + info.ascent;
  998.     lmargin = TextMargin;
  999.  
  1000.     /* compute the x and y increments */
  1001.     xinc = info.widMax;
  1002.     yinc = info.ascent + info.descent + info.leading;
  1003.  
  1004.     /* compute the character dimensions of the screen */
  1005.     pRect = &cwindow->portRect;
  1006.     scrh = (pRect->bottom - (2 * TextMargin) - (SBarWidth - 1)) / yinc;
  1007.     if (scrh > SCRH) scrh = SCRH;
  1008.     scrw = (pRect->right - (2 * TextMargin) - (SBarWidth - 1)) / xinc;
  1009.     if (scrw > SCRW) scrw = SCRW;
  1010.     
  1011.     /* clear the screen */
  1012.     scrclear();
  1013. }
  1014.  
  1015. CursorUpdate()
  1016. {
  1017.     if (cursorstate != -1)
  1018.     if (cursortime < TickCount()) {
  1019.         scrposition(x,y);
  1020.         if (cursorstate) {
  1021.         DrawChar(' ');
  1022.         cursortime = TickCount() + TIMEOFF;
  1023.         cursorstate = 0;
  1024.         }
  1025.         else {
  1026.         DrawChar('_');
  1027.         cursortime = TickCount() + TIMEON;
  1028.         cursorstate = 1;
  1029.         }
  1030.     }
  1031. }
  1032.  
  1033. CursorOn()
  1034. {
  1035.     cursortime = TickCount();
  1036.     cursorstate = 0;
  1037. }
  1038.  
  1039. CursorOff()
  1040. {
  1041.     if (cursorstate == 1) {
  1042.     scrposition(x,y);
  1043.     DrawChar(' ');
  1044.     }
  1045.     cursorstate = -1;
  1046. }
  1047.  
  1048. RedrawScreen()
  1049. {
  1050.     char *Line; int y;
  1051.     Line = topline;
  1052.     for (y = 0; y < scrh; y++) {
  1053.     scrposition(0,y);
  1054.     DrawText(Line,0,scrw);
  1055.     nextline(&Line);
  1056.     }
  1057. }
  1058.  
  1059. nextline(pline)
  1060.   char **pline;
  1061. {
  1062.     if ((*pline += SCRW) >= &screen[SCRH*SCRW])
  1063.     *pline = screen;
  1064. }
  1065.  
  1066. scrollup()
  1067. {
  1068.     RgnHandle updateRgn;
  1069.     Rect rect;
  1070.     int x;
  1071.     updateRgn = NewRgn();
  1072.     rect = cwindow->portRect;
  1073.     rect.bottom -= SBarWidth - 1;
  1074.     rect.right -= SBarWidth - 1;
  1075.     ScrollRect(&rect,0,-yinc,updateRgn);
  1076.     DisposeRgn(updateRgn);
  1077.     for (x = 0; x < SCRW; x++)
  1078.     topline[x] = ' ';
  1079.     nextline(&topline);
  1080. }
  1081.  
  1082. ======================== macstuff.c ==========================================
  1083.  
  1084. /* macstuff.c - macintosh interface routines for xlisp */
  1085.  
  1086. #include <stdio.h>
  1087.  
  1088. /* program limits */
  1089. #define LINEMAX     200    /* maximum line length */
  1090.  
  1091. /* externals */
  1092. extern FILE *tfp;
  1093. extern int x;
  1094.  
  1095. /* local variables */
  1096. static char linebuf[LINEMAX+1],*lineptr;
  1097. static int linepos[LINEMAX],linelen;
  1098. static long rseed = 1L;
  1099.  
  1100. osinit(name)
  1101.   char *name;
  1102. {
  1103.     /* initialize the mac interface routines */
  1104.     macinit();
  1105.  
  1106.     /* initialize the line editor */
  1107.     linelen = 0;
  1108. }
  1109.  
  1110. osfinish()
  1111. {
  1112. }
  1113.  
  1114. oserror(msg)
  1115. {
  1116.     char line[100],*p;
  1117.     sprintf(line,"error: %s\n",msg);
  1118.     for (p = line; *p != '\0'; ++p)
  1119.     ostputc(*p);
  1120. }
  1121.  
  1122. int osrand(n)
  1123.   int n;
  1124. {
  1125.     long k1;
  1126.     
  1127.     /* make sure we don't get stuck at zero */
  1128.     if (rseed == 0L) rseed = 1L;
  1129.     
  1130.     /* algorithm taken from Dr. Dobbs Journal, November 1985, Page 91 */
  1131.     k1 = rseed / 127773L;
  1132.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  1133.     rseed += 2147483647L;
  1134.     
  1135.     /* return a random number between 0 and n-1 */
  1136.     return ((int)(rseed % (long)n));
  1137. }
  1138.  
  1139. FILE *osaopen(name,mode)
  1140.   char *name,*mode;
  1141. {
  1142.     return (fopen(name,mode));
  1143. }
  1144.  
  1145. FILE *osbopen(name,mode)
  1146.   char *name,*mode;
  1147. {
  1148.     char nmode[4];
  1149.     strcpy(nmode,mode); strcat(nmode,"b");
  1150.     return (fopen(name,nmode));
  1151. }
  1152.  
  1153. int osclose(fp)
  1154.   FILE *fp;
  1155. {
  1156.     return (fclose(fp));
  1157. }
  1158.  
  1159. int osagetc(fp)
  1160.   FILE *fp;
  1161. {
  1162.     return (getc(fp));
  1163. }
  1164.  
  1165. int osbgetc(fp)
  1166.   FILE *fp;
  1167. {
  1168.     return (getc(fp));
  1169. }
  1170.  
  1171. int osaputc(ch,fp)
  1172.   int ch; FILE *fp;
  1173. {
  1174.     return (putc(ch,fp));
  1175. }
  1176.  
  1177. int osbputc(ch,fp)
  1178.   int ch; FILE *fp;
  1179. {
  1180.     return (putc(ch,fp));
  1181. }
  1182.  
  1183. int ostgetc()
  1184. {
  1185.     int ch,i;
  1186.  
  1187.     if (linelen--) return (*lineptr++);
  1188.     linelen = 0;
  1189.     while ((ch = scrgetc()) != '\r')
  1190.     switch (ch) {
  1191.     case EOF:
  1192.         return (ostgetc());
  1193.     case '\010':
  1194.         if (linelen > 0) {
  1195.         linelen--;
  1196.         while (x > linepos[linelen])
  1197.             scrdelete();
  1198.         }
  1199.         break;
  1200.     default:
  1201.         if (linelen < LINEMAX) {
  1202.             linebuf[linelen] = ch;
  1203.         linepos[linelen] = x;
  1204.         linelen++;
  1205.         }
  1206.         scrputc(ch);
  1207.         break;
  1208.     }
  1209.     linebuf[linelen++] = '\n';
  1210.     scrputc('\r'); scrputc('\n');
  1211.     if (tfp)
  1212.     for (i = 0; i < linelen; ++i)
  1213.         osaputc(linebuf[i],tfp);
  1214.     lineptr = linebuf; linelen--;
  1215.     return (*lineptr++);
  1216. }
  1217.  
  1218. int ostputc(ch)
  1219.   int ch;
  1220. {
  1221.     if (ch == '\n')
  1222.     scrputc('\r');
  1223.     scrputc(ch);
  1224.     if (tfp)
  1225.     osaputc(ch,tfp);
  1226.     return (1);
  1227. }
  1228.  
  1229. osflush()
  1230. {
  1231.     lineptr = linebuf;
  1232.     linelen = 0;
  1233. }
  1234.  
  1235. oscheck()
  1236. {
  1237.     DoEvent();
  1238. }
  1239.  
  1240.  
  1241. =========================== osdefs.h =====================================
  1242.  
  1243. extern LVAL xptsize(),
  1244.         xhidepen(),xshowpen(),xgetpen(),xpensize(),xpenmode(),
  1245.             xpenpat(),xpennormal(),xmoveto(),xmove(),xlineto(),xline(),
  1246.         xshowgraphics(),xhidegraphics(),xcleargraphics(),
  1247.         xtool(),xtool16(),xtool32(),xnewhandle(),xnewptr(),
  1248.         xhiword(),xloword(),xrdnohang();
  1249.  
  1250. =========================== osptrs.h =====================================
  1251.  
  1252. {    "HIDEPEN",            S, xhidepen        }, /* 300 */
  1253. {    "SHOWPEN",            S, xshowpen        }, /* 301 */
  1254. {    "GETPEN",            S, xgetpen        }, /* 302 */
  1255. {    "PENSIZE",            S, xpensize        }, /* 303 */
  1256. {    "PENMODE",            S, xpenmode        }, /* 304 */
  1257. {    "PENPAT",            S, xpenpat        }, /* 305 */
  1258. {    "PENNORMAL",            S, xpennormal        }, /* 306 */
  1259. {    "MOVETO",            S, xmoveto        }, /* 307 */
  1260. {    "MOVE",                S, xmove        }, /* 308 */
  1261. {    "LINETO",            S, xlineto        }, /* 309 */
  1262. {    "LINE",                S, xline        }, /* 310 */
  1263. {    "SHOW-GRAPHICS",        S, xshowgraphics    }, /* 311 */
  1264. {    "HIDE-GRAPHICS",        S, xhidegraphics    }, /* 312 */
  1265. {    "CLEAR-GRAPHICS",        S, xcleargraphics    }, /* 313 */
  1266. {    "TOOLBOX",            S, xtool        }, /* 314 */
  1267. {    "TOOLBOX-16",            S, xtool16        }, /* 315 */
  1268. {    "TOOLBOX-32",            S, xtool32        }, /* 316 */
  1269. {    "NEWHANDLE",            S, xnewhandle        }, /* 317 */
  1270. {    "NEWPTR",            S, xnewptr        }, /* 318 */
  1271. {    "HIWORD",            S, xhiword        }, /* 319 */
  1272. {    "LOWORD",            S, xloword        }, /* 320 */
  1273. {    "READ-CHAR-NO-HANG",        S, xrdnohang        }, /* 321 */
  1274. {    "COMMAND-POINT-SIZE",        S, xptsize        }, /* 322 */
  1275.  
  1276.  
  1277. ======================== Xlisp.Rsrc ==========================================
  1278.  
  1279. XLisp.Rsrc
  1280.  
  1281. TYPE WIND
  1282.   ,128
  1283. XLISP version 2.0
  1284. 41 4 339 508
  1285. InVisible GoAway
  1286. 0
  1287. 0
  1288.  
  1289. TYPE WIND
  1290.   ,129
  1291. Graphics Window
  1292. 22 4 254 508
  1293. InVisible NoGoAway
  1294. 2
  1295. 0
  1296.  
  1297. TYPE DLOG
  1298.   ,129
  1299. About XLISP
  1300. 50 100 290 395
  1301. Visible NoGoAway
  1302. 3
  1303. 0
  1304. 129
  1305.  
  1306. TYPE DITL
  1307.   ,129
  1308. 9
  1309.  
  1310. staticText
  1311. 20 20 40 275
  1312. XLISP v2.0, February 6, 1988
  1313.  
  1314. staticText
  1315. 40 20 60 275
  1316. Copyright (c) 1988, by David Betz
  1317.  
  1318. staticText
  1319. 60 20 80 275
  1320. All Rights Reserved
  1321.  
  1322. staticText
  1323. 90 20 110 275
  1324. Author contact information:
  1325.  
  1326. staticText
  1327. 110 40 130 275
  1328. David Betz
  1329.  
  1330. staticText
  1331. 130 40 150 275
  1332. 127 Taylor Road
  1333.  
  1334. staticText
  1335. 150 40 170 275
  1336. Peterborough, NH  03458
  1337.  
  1338. staticText
  1339. 170 40 190 275
  1340. (603) 924-6936
  1341.  
  1342. staticText
  1343. 200 20 220 275
  1344. Portions Copyright Think Technologies
  1345.  
  1346. TYPE MENU
  1347.   ,1
  1348. \14
  1349. About XLISP
  1350. (-
  1351.  
  1352. TYPE MENU
  1353.   ,256
  1354. File
  1355. Load.../L
  1356. Load Noisily.../N
  1357. (-
  1358. Quit/Q
  1359.  
  1360. TYPE MENU
  1361.   ,257
  1362. Edit
  1363. Undo/Z
  1364. (-
  1365. Cut/X
  1366. Copy/C
  1367. Paste/V
  1368. Clear
  1369.  
  1370. TYPE MENU
  1371.   ,258
  1372. Control
  1373. Break/B
  1374. Continue/P
  1375. Clean Up Error/G
  1376. Cancel Input/U
  1377. Top Level/T
  1378. (-
  1379. Split Screen/S
  1380.  
  1381.  
  1382. ======================== Alles ist gemacht  ==================================
  1383.  
  1384.  
  1385. -- 
  1386. Eric F. Johnson, Boulware Technologies, Inc. 
  1387. 415 W. Travelers Trail, Burnsville, MN 55337 USA.  Phone: +1 612-894-0313. 
  1388. erc@pai.mn.org    - or -   bungia!pai!erc
  1389. (We have a very dumb mailer, so please send a bang-!-style return address.)
  1390.  
  1391.  
  1392.