(FILECREATED "13-Mar-85 10:40:42" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;7 14776
changes to: (FNS \DORADO\STARTCOLOR)
previous date: "13-Mar-85 09:48:09" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;6)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DORADOCOLORCOMS)
(RPAQQ DORADOCOLORCOMS [[COMS (* Dorado machine dependent color display fns)
(FNS \DORADOINITCOLOR)
(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)))
(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@COMPILE DOCOPY (P (\DORADOINITCOLOR)
(\CREATEDISPLAY (QUOTE
DORADOCOLORDISPLAY)
\DORADOWSOPS
\DORADOWSDATA
(FUNCTION
\DORADOCOLOR.EVENTFN])
(* Dorado machine dependent color display fns)
(DEFINEQ
(\DORADOINITCOLOR
[LAMBDA NIL (* hdj "31-Jan-85 17:29")
(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])
)
(DEFINEQ
(\DORADO\STARTCOLOR
[LAMBDA (DISPLAY COLORMAP PTRTOBITS BITSPP) (* edited: "13-Mar-85 10:39")
(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 40)
(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 NIL (* rrb " 6-JUL-83 12:19")
(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])
(\DORADO\SETSCREENCOLORMAP
[LAMBDA (DISPLAY COLORMAP) (* hdj " 4-Feb-85 19:02")
(OR \DORADO\ATABLEIMAGE (SHOULDNT))
(SELECTQ (TYPENAME COLORMAP)
[COLORMAPP (for I from 0 by 2 to 31 as J from 0 by 128
do (\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE COLORMAP I))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE COLORMAP (ADD1 I]
[8BITCOLORMAPP (bind (COLORMAPBASE ←(fetch (8BITCOLORMAPP COLORINTENSITIES)
of COLORMAP))
for I from 0 by 2 to 511 as J from 0 by 8
do (\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE COLORMAPBASE I))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE COLORMAPBASE (ADD1 I]
(\ILLEGAL.ARG COLORMAP))
(\DORADO\LOOKATA (EMADDRESS MCBLow])
(\DORADOCOLORLEVEL
[LAMBDA (DISPLAY COLORMAP COLOR# PRIMARYCOLOR NEWLEVEL) (* hdj " 4-Feb-85 18:56")
(* this code uses the COLORMAPP for storing the 4 bit per pixel dorado colormap but uses a different format from the
DOLPHIN. I think this will lead to problems if a colormap created for one of the machines is moved to the other one
without recreating it.)
(PROG ((COLOR# (COLORNUMBERP COLOR#))
BASE CE)
(SETQ BASE (SELECTQ (TYPENAME COLORMAP)
(COLORMAPP COLORMAP)
(8BITCOLORMAPP (fetch (8BITCOLORMAPP COLORINTENSITIES) of COLORMAP))
(\ILLEGAL.ARG COLORMAP)))
(SETQ CE (\ADDBASE BASE (LLSH COLOR# 1)))
(RETURN (PROG1 (SELECTQ PRIMARYCOLOR
(RED (IPLUS (LLSH (fetch RedHi of CE)
4)
(fetch RedLo of CE)))
(BLUE (fetch Blue of CE))
(GREEN (fetch Green of CE))
(\ILLEGAL.ARG PRIMARYCOLOR))
(COND
(NEWLEVEL (SETQ NEWLEVEL (LOGAND NEWLEVEL 255))
(SELECTQ PRIMARYCOLOR
(RED (replace RedHi of CE with (LRSH NEWLEVEL 4))
(replace RedLo of CE with (LOGAND NEWLEVEL 15)))
(BLUE (replace Blue of CE with NEWLEVEL))
(GREEN (replace Green of CE with NEWLEVEL))
NIL)
(COND
((EQ COLORMAP \SystemColorMap)
(\DORADO\SETONECOLOR BASE COLOR#])
(\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 (COLORMAPBASE CN) (* edited: " 9-SEP-82 12:31")
(OR \DORADO\ATABLEIMAGE (SHOULDNT))
[PROG [(I (LLSH CN 1))
(J (LLSH CN (IDIFFERENCE 11 \COLORDISPLAYBITSPERPIXEL]
(\PUTBASE \DORADO\ATABLEIMAGE J (\GETBASE COLORMAPBASE I))
(\PUTBASE \DORADO\ATABLEIMAGE (ADD1 J)
(\GETBASE COLORMAPBASE (ADD1 I]
(\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)
)
(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@COMPILE DOCOPY
(\DORADOINITCOLOR)
(\CREATEDISPLAY (QUOTE DORADOCOLORDISPLAY)
\DORADOWSOPS \DORADOWSDATA (FUNCTION \DORADOCOLOR.EVENTFN))
)
(PUTPROPS DORADOCOLOR COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1418 2306 (\DORADOINITCOLOR 1428 . 2304)) (2307 11142 (\DORADO\STARTCOLOR 2317 . 5437)
(\DORADO\STOPCOLOR 5439 . 5930) (\DORADO\SETSCREENCOLORMAP 5932 . 6872) (\DORADOCOLORLEVEL 6874 . 8438
) (\DORADOROTATECOLORMAP 8440 . 10644) (\DORADO\SETONECOLOR 10646 . 11140)) (11143 11771 (
\DORADO\LOOKATA 11153 . 11557) (\DORADO\MAKEATABLE 11559 . 11769)) (11772 13081 (\DORADOCOLOR.EVENTFN
11782 . 13079)))))
STOP