github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-24 19:40:36 +00:00
Code Issues Projects Releases Wiki Activity

pull more newer library lispusers internal(/library) files from envos (#813)

Browse Source
This commit is contained in:
Larry Masinter
2022-07-03 21:24:36 -07:00
committed by GitHub
parent d7ca40ebeb
commit 25e791de4f
47 changed files with 10448 additions and 1724 deletions
Download Patch File Download Diff File Expand all files Collapse all files

399
lispusers/DORADOCOLOR
View File

@@ -1,49 +1,53 @@
(FILECREATED "24-Feb-86 12:32:26" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;27 15311
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Jun-90 13:56:37" {DSK}<usr>local>lde>lispcore>internal>library>DORADOCOLOR.;2 16864
changes to: (VARS DORADOCOLORCOMS)
changes to%: (VARS DORADOCOLORCOMS)
previous date: "15-Feb-86 16:46:20" {ERIS}<LISPCORE>LIBRARY>DORADOCOLOR.;26)
previous date%: "24-Feb-86 12:32:26"
{DSK}<usr>local>lde>lispcore>internal>library>DORADOCOLOR.;1)
(* Copyright (c) 1985, 1900, 1986 by Xerox Corporation. All rights reserved.)
(* ; "
Copyright (c) 1985, 1900, 1986, 1990 by Venue & 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.)
(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
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(BLOCKRECORD MonitorCB ((Seal WORD)
(Flags WORD)
@@ -81,9 +85,9 @@ Jellinek, and Kelly Roach.)
(NIL BITS 4)
(Green BITS 8)
(RedHi BITS 4)))
]
)
(DECLARE: EVAL@COMPILE
(DECLARE%: EVAL@COMPILE
(RPAQQ DORADO\COLORSCREENWIDTH 640)
@@ -113,6 +117,7 @@ Jellinek, and Kelly Roach.)
(RPAQQ CMapPages 8)
(CONSTANTS (DORADO\COLORSCREENWIDTH 640)
(DORADO\COLORSCREENHEIGHT 480)
(DORADOCOLORPAGES 602)
@@ -129,8 +134,8 @@ Jellinek, and Kelly Roach.)
(CMapPages 8))
)
)
(* * \DORADOCOLOR.LEFTMARGIN should be set to 80 for small CONRACs, 56 for large CONRACs, and
40 for most other monitors. *)
(* * \DORADOCOLOR.LEFTMARGIN should be set to 80 for small CONRACs, 56 for large CONRACs, and 40 for
most other monitors. *)
(RPAQ? \DORADOCOLOR.LEFTMARGIN 80)
@@ -138,191 +143,207 @@ Jellinek, and Kelly Roach.)
(RPAQ? \DORADOCOLOR.ATABLEIMAGE NIL)
(RPAQ? DORADOCOLOR.BITSPERPIXEL 8)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(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))))
[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))))
[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")
[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)))
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)
DITYPE _ 'DORADOCOLOR
DIWIDTH _ DORADO\COLORSCREENWIDTH
DIHEIGHT _ DORADO\COLORSCREENHEIGHT
DIBITSPERPIXEL _ 8
DIWSOPS _ \DORADOCOLORWSOPS))
(\DEFINEDISPLAYINFO \DORADOCOLORINFO)))
(\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)))))))
[LAMBDA (FDEV) (* kbr%: "21-Aug-85 15:55")
(DECLARE (GLOBALVARS \DORADOCOLOR.LEFTMARGIN DORADOCOLOR.BITSPERPIXEL))
(PROG (DISPLAYSTATE MCB AC CB)
(COND
((EQ (MACHINETYPE)
'DORADO)
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'STARTCOLOR)
(MOVD '\DISPLAY.PILOTBITBLT '\SOFTCURSORPILOTBITBLT)
(\LOCKFN '\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 '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))
[LAMBDA (FDEV) (* kbr%: "21-Aug-85 15:56")
(PROG (DISPLAYSTATE MCB)
(SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV))
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'STOPCOLOR)
(SETQ MCB (EMADDRESS MCBLow))
(replace (MonitorCB ACB) of MCB with 0)
(\ZEROWORDS \DORADOCOLOR.ATABLEIMAGE (\ADDBASE \DORADOCOLOR.ATABLEIMAGE 32))
(* Black)
(\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)))))
(\TEMPUNLOCKPAGES \DORADOCOLOR.ATABLEIMAGE CMapPages)
(\TEMPUNLOCKPAGES (fetch (BITMAP BITMAPBASE) of ColorScreenBitMap)
DORADOCOLORPAGES)
(replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with '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)))))
[LAMBDA (FDEV EVENT) (* kbr%: "24-Aug-85 16:55")
(COND
((EQ (fetch (DISPLAYSTATE ONOFF) of (fetch (FDEV DEVICEINFO) of FDEV))
'ON)
(SELECTQ EVENT
((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS) (* turn off display since we may
 awake on different machine)
(COLORDISPLAY '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))
[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)))))
(\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#)))))
[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)))))
[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)
(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)))))
(PUTPROPS DORADOCOLOR COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4684 6340 (\RGB.TO.DORADO.RGB 4694 . 5814) (\DORADOCOLOR.LOOKATA 5816 . 6338)) (6341
15289 (\DORADOCOLOR.INIT 6351 . 7530) (\DORADOCOLOR.STARTCOLOR 7532 . 12956) (\DORADOCOLOR.STOPCOLOR
12958 . 13864) (\DORADOCOLOR.EVENTFN 13866 . 14669) (\DORADOCOLOR.SENDCOLORMAPENTRY 14671 . 15287)) (
15290 16679 (\DORADOCOLOR.COLORLEVEL 15300 . 16071) (\DORADOCOLOR.SETONECOLOR 16073 . 16677)))))
STOP