-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathMONITOR
180 lines (161 loc) · 9.99 KB
/
MONITOR
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
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "14-Mar-88 17:29:38" |{MCS:MCS:STANFORD}<LANE>MONITOR.;9| 10032
changes to%: (VARS MONITORCOMS)
(FNS MONITOR.GET.BITMAP MONITOR MONITOR.BUTTONEVENTFN MONITOR.SHRINK.BITMAP
MONITOR.SEND.BITMAP)
(COURIERPROGRAMS MONITOR)
previous date%: "14-Mar-88 09:15:11" |{MCS:MCS:STANFORD}<LANE>MONITOR.;1|)
(PRETTYCOMPRINT MONITORCOMS)
(RPAQQ MONITORCOMS ((FNS MONITOR MONITOR.GET.BITMAP MONITOR.BUTTONEVENTFN MONITOR.SHRINK.BITMAP
MONITOR.SEND.BITMAP)
(COURIERPROGRAMS MONITOR)
(INITVARS (MONITOR.SCALE 3)
MONITOR.SCRATCH.BITMAPS)
(GLOBALVARS MONITOR.SCALE MONITOR.SCRATCH.BITMAPS)
(DECLARE%: DONTCOPY (RECORDS MONITOR.SCRATCH.BITMAP))
(FILES COURIERSERVE BITMAPFNS)
(P (COURIER.START.SERVER))))
(DEFINEQ
(MONITOR
[LAMBDA (HOST SCALE) (* ; "Edited 14-Mar-88 13:46 by cdl")
(LET ((COURIER.STREAM (COURIER.OPEN HOST))
BITMAP SCREEN.WINDOW CLOSEUP.WINDOW)
(if (NULL SCALE)
then (SETQ SCALE MONITOR.SCALE))
(SETQ BITMAP (MONITOR.GET.BITMAP COURIER.STREAM SCALE))
[SETQ SCREEN.WINDOW (CREATEW (with REGION (GETBOXREGION (WIDTHIFWINDOW (BITMAPWIDTH BITMAP))
(TIMES (HEIGHTIFWINDOW (BITMAPHEIGHT BITMAP
))
2))
(CREATEREGION LEFT BOTTOM WIDTH (QUOTIENT HEIGHT 2]
(BITBLT BITMAP NIL NIL SCREEN.WINDOW)
(SETQ CLOSEUP.WINDOW
(CREATEW (with REGION (WINDOWPROP SCREEN.WINDOW 'REGION)
(create REGION
LEFT _ LEFT
BOTTOM _ PTOP
WIDTH _ WIDTH
HEIGHT _ (HEIGHTIFWINDOW (BITMAPHEIGHT BITMAP)
HOST)))
HOST))
(ATTACHWINDOW CLOSEUP.WINDOW SCREEN.WINDOW)
(BITBLT (MONITOR.GET.BITMAP COURIER.STREAM SCALE (DSPCLIPPINGREGION NIL SCREEN.WINDOW))
NIL NIL CLOSEUP.WINDOW)
(WINDOWPROP SCREEN.WINDOW 'MONITOR.SCALE SCALE)
(WINDOWPROP SCREEN.WINDOW 'COURIER.STREAM COURIER.STREAM)
(WINDOWPROP SCREEN.WINDOW 'CLOSEUP.WINDOW CLOSEUP.WINDOW)
(WINDOWPROP SCREEN.WINDOW 'BUTTONEVENTFN (FUNCTION MONITOR.BUTTONEVENTFN))
[WINDOWADDPROP SCREEN.WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW)
(CLOSEF? (WINDOWPROP WINDOW '
COURIER.STREAM))
(WINDOWPROP WINDOW 'CLOSEUP.WINDOW NIL]
SCREEN.WINDOW])
(MONITOR.GET.BITMAP
[LAMBDA (STREAM SCALE REGION) (* ; "Edited 14-Mar-88 14:01 by cdl")
(LET (BULK.DATA.STREAM)
(RESETLST [RESETSAVE NIL `(CLOSEF? ,(SETQ BULK.DATA.STREAM (COURIER.CALL STREAM 'MONITOR
'SEND.BITMAP SCALE REGION
NIL]
(READBM BULK.DATA.STREAM])
(MONITOR.BUTTONEVENTFN
[LAMBDA (WINDOW) (* ; "Edited 14-Mar-88 13:33 by cdl")
(LET ((SCALE (WINDOWPROP WINDOW 'MONITOR.SCALE))
REGION POSITION CLIPPINGREGION)
(if (MOUSESTATE LEFT)
then [with REGION (SETQ CLIPPINGREGION (DSPCLIPPINGREGION NIL WINDOW))
(SETQ REGION (CREATEREGION NIL NIL (QUOTIENT WIDTH SCALE)
(QUOTIENT HEIGHT SCALE]
(until (MOUSESTATE UP)
do (if [with POSITION (SETQ POSITION (CURSORPOSITION NIL WINDOW POSITION))
(with REGION REGION (OR (NEQ XCOORD LEFT)
(NEQ YCOORD BOTTOM]
then (with REGION REGION (if LEFT
then (DSPFILL REGION BLACKSHADE 'INVERT
WINDOW))
(with POSITION POSITION (SETQ LEFT XCOORD)
(SETQ BOTTOM YCOORD)))
(DSPFILL REGION BLACKSHADE 'INVERT WINDOW)
else (BLOCK)) finally (if (with REGION REGION LEFT)
then (DSPFILL REGION BLACKSHADE 'INVERT WINDOW)))
(BITBLT [MONITOR.GET.BITMAP (WINDOWPROP WINDOW 'COURIER.STREAM)
SCALE
(with REGION CLIPPINGREGION
(with POSITION (CURSORPOSITION NIL WINDOW POSITION)
(create REGION
LEFT _ (TIMES SCALE XCOORD)
BOTTOM _ (TIMES SCALE YCOORD)
WIDTH _ WIDTH
HEIGHT _ HEIGHT smashing REGION]
NIL NIL (WINDOWPROP WINDOW 'CLOSEUP.WINDOW))
elseif (MOUSESTATE MIDDLE)
then (RESETFORM (CURSOR WAITINGCURSOR)
(BITBLT (MONITOR.GET.BITMAP (WINDOWPROP WINDOW 'COURIER.STREAM)
SCALE)
NIL NIL WINDOW])
(MONITOR.SHRINK.BITMAP
[LAMBDA (SOURCE SCALE DESTINATION SCRATCH) (* ; "Edited 14-Mar-88 11:37 by cdl")
(* Specialized rewrite of SHRINKBITMAP)
[if (EQP SCALE 1)
then (BITBLT SOURCE NIL NIL DESTINATION)
else (BLTSHADE WHITESHADE SCRATCH)
(BLTSHADE WHITESHADE DESTINATION)
(LET ((HEIGHT (BITMAPHEIGHT SOURCE))
(WIDTH (BITMAPWIDTH SOURCE)))
(for Y from 0 to (SUB1 HEIGHT) do (BITBLT SOURCE 0 Y SCRATCH 0 (QUOTIENT Y SCALE)
WIDTH 1 'INPUT 'PAINT))
(for X from 0 to (SUB1 WIDTH) do (BITBLT SCRATCH X 0 DESTINATION (QUOTIENT X SCALE)
0 1 HEIGHT 'INPUT 'PAINT]
DESTINATION])
(MONITOR.SEND.BITMAP
[LAMBDA (COURIERSTREAM PROGRAM PROCEDURE SCALE REGION BULK.DATA.STREAM)
(* ; "Edited 14-Mar-88 11:37 by cdl")
[LET ((SCRATCH.BITMAP (ASSOC SCALE MONITOR.SCRATCH.BITMAPS)))
[if (NULL SCRATCH.BITMAP)
then (push MONITOR.SCRATCH.BITMAPS (SETQ SCRATCH.BITMAP
(with REGION WHOLESCREEN
(create MONITOR.SCRATCH.BITMAP
BITMAPSCALE _ SCALE
DESTINATION _ (BITMAPCREATE
(QUOTIENT WIDTH SCALE)
(QUOTIENT HEIGHT SCALE))
SCRATCH _ (BITMAPCREATE WIDTH
(QUOTIENT HEIGHT SCALE
]
(with MONITOR.SCRATCH.BITMAP SCRATCH.BITMAP (if REGION
then (BLTSHADE WHITESHADE DESTINATION)
(with REGION REGION
(BITBLT (SCREENBITMAP)
LEFT BOTTOM DESTINATION))
(WRITEBM BULK.DATA.STREAM DESTINATION)
else (WRITEBM BULK.DATA.STREAM
(MONITOR.SHRINK.BITMAP (
SCREENBITMAP
)
SCALE DESTINATION SCRATCH]
'(RETURN])
)
(COURIERPROGRAM MONITOR (1118 0)
TYPES
((SCALE INTEGER)
(REGION (SEQUENCE INTEGER)))
PROCEDURES
((SEND.BITMAP 0 (SCALE REGION BULK.DATA.SINK)
RETURNS NIL REPORTS NIL IMPLEMENTEDBY MONITOR.SEND.BITMAP))
ERRORS
NIL)
(RPAQ? MONITOR.SCALE 3)
(RPAQ? MONITOR.SCRATCH.BITMAPS NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MONITOR.SCALE MONITOR.SCRATCH.BITMAPS)
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD MONITOR.SCRATCH.BITMAP (BITMAPSCALE DESTINATION SCRATCH))
)
)
(FILESLOAD COURIERSERVE BITMAPFNS)
(COURIER.START.SERVER)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1029 9390 (MONITOR 1039 . 3201) (MONITOR.GET.BITMAP 3203 . 3685) (MONITOR.BUTTONEVENTFN
3687 . 6211) (MONITOR.SHRINK.BITMAP 6213 . 7126) (MONITOR.SEND.BITMAP 7128 . 9388)))))
STOP