(FILECREATED "24-Feb-86 12:32:26" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;27 15311
changes to: (VARS DORADOCOLORCOMS)
previous date: "15-Feb-86 16:46:20" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;26)
(* Copyright (c) 1985, 1900, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DORADOCOLORCOMS)
(RPAQQ DORADOCOLORCOMS ((* * DORADOCOLOR -- Dorado machine dependent color display fns -- By
Richard Burton, Herb Jellinek, and Kelly Roach.)
(DECLARE: DONTCOPY (RECORDS MonitorCB ChannelCB ColorCB ColorEntry)
(CONSTANTS (DORADO\COLORSCREENWIDTH 640)
(DORADO\COLORSCREENHEIGHT 480)
(DORADOCOLORPAGES 602)
(pplOffset 255)
(MCBPtr 268)
(MCBSeal 65326)
(MCBLow 160)
(MCBSize 8)
(AFlagsMask 4)
(ChCBLow 168)
(ChCBSize 8)
(ColCBLow 176)
(ColCBSize 16)
(CMapPages 8)))
(* * \DORADOCOLOR.LEFTMARGIN should be set to 80 for small CONRACs, 56
for large CONRACs, and 40 for most other monitors. *)
(INITVARS (\DORADOCOLOR.LEFTMARGIN 80)
(\DORADOCOLOR.ATABLEIMAGE NIL)
(DORADOCOLOR.BITSPERPIXEL 8))
(GLOBALVARS \DORADOCOLOR.ATABLEIMAGE \DORADOCOLOR.LEFTMARGIN
DORADOCOLOR.BITSPERPIXEL)
(FNS \RGB.TO.DORADO.RGB \DORADOCOLOR.LOOKATA)
(FNS \DORADOCOLOR.INIT \DORADOCOLOR.STARTCOLOR \DORADOCOLOR.STOPCOLOR
\DORADOCOLOR.EVENTFN \DORADOCOLOR.SENDCOLORMAPENTRY)
(FNS \DORADOCOLOR.COLORLEVEL \DORADOCOLOR.SETONECOLOR)
(FILES COLOR)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\DORADOCOLOR.INIT)))))
(* * DORADOCOLOR -- Dorado machine dependent color display fns -- By Richard Burton, Herb
Jellinek, and Kelly Roach.)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD MonitorCB ((Seal WORD)
(Flags WORD)
(ACB WORD)
(NIL WORD)
(colorCB WORD)))
(BLOCKRECORD ChannelCB ((NIL WORD)
(wordsPerLine WORD)
(bitmapLo WORD)
(bitmapHi WORD)
(linesPerField WORD)
(pixelsPerLine WORD)
(leftMargin WORD)
(scan WORD)))
(BLOCKRECORD ColorCB ((ATableLo WORD)
(ATableHi WORD)
(NIL 6 WORD)
(VBtoVS BYTE)
(VStoVS BYTE)
(VStoVB WORD)
(VisibleLines WORD)
(X WORD)
(W BYTE)
(A BYTE)
(BtoA WORD)
(clockm BITS 12)
(clockd BITS 4)
(NIL WORD)))
(BLOCKRECORD ColorEntry ((NIL BITS 4)
(RedLo BITS 4)
(Blue BYTE)
(NIL BITS 4)
(Green BITS 8)
(RedHi BITS 4)))
]
(DECLARE: EVAL@COMPILE
(RPAQQ DORADO\COLORSCREENWIDTH 640)
(RPAQQ DORADO\COLORSCREENHEIGHT 480)
(RPAQQ DORADOCOLORPAGES 602)
(RPAQQ pplOffset 255)
(RPAQQ MCBPtr 268)
(RPAQQ MCBSeal 65326)
(RPAQQ MCBLow 160)
(RPAQQ MCBSize 8)
(RPAQQ AFlagsMask 4)
(RPAQQ ChCBLow 168)
(RPAQQ ChCBSize 8)
(RPAQQ ColCBLow 176)
(RPAQQ ColCBSize 16)
(RPAQQ CMapPages 8)
(CONSTANTS (DORADO\COLORSCREENWIDTH 640)
(DORADO\COLORSCREENHEIGHT 480)
(DORADOCOLORPAGES 602)
(pplOffset 255)
(MCBPtr 268)
(MCBSeal 65326)
(MCBLow 160)
(MCBSize 8)
(AFlagsMask 4)
(ChCBLow 168)
(ChCBSize 8)
(ColCBLow 176)
(ColCBSize 16)
(CMapPages 8))
)
)
(* * \DORADOCOLOR.LEFTMARGIN should be set to 80 for small CONRACs, 56 for large CONRACs, and
40 for most other monitors. *)
(RPAQ? \DORADOCOLOR.LEFTMARGIN 80)
(RPAQ? \DORADOCOLOR.ATABLEIMAGE NIL)
(RPAQ? DORADOCOLOR.BITSPERPIXEL 8)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DORADOCOLOR.ATABLEIMAGE \DORADOCOLOR.LEFTMARGIN DORADOCOLOR.BITSPERPIXEL)
)
(DEFINEQ
(\RGB.TO.DORADO.RGB
(LAMBDA (RGB ColorEntryBox) (* kbr: " 5-Jul-85 15:08")
(PROG (ColorEntry)
(SETQ ColorEntry (OR ColorEntryBox (\ALLOCBLOCK 1)))
(replace (ColorEntry Blue) of ColorEntry with (fetch (RGB BLUE) of RGB))
(replace (ColorEntry Green) of ColorEntry with (fetch (RGB GREEN) of RGB))
(replace (ColorEntry RedLo) of ColorEntry with (LOGAND (fetch (RGB RED) of RGB)
15))
(replace (ColorEntry RedHi) of ColorEntry with (LRSH (fetch (RGB RED) of RGB)
4))
(RETURN ColorEntry))))
(\DORADOCOLOR.LOOKATA
(LAMBDA (MCB) (* kbr: " 5-Jul-85 16:04")
(replace (MonitorCB Flags) of MCB with (LOGOR AFlagsMask (fetch (MonitorCB Flags) of MCB)))
(while (EQ AFlagsMask (LOGAND AFlagsMask (fetch (MonitorCB Flags) of MCB)))
do (* wait for microcode to notice)
(BLOCK))))
)
(DEFINEQ
(\DORADOCOLOR.INIT
(LAMBDA NIL (* kbr:
"15-Feb-86 13:01")
(DECLARE (GLOBALVARS \DORADOCOLORWSOPS \DORADOCOLORINFO))
(SETQ \DORADOCOLORWSOPS (create WSOPS
STARTBOARD ←(FUNCTION NILL)
STARTCOLOR ←(FUNCTION \DORADOCOLOR.STARTCOLOR)
STOPCOLOR ←(FUNCTION \DORADOCOLOR.STOPCOLOR)
EVENTFN ←(FUNCTION \DORADOCOLOR.EVENTFN)
SENDCOLORMAPENTRY ←(FUNCTION \DORADOCOLOR.SENDCOLORMAPENTRY)
SENDPAGE ←(FUNCTION NILL)
PILOTBITBLT ←(FUNCTION \DISPLAY.PILOTBITBLT)))
(SETQ \DORADOCOLORINFO (create DISPLAYINFO
DITYPE ←(QUOTE DORADOCOLOR)
DIWIDTH ← DORADO\COLORSCREENWIDTH
DIHEIGHT ← DORADO\COLORSCREENHEIGHT
DIBITSPERPIXEL ← 8
DIWSOPS ← \DORADOCOLORWSOPS))
(\DEFINEDISPLAYINFO \DORADOCOLORINFO)))
(\DORADOCOLOR.STARTCOLOR
(LAMBDA (FDEV) (* kbr: "21-Aug-85 15:55")
(DECLARE (GLOBALVARS \DORADOCOLOR.LEFTMARGIN DORADOCOLOR.BITSPERPIXEL))
(PROG (DISPLAYSTATE MCB AC CB)
(COND
((EQ (MACHINETYPE)
(QUOTE DORADO))
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with (QUOTE STARTCOLOR))
(MOVD (QUOTE \DISPLAY.PILOTBITBLT)
(QUOTE \SOFTCURSORPILOTBITBLT))
(\LOCKFN (QUOTE \SOFTCURSORPILOTBITBLT))
(SETQ MCB (EMADDRESS MCBLow))
(SETQ AC (EMADDRESS ChCBLow))
(SETQ CB (EMADDRESS ColCBLow))
(\ZEROWORDS MCB (\ADDBASE MCB MCBSize))
(\ZEROWORDS AC (\ADDBASE AC ChCBSize))
(\ZEROWORDS CB (\ADDBASE CB ColCBSize)) (* Set up color control block)
(OR \DORADOCOLOR.ATABLEIMAGE (SETQ \DORADOCOLOR.ATABLEIMAGE (\ALLOCBLOCK (ITIMES
CMapPages 128)
NIL 128)))
(\TEMPLOCKPAGES \DORADOCOLOR.ATABLEIMAGE CMapPages)
(replace (ColorCB ATableHi) of CB with (\HILOC \DORADOCOLOR.ATABLEIMAGE))
(* Reverse pointer)
(replace (ColorCB ATableLo) of CB with (\LOLOC \DORADOCOLOR.ATABLEIMAGE))
(replace (ColorCB VBtoVS) of CB with 3)
(replace (ColorCB VStoVS) of CB with 3)
(replace (ColorCB VStoVB) of CB with 16)
(replace (ColorCB VisibleLines) of CB with 240)
(replace (ColorCB X) of CB with 379)
(replace (ColorCB W) of CB with 6)
(replace (ColorCB A) of CB with 35)
(replace (ColorCB BtoA) of CB with 18)
(replace (ColorCB clockm) of CB with 88)
(replace (ColorCB clockd) of CB with 12) (* set up channel control block)
(replace (ChannelCB wordsPerLine) of AC with (FOLDHI (ITIMES DORADO\COLORSCREENWIDTH
DORADOCOLOR.BITSPERPIXEL)
BITSPERWORD))
(SETQ ColorScreenBitMapBase (fetch (BITMAP BITMAPBASE) of ColorScreenBitMap))
(\TEMPLOCKPAGES ColorScreenBitMapBase DORADOCOLORPAGES)
(replace (ChannelCB bitmapHi) of AC with (\HILOC ColorScreenBitMapBase))
(replace (ChannelCB bitmapLo) of AC with (\LOLOC ColorScreenBitMapBase))
(replace (ChannelCB linesPerField) of AC with (IQUOTIENT DORADO\COLORSCREENHEIGHT 2))
(replace (ChannelCB pixelsPerLine) of AC with (IPLUS DORADO\COLORSCREENWIDTH pplOffset))
(replace (ChannelCB leftMargin) of AC with \DORADOCOLOR.LEFTMARGIN)
(replace (ChannelCB scan) of AC with (SELECTQ DORADOCOLOR.BITSPERPIXEL
(4
(* Magic constants = 164B)
116)
(8
(* Magic constants = 170B)
120)
(\ILLEGAL.ARG DORADOCOLOR.BITSPERPIXEL)))
(replace (MonitorCB Seal) of MCB with MCBSeal)
(replace (MonitorCB Flags) of MCB with 60)
(replace (MonitorCB ACB) of MCB with ChCBLow)
(* Wyatt used an empty A bitmap to establish scan mode.
Why? We dont)
(replace (MonitorCB colorCB) of MCB with ColCBLow)
(EMPUTBASE MCBPtr MCBLow)
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with (QUOTE ON)))))))
(\DORADOCOLOR.STOPCOLOR
(LAMBDA (FDEV) (* kbr: "21-Aug-85 15:56")
(PROG (DISPLAYSTATE MCB)
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with (QUOTE STOPCOLOR))
(SETQ MCB (EMADDRESS MCBLow))
(replace (MonitorCB ACB) of MCB with 0)
(\ZEROWORDS \DORADOCOLOR.ATABLEIMAGE (\ADDBASE \DORADOCOLOR.ATABLEIMAGE 32))
(* Black)
(\DORADOCOLOR.LOOKATA MCB)
(EMPUTBASE MCBPtr 0)
(\TEMPUNLOCKPAGES \DORADOCOLOR.ATABLEIMAGE CMapPages)
(\TEMPUNLOCKPAGES (fetch (BITMAP BITMAPBASE) of ColorScreenBitMap)
DORADOCOLORPAGES)
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with (QUOTE OFF)))))
(\DORADOCOLOR.EVENTFN
(LAMBDA (FDEV EVENT) (* kbr: "24-Aug-85 16:55")
(COND
((EQ (fetch (DISPLAYSTATE ONOFF) of (fetch (FDEV DEVICEINFO) of FDEV))
(QUOTE ON))
(SELECTQ EVENT
((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS)
(* turn off display since we may awake on different
machine)
(COLORDISPLAY (QUOTE OFF)))
(AFTERSAVEVM (* Rekick the color microcode.
*)
(\DORADOCOLOR.STARTCOLOR \COLORDISPLAYFDEV)
(SCREENCOLORMAP (SCREENCOLORMAP)))
NIL)))))
(\DORADOCOLOR.SENDCOLORMAPENTRY
(LAMBDA (FDEV COLOR# RGB) (* kbr: " 5-Jul-85 15:06")
(PROG (ScratchColorEntry J)
(SETQ ScratchColorEntry (\RGB.TO.DORADO.RGB (LIST 0 0 0)))
(OR \DORADOCOLOR.ATABLEIMAGE (SHOULDNT))
(SETQ J (ITIMES COLOR# 8))
(\RGB.TO.DORADO.RGB RGB ScratchColorEntry)
(\PUTBASE \DORADOCOLOR.ATABLEIMAGE J (\GETBASE ScratchColorEntry 0))
(\PUTBASE \DORADOCOLOR.ATABLEIMAGE (ADD1 J)
(\GETBASE ScratchColorEntry 1))
(\DORADOCOLOR.LOOKATA (EMADDRESS MCBLow)))))
)
(DEFINEQ
(\DORADOCOLOR.COLORLEVEL
(LAMBDA (DISPLAY COLOR# PRIMARYCOLOR NEWLEVEL) (* kbr: " 5-Jul-85 15:23")
(PROG (REALCOLOR# COLORMAP ColorEntry)
(SETQ REALCOLOR# (COLORNUMBERP COLOR#))
(SETQ COLORMAP (SCREENCOLORMAP NIL DISPLAY))
(SETQ ColorEntry (COLORMAPENTRY COLORMAP REALCOLOR#))
(PROG1 (\GENERIC.COLORLEVEL COLORMAP REALCOLOR# PRIMARYCOLOR NEWLEVEL)
(* destructively modifies ColorEntry entry of COLORMAP
to have correct level of PRIMARYCOLOR)
(\DORADOCOLOR.SETONECOLOR ColorEntry REALCOLOR#)))))
(\DORADOCOLOR.SETONECOLOR
(LAMBDA (RGBTRIPLE COLOR#) (* kbr: " 5-Jul-85 15:24")
(PROG (DORADOFORMATCOLORCELL J)
(OR \DORADOCOLOR.ATABLEIMAGE (SHOULDNT))
(SETQ DORADOFORMATCOLORCELL (\RGB.TO.DORADO.RGB RGBTRIPLE))
(SETQ J (LLSH COLOR# (IDIFFERENCE 11 DORADOCOLOR.BITSPERPIXEL)))
(\PUTBASE \DORADOCOLOR.ATABLEIMAGE J (\GETBASE DORADOFORMATCOLORCELL 0))
(\PUTBASE \DORADOCOLOR.ATABLEIMAGE (ADD1 J)
(\GETBASE DORADOFORMATCOLORCELL 1))
(\DORADOCOLOR.LOOKATA (EMADDRESS MCBLow)))))
)
(FILESLOAD COLOR)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\DORADOCOLOR.INIT)
)
(PUTPROPS DORADOCOLOR COPYRIGHT ("Xerox Corporation" 1985 1900 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5142 6333 (\RGB.TO.DORADO.RGB 5152 . 5872) (\DORADOCOLOR.LOOKATA 5874 . 6331)) (6334
13812 (\DORADOCOLOR.INIT 6344 . 7610) (\DORADOCOLOR.STARTCOLOR 7612 . 11482) (\DORADOCOLOR.STOPCOLOR
11484 . 12431) (\DORADOCOLOR.EVENTFN 12433 . 13153) (\DORADOCOLOR.SENDCOLORMAPENTRY 13155 . 13810)) (
13813 15147 (\DORADOCOLOR.COLORLEVEL 13823 . 14500) (\DORADOCOLOR.SETONECOLOR 14502 . 15145)))))
STOP