(FILECREATED "16-Feb-86 00:14:45" {ERIS}<LISPCORE>LIBRARY>DANDELIONUFO.;24 11913
changes to: (VARS DANDELIONUFOCOMS \DANDELIONUFO.LOCKEDFNS)
(FNS \DANDELIONUFO.WRITE \DANDELIONUFO.SENDPAGE)
previous date: "15-Feb-86 12:35:33" {ERIS}<LISPCORE>LIBRARY>DANDELIONUFO.;23)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DANDELIONUFOCOMS)
(RPAQQ DANDELIONUFOCOMS ((* DANDELIONUFO -- Driver for the UFO systems Dandelion BusMaster color
board -- By Kelly Roach and Herb Jellinek. *)
(CONSTANTS (NYBBLESPERWORD 4)
(BITSPERNYBBLE 4)
(\PCColorMapBase 917520)
(\RochesterDisplayBase 917504)
(\RochesterDisplayOffsetRegister 917552)
(\RochesterDisplayOffsetRegisterLo 917553)
(\RochesterBUSADDRHI 8)
(\RochesterBUSADDRLO 0)
(\RochesterPIXELSPERPAGE 1024)
(\RochesterRASTERWIDTH 160))
(FNS \DANDELIONUFO.WRITE)
(FNS \DANDELIONUFO.INIT \DANDELIONUFO.STARTBOARD
\DANDELIONUFO.SENDCOLORMAPENTRY \DANDELIONUFO.SENDPAGE
\DANDELIONUFO.PILOTBITBLT)
(FILES BUSCOLOR)
(VARS \DANDELIONUFO.LOCKEDFNS)
(DECLARE: DONTEVAL@COMPILE DOCOPY (P (\DANDELIONUFO.INIT)))))
(* DANDELIONUFO -- Driver for the UFO systems Dandelion BusMaster color board -- By Kelly
Roach and Herb Jellinek. *)
(DECLARE: EVAL@COMPILE
(RPAQQ NYBBLESPERWORD 4)
(RPAQQ BITSPERNYBBLE 4)
(RPAQQ \PCColorMapBase 917520)
(RPAQQ \RochesterDisplayBase 917504)
(RPAQQ \RochesterDisplayOffsetRegister 917552)
(RPAQQ \RochesterDisplayOffsetRegisterLo 917553)
(RPAQQ \RochesterBUSADDRHI 8)
(RPAQQ \RochesterBUSADDRLO 0)
(RPAQQ \RochesterPIXELSPERPAGE 1024)
(RPAQQ \RochesterRASTERWIDTH 160)
(CONSTANTS (NYBBLESPERWORD 4)
(BITSPERNYBBLE 4)
(\PCColorMapBase 917520)
(\RochesterDisplayBase 917504)
(\RochesterDisplayOffsetRegister 917552)
(\RochesterDisplayOffsetRegisterLo 917553)
(\RochesterBUSADDRHI 8)
(\RochesterBUSADDRLO 0)
(\RochesterPIXELSPERPAGE 1024)
(\RochesterRASTERWIDTH 160))
)
(DEFINEQ
(\DANDELIONUFO.WRITE
(LAMBDA (A D) (* kbr:
" 4-Feb-86 17:24")
(PCBUS.WRITE (IPLUS 917504 A)
D)))
)
(DEFINEQ
(\DANDELIONUFO.INIT
(LAMBDA NIL (* kbr:
"15-Feb-86 12:32")
(DECLARE (GLOBALVARS \DANDELIONUFOWSOPS \DANDELIONUFOINFO))
(for FN in \DANDELIONUFO.LOCKEDFNS do (\LOCKFN FN))
(SETQ \DANDELIONUFOWSOPS (create WSOPS
STARTBOARD ←(FUNCTION \DANDELIONUFO.STARTBOARD)
STARTCOLOR ←(FUNCTION \BUSCOLOR.STARTCOLOR)
STOPCOLOR ←(FUNCTION \BUSCOLOR.STOPCOLOR)
EVENTFN ←(FUNCTION \BUSCOLOR.EVENTFN)
SENDCOLORMAPENTRY ←(FUNCTION \DANDELIONUFO.SENDCOLORMAPENTRY)
SENDPAGE ←(FUNCTION \DANDELIONUFO.SENDPAGE)
PILOTBITBLT ←(FUNCTION \DANDELIONUFO.PILOTBITBLT)))
(SETQ \DANDELIONUFOINFO (create DISPLAYINFO
DITYPE ←(QUOTE DANDELIONUFO)
DIWIDTH ← 640
DIHEIGHT ← 400
DIBITSPERPIXEL ← 4
DIWSOPS ← \DANDELIONUFOWSOPS))
(\DEFINEDISPLAYINFO \DANDELIONUFOINFO)))
(\DANDELIONUFO.STARTBOARD
(LAMBDA NIL (* kbr:
"25-Aug-85 16:23")
(\DANDELIONUFO.WRITE 1 0)
(\DANDELIONUFO.WRITE 1 0)
(\DANDELIONUFO.WRITE 1 16)
(\DANDELIONUFO.WRITE 0 24)
(\DANDELIONUFO.WRITE 0 (SELECTQ COLORMONITORTYPE
((NIL CONRAC)
10)
(HITACHI 11)
(ERROR "ILLEGAL ARG" COLORMONITORTYPE)))
(\DANDELIONUFO.WRITE 0 25)
(\DANDELIONUFO.WRITE 0 43)
(\DANDELIONUFO.WRITE 0 227)
(\DANDELIONUFO.WRITE 0 39)
(\DANDELIONUFO.WRITE 0 0)
(\DANDELIONUFO.WRITE 0 0)
(\DANDELIONUFO.WRITE 0 0)
(\DANDELIONUFO.WRITE 0 0)
(\DANDELIONUFO.WRITE 0 0)
(\DANDELIONUFO.WRITE 1 63)
(\DANDELIONUFO.WRITE 2 1)
(\DANDELIONUFO.WRITE 3 0)
(\DANDELIONUFO.WRITE 32 8)
(\DANDELIONUFO.WRITE 48 0)
(\DANDELIONUFO.WRITE 49 0)))
(\DANDELIONUFO.SENDCOLORMAPENTRY
(LAMBDA (FDEV COLOR# RGB) (* kbr:
" 4-Feb-86 17:22")
(* sends the Ith entry
of the colormap COLORMAP
to the extension bus.)
(PROG (LUT)
(SETQ LUT (LOGXOR 63 (LOGOR 128 (LLSH (LRSH (fetch (RGB BLUE) of RGB)
6)
4)
(LLSH (LRSH (fetch (RGB GREEN) of RGB)
6)
2)
(LRSH (fetch (RGB RED) of RGB)
6))))
(PCBUS.WRITE (IPLUS \PCColorMapBase COLOR#)
LUT))))
(\DANDELIONUFO.SENDPAGE
(LAMBDA (PAGE PAGE#) (* kbr:
"16-Feb-86 00:14")
(PROG (DISPINTERRUPT)
(SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0))
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(PCBUS.WRITEHL 14 48 (LLSH (LOGAND PAGE# 3)
6))
(PCBUS.WRITEHL 14 49 (LRSH PAGE# 2)) (* ((1024 pixels /
page) / (16 pixels /
offset)) = 64 offsets /
page)
(\BUSBLTOUTNYBBLES PAGE \RochesterBUSADDRHI \RochesterBUSADDRLO WORDSPERPAGE)
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT))))
(\DANDELIONUFO.PILOTBITBLT
(LAMBDA (PILOTBBT N) (* kbr:
" 4-Feb-86 17:23")
(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 48 (LLSH (LOGAND CURRPAGEINBITMAP 3)
6))
(PCBUS.WRITEHL 14 49 (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 48 (LLSH (LOGAND CURRPAGEINBITMAP 3)
6))
(PCBUS.WRITEHL 14 49 (LRSH CURRPAGEINBITMAP 2)))))
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT))))
)
(FILESLOAD BUSCOLOR)
(RPAQQ \DANDELIONUFO.LOCKEDFNS (\DANDELIONUFO.PILOTBITBLT \DANDELIONUFO.SENDPAGE))
(DECLARE: DONTEVAL@COMPILE DOCOPY
(\DANDELIONUFO.INIT)
)
(PUTPROPS DANDELIONUFO COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2638 2904 (\DANDELIONUFO.WRITE 2648 . 2902)) (2905 11658 (\DANDELIONUFO.INIT 2915 .
4263) (\DANDELIONUFO.STARTBOARD 4265 . 5304) (\DANDELIONUFO.SENDCOLORMAPENTRY 5306 . 6388) (
\DANDELIONUFO.SENDPAGE 6390 . 7342) (\DANDELIONUFO.PILOTBITBLT 7344 . 11656)))))
STOP