(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