(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