summaryrefslogtreecommitdiff
path: root/sys/mac/macfun.c
diff options
context:
space:
mode:
Diffstat (limited to 'sys/mac/macfun.c')
-rw-r--r--sys/mac/macfun.c222
1 files changed, 222 insertions, 0 deletions
diff --git a/sys/mac/macfun.c b/sys/mac/macfun.c
new file mode 100644
index 0000000..e92461d
--- /dev/null
+++ b/sys/mac/macfun.c
@@ -0,0 +1,222 @@
+/* macfun.c - macintosh user interface functions for xlisp */
+/* Written by Brian Kendig. */
+
+#include <Quickdraw.h>
+#include <Windows.h>
+#include <Memory.h>
+#include "xlisp.h"
+#include "macint.h"
+
+/* externals */
+extern WindowPtr gCommandWin, gGraphicsWin;
+extern Boolean hasColorQD;
+extern unsigned long startupTicks;
+extern void ShowGrafWin (void);
+
+unsigned long ticks_per_second (void) { return 60; }
+unsigned long run_tick_count (void) { return ((unsigned long) TickCount ()) - startupTicks; }
+unsigned long real_tick_count (void) { return (unsigned long) TickCount (); }
+
+LVAL xrealtime (void) { return cvfixnum ((FIXTYPE)real_tick_count()); } /* get-internal-real-time */
+LVAL xruntime (void) { return cvfixnum ((FIXTYPE)run_tick_count()); } /* get-internal-run-time */
+LVAL xtime (void) { return cvfixnum ((FIXTYPE)real_tick_count()); } /* time */
+
+/* get an integer parameter */
+LOCAL int getNumber () {
+ LVAL num = xlgafixnum ();
+ return ((int) getfixnum (num));
+}
+
+/* handle commands that require integer arguments */
+LOCAL LVAL GrafCmd (char funct, int nArgs) {
+ short x, y, z;
+ if (nArgs > 0) x = getNumber ();
+ if (nArgs > 1) y = getNumber ();
+ if (nArgs > 2) z = getNumber ();
+ xllastarg ();
+ SetPort (gGraphicsWin);
+ switch (funct) {
+ case 'G': ShowGrafWin (); break;
+ case 'g': HideGrafWin (); break;
+ case 'x': EraseRect (&gGraphicsWin->portRect); break;
+ case 's': ShowPen (); break;
+ case 'h': HidePen (); break;
+ case 'd': PenMode (x); break;
+ case 'M': Move (x, y); break;
+ case 'm': MoveTo (x, y); break;
+ case 'L': Line (x, y); break;
+ case 'l': LineTo (x, y); break;
+ case 'S': PenSize (x, y); break;
+ case 'p': PenNormal (); break;
+ case 'c':
+ if (hasColorQD) {
+ RGBColor col; col.red = x; col.green = y; col.blue = z;
+ RGBForeColor (&col);
+ } break;
+ }
+ SetPort (gCommandWin);
+ return NIL;
+}
+
+LVAL xshowgraphics (void) { return GrafCmd ('G', 0); } /* show graphics win */
+LVAL xhidegraphics (void) { return GrafCmd ('g', 0); } /* hide graphics win */
+LVAL xcleargraphics (void) { return GrafCmd ('x', 0); } /* clear graphics win */
+LVAL xshowpen (void) { return GrafCmd ('s', 0); } /* show the pen */
+LVAL xhidepen (void) { return GrafCmd ('h', 0); } /* hide the pen */
+LVAL xpenmode (void) { return GrafCmd ('d', 1); } /* set the pen mode */
+LVAL xmove (void) { return GrafCmd ('M', 2); } /* move pen in a specified direction */
+LVAL xmoveto (void) { return GrafCmd ('m', 2); } /* move pen to a screen location */
+LVAL xdraw (void) { return GrafCmd ('L', 2); } /* draw a line in a specified direction */
+LVAL xdrawto (void) { return GrafCmd ('l', 2); } /* draw a line to a screen location */
+LVAL xpensize (void) { return GrafCmd ('S', 2); } /* set the pen size */
+LVAL xpennormal (void) { return GrafCmd ('p', 0); } /* set the pen to normal */
+LVAL xcolor (void) { return GrafCmd ('c', 3); } /* set RGB color of pen */
+
+
+LVAL xgetpen (void) { /* get the pen position */
+ LVAL val;
+ Point p;
+ xllastarg ();
+ SetPort ((GrafPtr)gGraphicsWin);
+ GetPen (&p);
+ SetPort (gCommandWin);
+ xlsave1 (val);
+ val = consa (NIL);
+ rplaca (val,cvfixnum ((FIXTYPE)p.h));
+ rplacd (val,cvfixnum ((FIXTYPE)p.v));
+ xlpop ();
+ return val;
+}
+
+LVAL xpenpat (void) { /* set the pen pattern */
+ LVAL plist;
+ Pattern pat;
+ int i;
+ plist = xlgalist ();
+ xllastarg ();
+ for (i = 0; i < 8 && consp (plist); ++i, plist = cdr (plist))
+// if (fixp (car (plist))) pat[i] = getfixnum (car (plist));
+ SetPort ((GrafPtr)gGraphicsWin);
+ PenPat (&pat);
+ SetPort (gCommandWin);
+ return NIL;
+}
+
+
+/* The functions below are not yet implemented. */
+
+LVAL xtool (void) { /* call the toolbox */
+ int trap = getNumber ();
+ LVAL val;
+
+/* asm {
+ move.l args(A6),D0
+ beq L2
+ L1: move.l D0,A0
+ move.l 2(A0),A1
+ move.w 4(A1),-(A7)
+ move.l 6(A0),D0
+ bne L1
+ L2: lea L3,A0
+ move.w trap(A6),(A0)
+ L3: dc.w 0xA000
+ clr.l val(A6)
+ }
+
+ return val; */
+ return cvfixnum ((FIXTYPE) trap);
+}
+
+LVAL xtool16 (void) { /* call the toolbox with a 16 bit result */
+ int trap = getNumber ();
+ int val;
+
+/* asm {
+ clr.w -(A7)
+ move.l args(A6), D0
+ beq L2
+ L1: move.l D0, A0
+ move.l 2(A0), A1
+ move.w 4(A1), -(A7)
+ move.l 6(A0), D0
+ bne L1
+ L2: lea L3, A0
+ move.w trap(A6), (A0)
+ L3: dc.w 0xA000
+ move.w (A7)+, val(A6)
+ }
+
+ return cvfixnum ((FIXTYPE) val); */
+ return cvfixnum ((FIXTYPE) trap);
+}
+
+LVAL xtool32 (void) { /* call the toolbox with a 32 bit result */
+ int trap = getNumber ();
+ long val;
+
+/* asm {
+ clr.l -(A7)
+ move.l args(A6),D0
+ beq L2
+ L1: move.l D0,A0
+ move.l 2(A0),A1
+ move.w 4(A1),-(A7)
+ move.l 6(A0),D0
+ bne L1
+ L2: lea L3,A0
+ move.w trap(A6),(A0)
+ L3: dc.w 0xA000
+ move.l (A7)+,val(A6)
+ }
+
+ return cvfixnum ((FIXTYPE) val); */
+ return cvfixnum ((FIXTYPE) trap);
+}
+
+LVAL xnewhandle (void) { /* allocate a new handle */
+ LVAL num = xlgafixnum ();
+ long size = getfixnum (num);
+ xllastarg ();
+ return cvfixnum ((FIXTYPE) NewHandle (size));
+}
+
+LVAL xnewptr (void) { /* allocate memory */
+ LVAL num = xlgafixnum ();
+ long size = getfixnum (num);
+ xllastarg ();
+ return cvfixnum ((FIXTYPE) NewPtr (size));
+}
+
+LVAL xhiword (void) { /* return the high order 16 bits of an integer */
+ unsigned int val = (unsigned int) (getNumber () >> 16);
+ xllastarg ();
+ return cvfixnum ((FIXTYPE) val);
+}
+
+LVAL xloword (void) { /* return the low order 16 bits of an integer */
+ unsigned int val = (unsigned int) getNumber ();
+ xllastarg ();
+ return cvfixnum ((FIXTYPE) val);
+}
+
+LVAL xrdnohang (void) { /* get the next character in the look-ahead buffer */
+ int ch = 0;
+ xllastarg ();
+/* if ((ch = scrnextc ()) == EOF) return NIL; */
+ return cvfixnum ((FIXTYPE) ch);
+}
+
+void ossymbols (void) { /* ossymbols - enter important symbols */
+ LVAL sym;
+
+ /* setup globals for the window handles */
+ sym = xlenter ("*COMMAND-WINDOW*");
+ setvalue (sym, cvfixnum ((FIXTYPE) gCommandWin));
+ sym = xlenter ("*GRAPHICS-WINDOW*");
+ setvalue (sym, cvfixnum ((FIXTYPE) gGraphicsWin));
+}
+
+void xoserror (char *msg) { /* do nothing */ }
+
+LVAL xsystem (V) { return NIL; }
+LVAL xgetkey (V) { return NIL; }
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-16 09:59:43 +0000