home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / code / xlisp_20.sit / macfun.c next >
Encoding:
C/C++ Source or Header  |  1988-07-29  |  5.8 KB  |  343 lines
  1. /* macfun.c - macintosh user interface functions for xlisp */
  2.  
  3. #include <Quickdraw.h>
  4. #include <WindowMgr.h>
  5. #include <MemoryMgr.h>
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern GrafPtr cwindow,gwindow;
  10.  
  11. /* forward declarations */
  12. FORWARD LVAL do_0();
  13. FORWARD LVAL do_1();
  14. FORWARD LVAL do_2();
  15.  
  16. /* xptsize - set the command window point size */
  17. LVAL xptsize()
  18. {
  19.     LVAL val;
  20.     val = xlgafixnum();
  21.     xllastarg();
  22.     TextSize((int)getfixnum(val));
  23.     InvalRect(&cwindow->portRect);
  24.     SetupScreen();
  25.     return (NIL);
  26. }
  27.  
  28. /* xhidepen - hide the pen */
  29. LVAL xhidepen()
  30. {
  31.     return (do_0('H'));
  32. }
  33.  
  34. /* xshowpen - show the pen */
  35. LVAL xshowpen()
  36. {
  37.     return (do_0('S'));
  38. }
  39.  
  40. /* xgetpen - get the pen position */
  41. LVAL xgetpen()
  42. {
  43.     LVAL val;
  44.     Point p;
  45.     xllastarg();
  46.     SetPort(gwindow);
  47.     GetPen(&p);
  48.     SetPort(cwindow);
  49.     xlsave1(val);
  50.     val = consa(NIL);
  51.     rplaca(val,cvfixnum((FIXTYPE)p.h));
  52.     rplacd(val,cvfixnum((FIXTYPE)p.v));
  53.     xlpop();
  54.     return (val);
  55. }
  56.  
  57. /* xpenmode - set the pen mode */
  58. LVAL xpenmode()
  59. {
  60.     return (do_1('M'));
  61. }
  62.  
  63. /* xpensize - set the pen size */
  64. LVAL xpensize()
  65. {
  66.     return (do_2('S'));
  67. }
  68.  
  69. /* xpenpat - set the pen pattern */
  70. LVAL xpenpat()
  71. {
  72.     LVAL plist;
  73.     char pat[8],i;
  74.     plist = xlgalist();
  75.     xllastarg();
  76.     for (i = 0; i < 8 && consp(plist); ++i, plist = cdr(plist))
  77.     if (fixp(car(plist)))
  78.         pat[i] = getfixnum(car(plist));
  79.     SetPort(gwindow);
  80.     PenPat(pat);
  81.     SetPort(cwindow);
  82.     return (NIL);
  83. }
  84.  
  85. /* xpennormal - set the pen to normal */
  86. LVAL xpennormal()
  87. {
  88.     xllastarg();
  89.     SetPort(gwindow);
  90.     PenNormal();
  91.     SetPort(cwindow);
  92.     return (NIL);
  93. }
  94.  
  95. /* xmoveto - Move to a screen location */
  96. LVAL xmoveto()
  97. {
  98.     return (do_2('m'));
  99. }
  100.  
  101. /* xmove - Move in a specified direction */
  102. LVAL xmove()
  103. {
  104.     return (do_2('M'));
  105. }
  106.  
  107. /* xlineto - draw a Line to a screen location */
  108. LVAL xlineto()
  109. {
  110.     return (do_2('l'));
  111. }
  112.  
  113. /* xline - draw a Line in a specified direction */
  114. LVAL xline()
  115. {
  116.     return (do_2('L'));
  117. }
  118.  
  119. /* xshowgraphics - show the graphics window */
  120. LVAL xshowgraphics()
  121. {
  122.     xllastarg();
  123.     scrsplit(1);
  124.     return (NIL);
  125. }
  126.  
  127. /* xhidegraphics - hide the graphics window */
  128. LVAL xhidegraphics()
  129. {
  130.     xllastarg();
  131.     scrsplit(0);
  132.     return (NIL);
  133. }
  134.  
  135. /* xcleargraphics - clear the graphics window */
  136. LVAL xcleargraphics()
  137. {
  138.     xllastarg();
  139.     SetPort(gwindow);
  140.     EraseRect(&gwindow->portRect);
  141.     SetPort(cwindow);
  142.     return (NIL);
  143. }
  144.  
  145. /* do_0 - Handle commands that require no arguments */
  146. LOCAL LVAL do_0(fcn)
  147.   int fcn;
  148. {
  149.     xllastarg();
  150.     SetPort(gwindow);
  151.     switch (fcn) {
  152.     case 'H':    HidePen(); break;
  153.     case 'S':    ShowPen(); break;
  154.     }
  155.     SetPort(cwindow);
  156.     return (NIL);
  157. }
  158.  
  159. /* do_1 - Handle commands that require one integer argument */
  160. LOCAL LVAL do_1(fcn)
  161.   int fcn;
  162. {
  163.     int x;
  164.     x = getnumber();
  165.     xllastarg();
  166.     SetPort(gwindow);
  167.     switch (fcn) {
  168.     case 'M':    PenMode(x); break;
  169.     }
  170.     SetPort(cwindow);
  171.     return (NIL);
  172. }
  173.  
  174. /* do_2 - Handle commands that require two integer arguments */
  175. LOCAL LVAL do_2(fcn)
  176.   int fcn;
  177. {
  178.     int h,v;
  179.     h = getnumber();
  180.     v = getnumber();
  181.     xllastarg();
  182.     SetPort(gwindow);
  183.     switch (fcn) {
  184.     case 'l':    LineTo(h,v); break;
  185.     case 'L':    Line(h,v);   break;
  186.     case 'm':   MoveTo(h,v); break;
  187.     case 'M':    Move(h,v);   break;
  188.     case 'S':    PenSize(h,v);break;
  189.     }
  190.     SetPort(cwindow);
  191.     return (NIL);
  192. }
  193.  
  194. /* getnumber - get an integer parameter */
  195. LOCAL int getnumber()
  196. {
  197.     LVAL num;
  198.     num = xlgafixnum();
  199.     return ((int)getfixnum(num));
  200. }
  201.  
  202. /* xtool - call the toolbox */
  203. LVAL xtool()
  204. {
  205.     LVAL val;
  206.     int trap;
  207.  
  208.     trap = getnumber();
  209. /*
  210.  
  211.     asm {
  212.     move.l    args(A6),D0
  213.     beq    L2
  214. L1:    move.l    D0,A0
  215.     move.l    2(A0),A1
  216.     move.w    4(A1),-(A7)
  217.     move.l    6(A0),D0
  218.     bne    L1
  219. L2:    lea    L3,A0
  220.     move.w    trap(A6),(A0)
  221. L3:    dc.w    0xA000
  222.     clr.l    val(A6)
  223.     }
  224. */
  225.  
  226.     return (val);
  227. }
  228.  
  229. /* xtool16 - call the toolbox with a 16 bit result */
  230. LVAL xtool16()
  231. {
  232.     int trap,val;
  233.  
  234.     trap = getnumber();
  235. /*
  236.  
  237.     asm {
  238.     clr.w    -(A7)
  239.     move.l    args(A6),D0
  240.     beq    L2
  241. L1:    move.l    D0,A0
  242.     move.l    2(A0),A1
  243.     move.w    4(A1),-(A7)
  244.     move.l    6(A0),D0
  245.     bne    L1
  246. L2:    lea    L3,A0
  247.     move.w    trap(A6),(A0)
  248. L3:    dc.w    0xA000
  249.     move.w    (A7)+,val(A6)
  250.     }
  251. */
  252.  
  253.     return (cvfixnum((FIXTYPE)val));
  254. }
  255.  
  256. /* xtool32 - call the toolbox with a 32 bit result */
  257. LVAL xtool32()
  258. {
  259.     int trap;
  260.     long val;
  261.  
  262.     trap = getnumber();
  263. /*
  264.  
  265.     asm {
  266.     clr.l    -(A7)
  267.     move.l    args(A6),D0
  268.     beq    L2
  269. L1:    move.l    D0,A0
  270.     move.l    2(A0),A1
  271.     move.w    4(A1),-(A7)
  272.     move.l    6(A0),D0
  273.     bne    L1
  274. L2:    lea    L3,A0
  275.     move.w    trap(A6),(A0)
  276. L3:    dc.w    0xA000
  277.     move.l    (A7)+,val(A6)
  278.     }
  279. */
  280.  
  281.     return (cvfixnum((FIXTYPE)val));
  282. }
  283.  
  284. /* xnewhandle - allocate a new handle */
  285. LVAL xnewhandle()
  286. {
  287.     LVAL num;
  288.     long size;
  289.     num = xlgafixnum(); size = getfixnum(num);
  290.     xllastarg();
  291.     return (cvfixnum((FIXTYPE)NewHandle(size)));
  292. }
  293.  
  294. /* xnewptr - allocate memory */
  295. LVAL xnewptr()
  296. {
  297.     LVAL num;
  298.     long size;
  299.     num = xlgafixnum(); size = getfixnum(num);
  300.     xllastarg();
  301.     return (cvfixnum((FIXTYPE)NewPtr(size)));
  302. }
  303.     
  304. /* xhiword - return the high order 16 bits of an integer */
  305. LVAL xhiword()
  306. {
  307.     unsigned int val;
  308.     val = (unsigned int)(getnumber() >> 16);
  309.     xllastarg();
  310.     return (cvfixnum((FIXTYPE)val));
  311. }
  312.  
  313. /* xloword - return the low order 16 bits of an integer */
  314. LVAL xloword()
  315. {
  316.     unsigned int val;
  317.     val = (unsigned int)getnumber();
  318.     xllastarg();
  319.     return (cvfixnum((FIXTYPE)val));
  320. }
  321.  
  322. /* xrdnohang - get the next character in the look-ahead buffer */
  323. LVAL xrdnohang()
  324. {
  325.     int ch;
  326.     xllastarg();
  327.     if ((ch = scrnextc()) == EOF)
  328.     return (NIL);
  329.     return (cvfixnum((FIXTYPE)ch));
  330. }
  331.  
  332. /* ossymbols - enter important symbols */
  333. ossymbols()
  334. {
  335.     LVAL sym;
  336.  
  337.     /* setup globals for the window handles */
  338.     sym = xlenter("*COMMAND-WINDOW*");
  339.     setvalue(sym,cvfixnum((FIXTYPE)cwindow));
  340.     sym = xlenter("*GRAPHICS-WINDOW*");
  341.     setvalue(sym,cvfixnum((FIXTYPE)gwindow));
  342. }
  343.