-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathDANDELIONUFO4096
278 lines (239 loc) · 14.6 KB
/
DANDELIONUFO4096
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
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
(FILECREATED " 5-Jun-86 23:23:29" {ERIS}<LISPCORE>LIBRARY>DANDELIONUFO4096.;19 14610
changes to: (FNS \DANDELIONUFO4096.SENDCOLORMAPENTRY \DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL
)
(VARS DANDELIONUFO4096COMS)
previous date: " 5-Jun-86 21:19:03" {ERIS}<LISPCORE>LIBRARY>DANDELIONUFO4096.;18)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DANDELIONUFO4096COMS)
(RPAQQ DANDELIONUFO4096COMS ((* * DANDELIONUFO4096 -- Driver for the old version of UFO systems
Dandelion BusMaster color board -- By Kelly Roach and Herb Jellinek.
*)
(CONSTANTS (NYBBLESPERWORD 4)
(BITSPERNYBBLE 4)
(\PCColorMapRedBase 917568)
(\PCColorMapGreenBase 917584)
(\PCColorMapBlueBase 917600)
(\RochesterDisplayBase 917504)
(\RochesterDisplayOffsetRegister.4096 917696)
(\RochesterBUSADDRHI 8)
(\RochesterBUSADDRLO 0)
(\RochesterPIXELSPERPAGE 1024)
(\RochesterRASTERWIDTH 160)
(DDLPIXELSPERPAGE 1024)
(DDLPIXELSPERWORD 4))
(FNS \DANDELIONUFO4096.WRITE)
(FNS \DANDELIONUFO4096.INIT \DANDELIONUFO4096.STARTBOARD
\DANDELIONUFO4096.SENDCOLORMAPENTRY
\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL
\DANDELIONUFO4096.SENDPAGE \DANDELIONUFO4096.PILOTBITBLT)
(FILES BUSCOLOR)
(VARS \DANDELIONUFO4096.LOCKEDFNS)
(DECLARE: DONTEVAL@COMPILE DOCOPY (P (\DANDELIONUFO4096.INIT)))))
(* * DANDELIONUFO4096 -- Driver for the old version of UFO systems Dandelion BusMaster color
board -- By Kelly Roach and Herb Jellinek. *)
(DECLARE: EVAL@COMPILE
(RPAQQ NYBBLESPERWORD 4)
(RPAQQ BITSPERNYBBLE 4)
(RPAQQ \PCColorMapRedBase 917568)
(RPAQQ \PCColorMapGreenBase 917584)
(RPAQQ \PCColorMapBlueBase 917600)
(RPAQQ \RochesterDisplayBase 917504)
(RPAQQ \RochesterDisplayOffsetRegister.4096 917696)
(RPAQQ \RochesterBUSADDRHI 8)
(RPAQQ \RochesterBUSADDRLO 0)
(RPAQQ \RochesterPIXELSPERPAGE 1024)
(RPAQQ \RochesterRASTERWIDTH 160)
(RPAQQ DDLPIXELSPERPAGE 1024)
(RPAQQ DDLPIXELSPERWORD 4)
(CONSTANTS (NYBBLESPERWORD 4)
(BITSPERNYBBLE 4)
(\PCColorMapRedBase 917568)
(\PCColorMapGreenBase 917584)
(\PCColorMapBlueBase 917600)
(\RochesterDisplayBase 917504)
(\RochesterDisplayOffsetRegister.4096 917696)
(\RochesterBUSADDRHI 8)
(\RochesterBUSADDRLO 0)
(\RochesterPIXELSPERPAGE 1024)
(\RochesterRASTERWIDTH 160)
(DDLPIXELSPERPAGE 1024)
(DDLPIXELSPERWORD 4))
)
(DEFINEQ
(\DANDELIONUFO4096.WRITE
[LAMBDA (A D) (* N.H.Briggs "29-May-86 15:19")
(PCBUS.WRITE (IPLUS \RochesterDisplayBase A)
D])
)
(DEFINEQ
(\DANDELIONUFO4096.INIT
[LAMBDA NIL (* kbr: "15-Feb-86 12:42")
(DECLARE (GLOBALVARS \DANDELIONUFO4096WSOPS \DANDELIONUFO4096INFO))
(for FN in \DANDELIONUFO4096.LOCKEDFNS do (\LOCKFN FN))
[SETQ \DANDELIONUFO4096WSOPS (create WSOPS (SETQ STARTBOARD (FUNCTION
\DANDELIONUFO4096.STARTBOARD))
(SETQ STARTCOLOR (FUNCTION \BUSCOLOR.STARTCOLOR))
(SETQ STOPCOLOR (FUNCTION \BUSCOLOR.STOPCOLOR))
(SETQ EVENTFN (FUNCTION \BUSCOLOR.EVENTFN))
(SETQ SENDCOLORMAPENTRY (FUNCTION
\DANDELIONUFO4096.SENDCOLORMAPENTRY))
(SETQ SENDPAGE (FUNCTION \DANDELIONUFO4096.SENDPAGE))
(SETQ PILOTBITBLT (FUNCTION
\DANDELIONUFO4096.PILOTBITBLT]
(SETQ \DANDELIONUFO4096INFO (create DISPLAYINFO
DITYPE _ (QUOTE DANDELIONUFO4096)
DIWIDTH _ 640
DIHEIGHT _ 400
DIBITSPERPIXEL _ 4
DIWSOPS _ \DANDELIONUFO4096WSOPS))
(\DEFINEDISPLAYINFO \DANDELIONUFO4096INFO])
(\DANDELIONUFO4096.STARTBOARD
[LAMBDA (DISPLAY) (* N.H.Briggs "29-May-86 15:24")
(* * the ufo4096 card uses a Signetics 2672 programmable video timing controller. See the Signetics databook for
details)
(* * offsets (write): initialization = 0; command = 1; screen start lower = 2; screen start upper = 3;
cursor address lower = 4; cursor address upper = 5; display pointer address lower = 6; display pointer address
upper = 7)
(\DANDELIONUFO4096.WRITE 1 0) (* master reset)
(\DANDELIONUFO4096.WRITE 1 0) (* master reset)
(\DANDELIONUFO4096.WRITE 1 16) (* load IR ptr with 0 (ten values follow))
(\DANDELIONUFO4096.WRITE 0 24) (* non-interlaced 4 lines, vsync, buffer mode
independent)
(\DANDELIONUFO4096.WRITE 0 (SELECTQ COLORMONITORTYPE
((NIL CONRAC)
10)
(HITACHI 11)
(ERROR "ILLEGAL ARG" COLORMONITORTYPE)))
(* equalizing constant EC = .5
(Hact+Hfp+Hsync+Hbp) -2 (Hsync))
(\DANDELIONUFO4096.WRITE 0 25) (* Hsync width = 8, H back porch = 1)
(\DANDELIONUFO4096.WRITE 0 43) (* V front porch = 8 scan lines, V back porch = 26
scan lines)
(\DANDELIONUFO4096.WRITE 0 227) (* Char blink = 1/32 Vsync, 100 active rows per
screen)
(\DANDELIONUFO4096.WRITE 0 39) (* 39 active "characters" per row)
(\DANDELIONUFO4096.WRITE 0 0) (* cursor first line 0, last line 0
(don't care))
(\DANDELIONUFO4096.WRITE 0 0) (* lightpen line 0, no cursor blink, single height
chars, underline position scan line 0
(don't care))
(\DANDELIONUFO4096.WRITE 0 0) (* display buffer first address least significant bits
= 0)
(\DANDELIONUFO4096.WRITE 0 0) (* display buffer last address
(0) = 1023, display buffer first address most
significant bits = 0)
(\DANDELIONUFO4096.WRITE 0 0) (* cursor blink rate = 1/32 Vsync, split screen
interrupt row 0 (don't care))
(\DANDELIONUFO4096.WRITE 1 63) (* enable light pen, display on next field, cursor on)
(\DANDELIONUFO4096.WRITE 2 1) (* screen start address lower register = 1)
(\DANDELIONUFO4096.WRITE 3 0) (* screen start address upper register = 0)
(\DANDELIONUFO4096.WRITE 128 8) (* video control register = 8)
(\DANDELIONUFO4096.WRITE 192 0) (* address offset register low = 0)
(\DANDELIONUFO4096.WRITE 193 0) (* address offset register high = 0)
])
(\DANDELIONUFO4096.SENDCOLORMAPENTRY
(LAMBDA (FDEV COLOR ACTUALRGB) (* kbr: " 5-Jun-86 23:16")
(* sends the Ith entry of the colormap
COLORMAP to the extension bus.)
(PROG (HLS RGB)
(SETQ HLS (RGBTOHLS ACTUALRGB))
(replace (HLS LIGHTNESS) of HLS with (FMAX (fetch (HLS LIGHTNESS) of HLS)
.6))
(SETQ RGB (HLSTORGB HLS))
(PCBUS.WRITE (IPLUS \PCColorMapRedBase COLOR)
(\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL (fetch (RGB RED) of RGB)))
(PCBUS.WRITE (IPLUS \PCColorMapGreenBase COLOR)
(\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL (fetch (RGB GREEN) of RGB)))
(PCBUS.WRITE (IPLUS \PCColorMapBlueBase COLOR)
(\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL (fetch (RGB BLUE) of RGB))))))
(\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL
(LAMBDA (COLOR) (* kbr: " 5-Jun-86 23:14")
(PROG (ANSWER)
(RETURN (FOLDLO COLOR 16))
(SETQ ANSWER (IMIN HIGHFUDGE (IMAX (FOLDLO COLOR 16)
LOWFUDGE)))
(RETURN ANSWER))))
(\DANDELIONUFO4096.SENDPAGE
[LAMBDA (PAGE PAGE#) (* kbr: "16-Feb-86 00:17")
(PROG (DISPINTERRUPT)
(SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0))
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(PCBUS.WRITE \RochesterDisplayOffsetRegister.4096 (LLSH (LOGAND PAGE# 3)
6))
(PCBUS.WRITE (ADD1 \RochesterDisplayOffsetRegister.4096)
(LRSH PAGE# 2)) (* ((1024 pixels / page) /
(16 pixels / offset)) = 64 offsets / page)
(\BUSBLTOUTNYBBLES PAGE \RochesterBUSADDRHI \RochesterBUSADDRLO WORDSPERPAGE)
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT])
(\DANDELIONUFO4096.PILOTBITBLT
(LAMBDA (PILOTBBT N) (* kbr: " 5-Jun-86 21:17")
(PROG (DEST DESTBIT WIDTH HEIGHT BUSADDRHI BUSADDRLO NWORDS ABSCURRPAGE CURRPAGEINBITMAP
DISPINTERRUPT)
(* The busmaster UPDATEDAEMON is a narrow communication bottleneck from the
color screen bitmap to the color frame buffer.
We work around this bottleneck by communicating small important changes to the
color screen bitmap quickly and big less important changes slower.
*)
(* We try to make small changes that cross lots of pages appear visible in the
frame buffer quickly by writing to both color screen bitmap and frame buffer.
Big changes, which could be overwritten by other big changes before the
UPDATEDAEMON notices them (and so save us time this way) are best left to the
UPDATEDAEMON to handle. *)
(* First, output to the color screen
bitmap. *)
(\PILOTBITBLT PILOTBBT N)
(* Probably a case worth optimizing: cursors, carets, characters, vertical
drawlines, and vertical scroll bars. \BUSBLTOUTNYBBLES works in words, not
pixels (nybbles)%. We handle this problem by getting the values for our pixels
from the DEST we just did our \PILOTBITBLT to, slopping over to a few unchanged
pixels when necessary. *)
(SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0))(* \PUTBASE \EM.DISPINTERRUPT 0 0)
(SETQ DEST (fetch (PILOTBBT PBTDEST) of PILOTBBT))
(SETQ DESTBIT (fetch (PILOTBBT PBTDESTBIT) of PILOTBBT))
(SETQ WIDTH (fetch (PILOTBBT PBTWIDTH) of PILOTBBT))
(SETQ HEIGHT (fetch (PILOTBBT PBTHEIGHT) of PILOTBBT))
(SETQ ABSCURRPAGE (fetch (POINTER PAGE#) of DEST))
(SETQ CURRPAGEINBITMAP (IDIFFERENCE ABSCURRPAGE ColorScreenBitMapBasePage))
(SETQ NWORDS (IPLUS (FOLDHI (IPLUS DESTBIT WIDTH -1)
BITSPERWORD)
(IMINUS (FOLDLO DESTBIT BITSPERWORD))
1))
(SETQ BUSADDRLO (UNFOLD (IPLUS (fetch (POINTER WORDINPAGE) of DEST)
(FOLDLO DESTBIT BITSPERWORD))
NYBBLESPERWORD))
(SETQ DEST (\ADDBASE DEST (FOLDLO DESTBIT BITSPERWORD)))
(PCBUS.WRITEHL 14 192 (LLSH (LOGAND CURRPAGEINBITMAP 3)
6))
(PCBUS.WRITEHL 14 193 (LRSH CURRPAGEINBITMAP 2))
(for I from 1 to HEIGHT do (\BUSBLTOUTNYBBLES DEST \RochesterBUSADDRHI BUSADDRLO NWORDS)
(COND
((EQ I HEIGHT)
(RETURN)))
(SETQ DEST (\ADDBASE DEST \RochesterRASTERWIDTH))
(SETQ BUSADDRLO (IPLUS BUSADDRLO (UNFOLD \RochesterRASTERWIDTH
NYBBLESPERWORD)))
(COND
((IGEQ BUSADDRLO 32768)
(* Can't let BUSADDRLO exceed
MAX.SMALLP. *)
(SETQ BUSADDRLO (IDIFFERENCE BUSADDRLO 32768))
(SETQ CURRPAGEINBITMAP (IPLUS CURRPAGEINBITMAP 32))
(PCBUS.WRITEHL 14 192 (LLSH (LOGAND CURRPAGEINBITMAP 3)
6))
(PCBUS.WRITEHL 14 193 (LRSH CURRPAGEINBITMAP 2)))))
(* \PUTBASE \EM.DISPINTERRUPT 0
DISPINTERRUPT)
)))
)
(FILESLOAD BUSCOLOR)
(RPAQQ \DANDELIONUFO4096.LOCKEDFNS (\DANDELIONUFO4096.PILOTBITBLT \DANDELIONUFO4096.SENDPAGE))
(DECLARE: DONTEVAL@COMPILE DOCOPY
(\DANDELIONUFO4096.INIT)
)
(PUTPROPS DANDELIONUFO4096 COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3245 3443 (\DANDELIONUFO4096.WRITE 3255 . 3441)) (3444 14335 (\DANDELIONUFO4096.INIT
3454 . 4603) (\DANDELIONUFO4096.STARTBOARD 4605 . 7879) (\DANDELIONUFO4096.SENDCOLORMAPENTRY 7881 .
8953) (\DANDELIONUFO4096.SENDCOLORMAPENTRY.LEVEL 8955 . 9302) (\DANDELIONUFO4096.SENDPAGE 9304 . 10005
) (\DANDELIONUFO4096.PILOTBITBLT 10007 . 14333)))))
STOP