-
-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathTRAJECTORY-FOLLOWER
169 lines (151 loc) · 9.99 KB
/
TRAJECTORY-FOLLOWER
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
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 4-Apr-88 11:51:42" {ERINYES}<LISPUSERS>MEDLEY>TRAJECTORY-FOLLOWER.;1 9967
changes to%: (FNS TRAJECTORY.FOLLOW TRAJECTORY.FOLLOWER.POINT TRAJECTORY.FOLLOWER.PUT
TRAJECTORY.FOLLOWER.SETUP TRAJECTORY.FOLLOWER.TEST
TRAJECTORY.FOLLOWER.WRAPUP)
(VARS TRAJECTORY-FOLLOWERCOMS)
previous date%: " 4-Apr-88 11:43:37" {CORE}TRAJECTORY-FOLLOWER.;2)
(* "
Copyright (c) 1986, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TRAJECTORY-FOLLOWERCOMS)
(RPAQQ TRAJECTORY-FOLLOWERCOMS ((FNS TRAJECTORY.FOLLOW TRAJECTORY.FOLLOWER.POINT
TRAJECTORY.FOLLOWER.PUT TRAJECTORY.FOLLOWER.SETUP
TRAJECTORY.FOLLOWER.TEST TRAJECTORY.FOLLOWER.WRAPUP)
(VARS (TRAJECTORY.FOLLOWER.POINTS))
(GLOBALVARS TRAJECTORY.FOLLOWER.COUNT
TRAJECTORY.FOLLOWER.LAST.TIME TRAJECTORY.FOLLOWER.POINTER
TRAJECTORY.FOLLOWER.POINTS TRAJECTORY.FOLLOWER.DELAY
TRAJECTORY.FOLLOWER.DSP TRAJECTORY.FOLLOWER.BITMAP
TRAJECTORY.FOLLOWER.HALF.WIDTH
TRAJECTORY.FOLLOWER.HALF.HEIGHT TRAJECTORY.FOLLOWER.WIDTH
TRAJECTORY.FOLLOWER.HEIGHT)
(BITMAPS TRAJECTORY.FOLLOWER.DEFAULT.BITMAP
TRAJECTORY.FOLLOWER.BALL TRAJECTORY.FOLLOWER.HORIZONTAL
TRAJECTORY.FOLLOWER.VERTICAL)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
READNUMBER)))
(DEFINEQ
(TRAJECTORY.FOLLOW
[LAMBDA (KNOTS CLOSED N DELAY BITMAP WINDOW) (* ;
"Edited 4-Apr-88 11:51 by Briggs")
(* ;
"Edited 22-Apr-83 17:56 by DAHJr ")
(PROG NIL
(TRAJECTORY.FOLLOWER.SETUP (OR WINDOW (SCREENBITMAP))
N DELAY (OR BITMAP TRAJECTORY.FOLLOWER.BALL))
(DRAWCURVE KNOTS CLOSED (FUNCTION TRAJECTORY.FOLLOWER.POINT)
NIL
(OR WINDOW PROMPTWINDOW))
(TRAJECTORY.FOLLOWER.WRAPUP])
(TRAJECTORY.FOLLOWER.POINT
[LAMBDA (X Y WINDOW) (* ;
"Edited 4-Apr-88 11:52 by Briggs")
(* ; "Edited 19-APR-83 21:06 by DAHJr")
(if (IGREATERP (SETQ TRAJECTORY.FOLLOWER.POINTER (IPLUS TRAJECTORY.FOLLOWER.POINTER 2))
TRAJECTORY.FOLLOWER.COUNT)
then (SETQ TRAJECTORY.FOLLOWER.POINTER 1))
(TRAJECTORY.FOLLOWER.PUT TRAJECTORY.FOLLOWER.POINTER)
(if TRAJECTORY.FOLLOWER.DELAY
then (DISMISS (IDIFFERENCE TRAJECTORY.FOLLOWER.DELAY (CLOCKDIFFERENCE
TRAJECTORY.FOLLOWER.LAST.TIME
)))
(SETQ TRAJECTORY.FOLLOWER.LAST.TIME (CLOCK 0)))
(if X
then (SETA TRAJECTORY.FOLLOWER.POINTS TRAJECTORY.FOLLOWER.POINTER (FIXR X))
(SETA TRAJECTORY.FOLLOWER.POINTS (ADD1 TRAJECTORY.FOLLOWER.POINTER)
(FIXR Y))
(TRAJECTORY.FOLLOWER.PUT TRAJECTORY.FOLLOWER.POINTER)
else (SETA TRAJECTORY.FOLLOWER.POINTS TRAJECTORY.FOLLOWER.POINTER MAX.FIXP])
(TRAJECTORY.FOLLOWER.PUT
[LAMBDA (POINTER) (* ;
"Edited 4-Apr-88 11:53 by Briggs")
(* ; "Edited 19-APR-83 20:57 by DAHJr")
(PROG (X Y)
(if (NOT (IEQP (SETQ X (ELT TRAJECTORY.FOLLOWER.POINTS POINTER))
MAX.FIXP))
then (SETQ Y (ELT TRAJECTORY.FOLLOWER.POINTS (ADD1 POINTER)))
(BITBLT TRAJECTORY.FOLLOWER.BITMAP 0 0 TRAJECTORY.FOLLOWER.DSP (IDIFFERENCE
X
TRAJECTORY.FOLLOWER.HALF.WIDTH
)
(IDIFFERENCE Y TRAJECTORY.FOLLOWER.HALF.HEIGHT)
TRAJECTORY.FOLLOWER.WIDTH TRAJECTORY.FOLLOWER.HEIGHT 'INPUT 'INVERT])
(TRAJECTORY.FOLLOWER.SETUP
[LAMBDA (DSP N DELAY BITMAP) (* ;
"Edited 4-Apr-88 11:54 by Briggs")
(* ; "Edited 19-APR-83 21:05 by DAHJr")
(PROG ((REAL.N (OR N 100))
(REAL.BITMAP (OR BITMAP TRAJECTORY.FOLLOWER.DEFAULT.BITMAP)))
(if (AND TRAJECTORY.FOLLOWER.POINTS (EQ (ITIMES REAL.N 2)
(ARRAYSIZE TRAJECTORY.FOLLOWER.POINTS)))
else (SETQ TRAJECTORY.FOLLOWER.POINTS (ARRAY (ITIMES REAL.N 2)
'FIXP MAX.FIXP)))
(SETQ TRAJECTORY.FOLLOWER.POINTER 1)
(SETQ TRAJECTORY.FOLLOWER.COUNT REAL.N)
(SETQ TRAJECTORY.FOLLOWER.DSP DSP)
(SETQ TRAJECTORY.FOLLOWER.DELAY DELAY)
(if DELAY
then (SETQ TRAJECTORY.FOLLOWER.LAST.TIME (CLOCK 0)))
(SETQ TRAJECTORY.FOLLOWER.BITMAP REAL.BITMAP)
(SETQ TRAJECTORY.FOLLOWER.WIDTH (fetch (BITMAP BITMAPWIDTH) of REAL.BITMAP))
(SETQ TRAJECTORY.FOLLOWER.HEIGHT (fetch (BITMAP BITMAPHEIGHT) of REAL.BITMAP))
(SETQ TRAJECTORY.FOLLOWER.HALF.WIDTH (IQUOTIENT TRAJECTORY.FOLLOWER.WIDTH 2))
(SETQ TRAJECTORY.FOLLOWER.HALF.HEIGHT (IQUOTIENT TRAJECTORY.FOLLOWER.HEIGHT 2])
(TRAJECTORY.FOLLOWER.TEST
[LAMBDA NIL (* ;
"Edited 4-Apr-88 11:42 by Briggs")
(* ; "Edited 22-APR-83 16:17 by DAHJr")
(PROG (KNOTS N DELAY CLOSED BITMAP)
(printout PROMPTWINDOW
"Indicate knots on a trajectory; hold down left shift key on last point")
[SETQ KNOTS (CONS (GETPOSITION)
(collect (GETPOSITION) repeatuntil (KEYDOWNP 'LSHIFT]
(SETQ N (RNUMBER "Indicate the number of points in the follower"))
(SETQ DELAY (MAX 0 (RNUMBER "Indicate the delay per point (milliseconds)")))
(if (ZEROP DELAY)
then (SETQ DELAY NIL))
[SETQ CLOSED (MENU (create MENU
ITEMS _ '(OPEN CLOSED]
[SETQ BITMAP (MENU (create MENU
ITEMS _ '(("A single point" NIL)
("A horizontal line" TRAJECTORY.FOLLOWER.HORIZONTAL)
("A vertical line" TRAJECTORY.FOLLOWER.VERTICAL)
("A ball" TRAJECTORY.FOLLOWER.BALL]
(TRAJECTORY.FOLLOWER.SETUP (SCREENBITMAP)
N DELAY BITMAP)
(if (EQ CLOSED 'CLOSED)
then (until (KEYDOWNP 'LSHIFT) do (DRAWCURVE KNOTS T (FUNCTION
TRAJECTORY.FOLLOWER.POINT
)
NIL PROMPTWINDOW))
else (DRAWCURVE KNOTS NIL (FUNCTION TRAJECTORY.FOLLOWER.POINT)
NIL PROMPTWINDOW))
(TRAJECTORY.FOLLOWER.WRAPUP])
(TRAJECTORY.FOLLOWER.WRAPUP
[LAMBDA NIL (* ;
"Edited 4-Apr-88 11:42 by Briggs")
(* ; "Edited 19-APR-83 17:29 by DAHJr")
(for I to TRAJECTORY.FOLLOWER.COUNT do (TRAJECTORY.FOLLOWER.POINT])
)
(RPAQQ TRAJECTORY.FOLLOWER.POINTS NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TRAJECTORY.FOLLOWER.COUNT TRAJECTORY.FOLLOWER.LAST.TIME TRAJECTORY.FOLLOWER.POINTER
TRAJECTORY.FOLLOWER.POINTS TRAJECTORY.FOLLOWER.DELAY TRAJECTORY.FOLLOWER.DSP
TRAJECTORY.FOLLOWER.BITMAP TRAJECTORY.FOLLOWER.HALF.WIDTH TRAJECTORY.FOLLOWER.HALF.HEIGHT
TRAJECTORY.FOLLOWER.WIDTH TRAJECTORY.FOLLOWER.HEIGHT)
)
(RPAQQ TRAJECTORY.FOLLOWER.DEFAULT.BITMAP #*(1 1)H@@@)
(RPAQQ TRAJECTORY.FOLLOWER.BALL #*(21 21)@AOL@@@@@COO@@@@@OOOH@@@AOOOL@@@COOON@@@GOOOO@@@GOOOO@@@GOOOOH@@OOOOOH@@OOOOOH@@OOOOOH@@OOOOOH@@GOOOOH@@GOOOO@@@GOOOO@@@COOON@@@COOON@@@AOOOL@@@@OOOH@@@@GOO@@@@@AOL@@@@
)
(RPAQQ TRAJECTORY.FOLLOWER.HORIZONTAL #*(18 1)OOOOL@@@)
(RPAQQ TRAJECTORY.FOLLOWER.VERTICAL
#*(1 16)H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@H@@@)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
READNUMBER)
(PUTPROPS TRAJECTORY-FOLLOWER COPYRIGHT ("Xerox Corporation" 1986 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1992 8891 (TRAJECTORY.FOLLOW 2002 . 2689) (TRAJECTORY.FOLLOWER.POINT 2691 . 3989) (
TRAJECTORY.FOLLOWER.PUT 3991 . 5052) (TRAJECTORY.FOLLOWER.SETUP 5054 . 6500) (TRAJECTORY.FOLLOWER.TEST
6502 . 8493) (TRAJECTORY.FOLLOWER.WRAPUP 8495 . 8889)))))
STOP