1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
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; }
|
