(FILECREATED " 8-Jul-85 11:44:38" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;18 16623
changes to: (VARS DORADOCOLORCOMS)
previous date: " 3-Jul-85 11:56:21" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;17)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DORADOCOLORCOMS)
(RPAQQ DORADOCOLORCOMS [[COMS (* Dorado machine dependent color display fns)
(FNS (* preserved for historical reasons)
\CREATE.DORADOCOLORMAP)
(FNS \DORADOINITCOLOR \RGB.TO.DORADO.RGB)
(FNS \DORADO\STARTCOLOR \DORADO\STOPCOLOR \DORADO\SETSCREENCOLORMAP
\DORADOCOLORLEVEL \DORADOROTATECOLORMAP \DORADO\SETONECOLOR)
(FNS \DORADO\LOOKATA \DORADO\MAKEATABLE)
(FNS \DORADOCOLOR.EVENTFN)
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\DORADO\ATABLEIMAGE)))
(INITVARS (DORADO.COLORDISPLAY.LEFTMARGIN 56))
(GLOBALVARS \DORADO\ATABLEIMAGE)
(DECLARE: DONTCOPY (RECORDS MonitorCB ChannelCB ColorCB ColorEntry)
(CONSTANTS (pplOffset 255)
(MCBPtr 268)
(MCBSeal 65326)
(MCBLow 160)
(MCBSize 8)
(AFlagsMask 4)
(ChCBLow 168)
(ChCBSize 8)
(ColCBLow 176)
(ColCBSize 16)
(CMapPages 8]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\DORADOINITCOLOR)
(\CREATEDISPLAY (QUOTE DORADOCOLORDISPLAY)
\DORADOWSOPS \DORADOWSDATA
(FUNCTION
\DORADOCOLOR.EVENTFN])
(* Dorado machine dependent color display fns)
(DEFINEQ
(\CREATE.DORADOCOLORMAP
[LAMBDA (INTENSITIES BITSPERPIXEL) (* hdj "19-Jun-85 16:08")
(* creates a color map. Starts with a reasonable color
set. COLORMAPS must be on multiple of 16 word
boundaries for D0 hardware.)
(SELECTQ (OR BITSPERPIXEL \COLORDISPLAYBITSPERPIXEL)
(4 (PROG ((CMAP (create 4BITCOLORMAP)))
(for I from 0 to 15 as COLORS in (OR (LISTP (OR INTENSITIES
\DEFAULTCOLORINTENSITIES))
(\ILLEGAL.ARG INTENSITIES))
do (SETCOLORINTENSITY CMAP I COLORS))
(RETURN CMAP)))
(8 (PROG ((CMAP (create 8BITCOLORMAPP)))
(* 8BITCOLORMAPP is a datatype of one pointer to a block of 384 words. This extra indirection is because datatypes
can%'t be more than 256 words.)
(* make the lowest 16 colors the same as in the 4 bit
case)
(for I from 0 to 255 as COLORS in (OR (LISTP (OR INTENSITIES (APPEND
\DEFAULTCOLORINTENSITIES
\DEFAULT8BITCOLORINTENSITIES)))
(\ILLEGAL.ARG INTENSITIES))
do (SETCOLORINTENSITY CMAP I COLORS))
(RETURN CMAP)))
(\ILLEGAL.ARG BITSPERPIXEL])
)
(DEFINEQ
(\DORADOINITCOLOR
[LAMBDA NIL (* hdj "20-Jun-85 12:35")
(DECLARE (GLOBALVARS \DORADOWSOPS \DORADOWSDATA))
(SETQ \DORADOWSOPS (create WSOPS
WSCHANGEBACKGROUND ←(FUNCTION COLORBACKGROUND)
WSCHANGEBACKGROUNDBORDER ←(FUNCTION NILL)
WSDISPLAYHEIGHT ←(FUNCTION NILL)
STARTCOLOR ←(FUNCTION \DORADO\STARTCOLOR)
STOPCOLOR ←(FUNCTION \DORADO\STOPCOLOR)
SETSCREENCOLORMAP ←(FUNCTION \DORADO\SETSCREENCOLORMAP)
COLORLEVEL ←(FUNCTION \DORADOCOLORLEVEL)
ROTATECOLORMAP ←(FUNCTION \DORADOROTATECOLORMAP)))
(SETQ \DORADOWSDATA
(create WSDATA
WSDESTINATION ← ColorScreenBitMap
WSREGION ←(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 640
HEIGHT ← 480)
WSBACKGROUND ← 0
WSCOLORMAP ← NIL])
(\RGB.TO.DORADO.RGB
[LAMBDA (RGB ColorEntryBox) (* hdj "18-Jun-85 22:01")
(LET [(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))
ColorEntry])
)
(DEFINEQ
(\DORADO\STARTCOLOR
[LAMBDA (DISPLAY COLORMAP PTRTOBITS BITSPP) (* hdj " 2-Jul-85 14:05")
(DECLARE (GLOBALVARS DORADO.COLORDISPLAY.LEFTMARGIN))
(if (NEQ \MACHINETYPE \DORADO)
then (ERROR "Can't run Dorado color on a" (MACHINETYPE)))
(PROG ((MCB (EMADDRESS MCBLow))
(AC (EMADDRESS ChCBLow))
(CB (EMADDRESS ColCBLow)))
(\ZEROWORDS MCB (\ADDBASE MCB MCBSize))
(\ZEROWORDS AC (\ADDBASE AC ChCBSize))
(\ZEROWORDS CB (\ADDBASE CB ColCBSize)) (* Set up color control block)
(OR \DORADO\ATABLEIMAGE (\DORADO\MAKEATABLE COLORMAP))
(* Cant SCREENCOLOR map it til other structures are
set)
(\LOCKPAGES \DORADO\ATABLEIMAGE CMapPages)
(replace ATableHi of CB with (\HILOC \DORADO\ATABLEIMAGE))
(* Reverse pointer)
(replace ATableLo of CB with (\LOLOC \DORADO\ATABLEIMAGE))
(replace VBtoVS of CB with 3)
(replace VStoVS of CB with 3)
(replace VStoVB of CB with 16)
(replace VisibleLines of CB with 240)
(replace (ColorCB X) of CB with 379)
(replace W of CB with 6)
(replace A of CB with 35)
(replace BtoA of CB with 18)
(replace clockm of CB with 88)
(replace clockd of CB with 12) (* set up channel control block)
(replace wordsPerLine of AC with (FOLDHI (ITIMES COLORSCREENWIDTH BITSPP)
BITSPERWORD))
(replace bitmapHi of AC with (HILOC PTRTOBITS))
(replace bitmapLo of AC with (LOLOC PTRTOBITS))
(replace linesPerField of AC with (IQUOTIENT COLORSCREENHEIGHT 2))
(replace pixelsPerLine of AC with (IPLUS COLORSCREENWIDTH pplOffset))
(replace leftMargin of AC with DORADO.COLORDISPLAY.LEFTMARGIN)
(replace scan of AC with (SELECTQ BITSPP
(4 (* Magic constants = 164B)
116)
(8 (* Magic constants = 170B)
120)
(\ILLEGAL.ARG BITSPP)))
(replace Seal of MCB with MCBSeal)
(replace Flags of MCB with 60)
(replace ACB of MCB with ChCBLow) (* Wyatt used an empty A bitmap to establish scan mode.
Why? We dont)
(replace colorCB of MCB with ColCBLow)
(EMPUTBASE MCBPtr MCBLow)
(SCREENCOLORMAP COLORMAP DISPLAY) (* Waits for ucode in \SETSCREENCOLORMAP)
(* Wyatt now installed the real AC)
NIL)
(replace (DISPLAYSTATE RUNNING?) of (fetch (FDEV DEVICEINFO) of DISPLAY) with T])
(\DORADO\STOPCOLOR
[LAMBDA (DEVICE) (* hdj "21-Jun-85 15:29")
(PROG ((MCB (EMADDRESS MCBLow)))
(replace ACB of MCB with 0)
(\ZEROWORDS \DORADO\ATABLEIMAGE (\ADDBASE \DORADO\ATABLEIMAGE 32))
(* Black)
(\DORADO\LOOKATA MCB)
(EMPUTBASE MCBPtr 0)
(\UNLOCKPAGES \DORADO\ATABLEIMAGE CMapPages)
(replace (DISPLAYSTATE RUNNING?) of (fetch (FDEV DEVICEINFO) of DEVICE) with NIL])
(\DORADO\SETSCREENCOLORMAP
[LAMBDA (DISPLAY COLORMAP) (* hdj "19-Jun-85 17:49")
(LET [(ScratchColorEntry (\RGB.TO.DORADO.RGB (LIST 0 0 0]
(OR \DORADO\ATABLEIMAGE (SHOULDNT))
(if (type? 4BITCOLORMAP COLORMAP)
then (for I from 0 to 15 as J from 0 by 128
do (* destructively modify ScratchColorEntry)
(\RGB.TO.DORADO.RGB (COLORMAPENTRY COLORMAP I)
ScratchColorEntry)
(\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE ScratchColorEntry 0))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE ScratchColorEntry 1)))
elseif (type? 8BITCOLORMAP COLORMAP)
then (for I from 0 to 255 as J from 0 by 8
do (\RGB.TO.DORADO.RGB (COLORMAPENTRY COLORMAP I)
ScratchColorEntry)
(\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE ScratchColorEntry 0))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE ScratchColorEntry 1)))
else (\ILLEGAL.ARG COLORMAP)))
(\DORADO\LOOKATA (EMADDRESS MCBLow])
(\DORADOCOLORLEVEL
[LAMBDA (DISPLAY COLOR# PRIMARYCOLOR NEWLEVEL) (* hdj "19-Jun-85 17:49")
(LET* ((REALCOLOR# (COLORNUMBERP COLOR#))
(COLORMAP (SCREENCOLORMAP NIL DISPLAY))
(ColorEntry (COLORMAPENTRY COLORMAP REALCOLOR#)))
(PROG1 (\GENERIC.COLORLEVEL COLORMAP REALCOLOR# PRIMARYCOLOR NEWLEVEL)
(* destructively modifies ColorEntry entry of COLORMAP
to have correct level of PRIMARYCOLOR)
(\DORADO\SETONECOLOR ColorEntry REALCOLOR#])
(\DORADOROTATECOLORMAP
[LAMBDA (DISPLAY COLORMAP STARTCOLOR THRUCOLOR) (* hdj "12-Mar-85 19:39")
(OR \DORADO\ATABLEIMAGE (SHOULDNT))
[PROG ((BITSPP (COLORMAPBITS COLORMAP))
TMP S0 S1)
(SETQ STARTCOLOR (COND
(STARTCOLOR (COLORNUMBERP STARTCOLOR))
(T 0)))
[SETQ THRUCOLOR (COND
(THRUCOLOR (COLORNUMBERP THRUCOLOR))
(T (SUB1 (EXPT 2 BITSPP]
[COND
((ILESSP THRUCOLOR STARTCOLOR)
(SETQ STARTCOLOR (PROG1 THRUCOLOR (SETQ THRUCOLOR STARTCOLOR]
(COND
((EQ BITSPP 4) (* uses constants for 16 colors.)
(SETQ TMP (LLSH THRUCOLOR 7))
(SETQ S0 (\GETBASE \DORADO\ATABLEIMAGE TMP))
(SETQ S1 (\GETBASE \DORADO\ATABLEIMAGE (ADD1 TMP)))
[for I from TMP to (LLSH (ADD1 STARTCOLOR)
7)
by -128
do (\PUTBASE \DORADO\ATABLEIMAGE I (\GETBASE \DORADO\ATABLEIMAGE (IDIFFERENCE I 128))
)
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 I)
(\GETBASE \DORADO\ATABLEIMAGE (IDIFFERENCE I 127]
(\PUTBASE \DORADO\ATABLEIMAGE (LLSH STARTCOLOR 7)
S0)
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 (LLSH STARTCOLOR 7))
S1))
(T (* uses constants for 8 bits per pixel color)
(SETQ TMP (LLSH THRUCOLOR 3))
(SETQ S0 (\GETBASE \DORADO\ATABLEIMAGE TMP))
(SETQ S1 (\GETBASE \DORADO\ATABLEIMAGE (ADD1 TMP)))
[for I from TMP to (LLSH (ADD1 STARTCOLOR)
3)
by -8
do (\PUTBASE \DORADO\ATABLEIMAGE I (\GETBASE \DORADO\ATABLEIMAGE (IDIFFERENCE
I 8)))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 I)
(\GETBASE \DORADO\ATABLEIMAGE (IDIFFERENCE I 7]
(\PUTBASE \DORADO\ATABLEIMAGE (LLSH STARTCOLOR 3)
S0)
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 (LLSH STARTCOLOR 3))
S1]
(\DORADO\LOOKATA (EMADDRESS MCBLow])
(\DORADO\SETONECOLOR
[LAMBDA (RGBTRIPLE COLOR#) (* hdj "19-Jun-85 17:48")
(OR \DORADO\ATABLEIMAGE (SHOULDNT))
(LET [(DORADOFORMATCOLORCELL (\RGB.TO.DORADO.RGB RGBTRIPLE))
(J (LLSH COLOR# (IDIFFERENCE 11 \COLORDISPLAYBITSPERPIXEL]
(\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE DORADOFORMATCOLORCELL 0))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE DORADOFORMATCOLORCELL 1)))
(\DORADO\LOOKATA (EMADDRESS MCBLow])
)
(DEFINEQ
(\DORADO\LOOKATA
[LAMBDA (MCB) (* bas: "11-APR-82 16:38")
(replace Flags of MCB with (LOGOR AFlagsMask (fetch Flags of MCB)))
(while (EQ AFlagsMask (LOGAND AFlagsMask (fetch Flags of MCB))) do
(* wait for microcode to notice)])
(\DORADO\MAKEATABLE
[LAMBDA (CM) (* rrb " 2-JUL-82 19:09")
(SETQ \DORADO\ATABLEIMAGE (\ALLOCBLOCK (ITIMES CMapPages 128)
NIL 128])
)
(DEFINEQ
(\DORADOCOLOR.EVENTFN
[LAMBDA (DISPLAY EVENT) (* hdj "13-Mar-85 09:41")
(* * if we are about to SYSOUT, MAKESYS, SAVEVM or LOGOUT we flush all local framebuffer pages to PC and mark all
pages dirty so they get written out to vmem file. We turn off the update agent for the interim to avoid creating a
race condition)
(* * we only want to do it if the display is turned on, and not merely extant)
(if (fetch (DISPLAYSTATE RUNNING?) of (fetch (FDEV DEVICEINFO) of DISPLAY))
then (SELECTQ EVENT
((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS)
(* turn off display since we may awake on different
machine)
(COLORDISPLAY NIL))
[AFTERSAVEVM (* this was lifted from \DisplayEventFn -
not sure it makes sense here)
(COND
(\SystemColorMap (* colordisplay was on. turn it off.
User may have moved to machine without color display)
(SETQ LastSystemColorMap \SystemColorMap)
(SETQ \SystemColorMap NIL)
(SETQ \COLORCURSORBM NIL]
NIL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQQ \DORADO\ATABLEIMAGE NIL)
)
(RPAQ? DORADO.COLORDISPLAY.LEFTMARGIN 56)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DORADO\ATABLEIMAGE)
)
(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 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 (pplOffset 255)
(MCBPtr 268)
(MCBSeal 65326)
(MCBLow 160)
(MCBSize 8)
(AFlagsMask 4)
(ChCBLow 168)
(ChCBSize 8)
(ColCBLow 176)
(ColCBSize 16)
(CMapPages 8))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\DORADOINITCOLOR)
(\CREATEDISPLAY (QUOTE DORADOCOLORDISPLAY)
\DORADOWSOPS \DORADOWSDATA (FUNCTION \DORADOCOLOR.EVENTFN))
)
(PUTPROPS DORADOCOLOR COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1531 2994 (\CREATE.DORADOCOLORMAP 1541 . 2992)) (2995 4580 (\DORADOINITCOLOR 3005 .
3930) (\RGB.TO.DORADO.RGB 3932 . 4578)) (4581 12945 (\DORADO\STARTCOLOR 4591 . 7801) (
\DORADO\STOPCOLOR 7803 . 8406) (\DORADO\SETSCREENCOLORMAP 8408 . 9613) (\DORADOCOLORLEVEL 9615 . 10206
) (\DORADOROTATECOLORMAP 10208 . 12412) (\DORADO\SETONECOLOR 12414 . 12943)) (12946 13574 (
\DORADO\LOOKATA 12956 . 13360) (\DORADO\MAKEATABLE 13362 . 13572)) (13575 14884 (\DORADOCOLOR.EVENTFN
13585 . 14882)))))
STOP