(FILECREATED "11-Mar-85 21:23:54" {ERIS}<LISPCORE>LIBRARY>LLCOLOR.;17 88709  

      changes to:  (FNS \COLORDISPLAYBITS COLORDISPLAY)

      previous date: "11-Mar-85 19:10:45" {ERIS}<LISPCORE>LIBRARY>LLCOLOR.;16)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LLCOLORCOMS)

(RPAQQ LLCOLORCOMS ((FNS COLORDISPLAY COLORMAPBITS \CreateColorScreenBitMap SCREENCOLORMAP 
			 MAXIMUMCOLOR COLORSCREENBITMAP \COLORDISPLAYBITS COLORNUMBERBITSPERPIXEL)
	(FNS \STARTCOLOR \STOPCOLOR \SETSCREENCOLORMAP COLORLEVEL ROTATECOLORMAP)
	(FNS COLORMAPCREATE COLORMAPOF COLORMAPP COLORMAPCOPY COLORNUMBERP \LOOKUPCOLORNAME HLSP RGBP 
	     COLORFROMRGBLEVELS \POSSIBLECOLOR INTENSITIESFROMCOLORMAP SETCOLORINTENSITY)
	(FNS \GENERICCOLORLEVEL \GENERICROTATECOLORMAP)
	(FNS \INSUREBITSPERPIXEL \FAST8BIT \MAP4 \MAP8)
	(FNS \GETCOLORBRUSH \DDSETCOLORFONT \GETCOLORFONT \COLORFONTLOOKUP \COLORFONTSTORE)
	(FNS CHANGECURSORSCREEN \SETCOLORCURSORBM \TAKEDOWNCOLORCURSOR \IFCOLORDS\TAKEDOWNCOLORCURSOR 
	     \PUTUPCOLORCURSOR \COLORCURSORDOWN)
	(GLOBALVARS \COLORCURSOR \COLORSCREENBITMAPBASE \COLORCURSORWIDTH \CURSORSAV \COLORCURSORDOWN 
		    \EMPTYCURSOR \ColorCursorBBT \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH 
		    \COLORSCREENWIDTHINBITS \COLORCURSORBASE \COLORCURSORWIDTH \COLORCURSORHEIGHT 
		    \COLORFONTCACHE)
	(INITVARS (\COLORCURSOR)
		  (\CURSORSAV)
		  (\COLORFONTCACHE))
	(CURSORS \EMPTYCURSOR \DEFAULTCOLORCURSOR)
	(FNS \DRAWCOLORLINE1 \DRAW4BPPCOLORLINE \DRAW8BPPCOLORLINE)
	(DECLARE: DONTCOPY DOEVAL@COMPILE (MACROS .DRAW4BPPLINEX. .DRAW8BPPLINEX .DRAW8BPPLINEY 
						  .DRAW4BPPLINEY.))
	(DECLARE: DONTCOPY DOEVAL@COMPILE (MACROS \BITADDRESSOFPIXEL COLORNUMBERBITSPERPIXEL))
	(FNS \BWTOCOLORBLT \8BITLINEBLT \4BITLINEBLT COLORFILL COLORBACKGROUND COLORFILLAREA 
	     COLORTEXTUREFROMCOLOR# \BITMAPWORD)
	(FNS COLORIZEBITMAP)
	(RECORDS COLORMAPP 8BITCOLORMAPP RGB HLS)
	(DECLARE: DONTCOPY (RECORDS NIBBLES ONEOFFSETBITACCESS TWOOFFSETBITACCESS THREEOFFSETBTACCESS 
				    2BITNIBBLES ODD2BITNIBBLES)
		  (CONSTANTS (\ColorScreenAddr 268)
			     (\ColorMapAddr 270)
			     (REDMASK 2048)
			     (GREENMASK 1024)
			     (BLUEMASK 512)
			     (COLORSOFFSETINMAP 2)
			     (INTENSITYSIZE 3)
			     (REDOFFSET 0)
			     (GREENOFFSET 1)
			     (BLUEOFFSET 2)
			     (\MaxBitsPerPixel 4)
			     (\MaxBitMapWidth 65535)
			     (\MaxBitMapHeight 65535)
			     (\MaxBitMapWords 131066)))
	(* this should be in each device init)
	(VARS (COLORSCREENWIDTH 640)
	      (COLORSCREENHEIGHT 480))
	(CONSTANTS (MaxBitsPerPixel 8)
		   (PagesPerSegment 256)
		   (BITSPERWORD 16)
		   (ExtraColorDisplayPages 2))
	(INITVARS (\SystemColorMap)
		  (\COLORDISPLAYBITS)
		  (ColorScreenBitMap)
		  (LastSystemColorMap)
		  (\DefaultColorMap)
		  (\COLORDISPLAYBITSPERPIXEL 4))
	(VARS \DEFAULTCOLORINTENSITIES COLORNAMES
	      [\DEFAULT8BITCOLORINTENSITIES (for RED from 83 to 255 by 43 join
						 (for GREEN from 80 to 255 by 35 join
						      (for BLUE from 80 to 255 by 25 collect
							   (LIST RED GREEN BLUE]
	      (WHOLECOLORDISPLAY (create REGION LEFT ← 0 BOTTOM ← 0 WIDTH ← COLORSCREENWIDTH HEIGHT ← 
					 COLORSCREENHEIGHT)))
	(GLOBALVARS \COLORDISPLAYBITS \COLORDISPLAYBITSPERPIXEL ColorScreenBitMap \SystemColorMap 
		    LastSystemColorMap WHOLECOLORDISPLAY \COLORCURSOR)
	(RECORDS BRUSH)))
(DEFINEQ

(COLORDISPLAY
  [LAMBDA (COLORMAPIFON BITSPERPIXEL CLEARSCREENFLG DISPLAY)
                                                             (* hdj "11-Mar-85 21:14")
                                                             (* turns the color display on and off)
    (LET ((DISPLAYDEV (\CoerceToDisplayDevice DISPLAY)))
      (PROG1 \SystemColorMap                                 (* return whether on not it is on.)
	     (COND
	       (COLORMAPIFON (SETQ BITSPERPIXEL (\INSUREBITSPERPIXEL BITSPERPIXEL))
			     [COND
			       [\SystemColorMap              (* its currently on.)
						(COND
						  ((EQ (fetch (BITMAP BITMAPBITSPERPIXEL)
							  of (COLORSCREENBITMAP))
						       BITSPERPIXEL)
                                                             (* now on at same size; don't do anything)
						    NIL)
						  (T         (* to turn it on with a different size, turn it off 
							     first.)
						     (COLORDISPLAY NIL)
						     (COLORDISPLAY COLORMAPIFON BITSPERPIXEL 
								   DISPLAYDEV]
			       (T                            (* turn it on)
				  (\CreateColorScreenBitMap BITSPERPIXEL DISPLAYDEV)
				  (PROG (COLORBITS (CBITMAP (COLORSCREENBITMAP)))
				        (SETQ COLORBITS (fetch (BITMAP BITMAPBASE) of CBITMAP))
                                                             (* do type check before going uninterruptable)
				        [SETQ COLORMAPIFON (COLORMAPOF (COND
									 ((EQ COLORMAPIFON T)
									   LastSystemColorMap)
									 (T COLORMAPIFON]
				        (UNINTERRUPTABLY
                                            (\LOCKPAGES COLORBITS
							(IPLUS (FOLDHI (ITIMES (fetch 
										BITMAPRASTERWIDTH
										  of CBITMAP)
									       (fetch BITMAPHEIGHT
										  of CBITMAP))
								       WordsPerPage)
							       ExtraColorDisplayPages))
					    (\STARTCOLOR COLORMAPIFON COLORBITS BITSPERPIXEL 
							 DISPLAYDEV))]
			     (AND CLEARSCREENFLG (COLORBACKGROUND 0)))
	       (\SystemColorMap                              (* The color display is on, turn it off.)
				(AND CLEARSCREENFLG (COLORBACKGROUND 0))
                                                             (* move cursor back if it is now on color screen.)
				(AND \COLORCURSORBM (CHANGECURSORSCREEN (SCREENBITMAP)))
				(PROG ((CBITMAP (COLORSCREENBITMAP)))
				      (UNINTERRUPTABLY
                                          (\STOPCOLOR DISPLAYDEV)
					  (SETQ LastSystemColorMap \SystemColorMap)
					  (SETQ \SystemColorMap NIL)
					  (\UNLOCKPAGES (fetch (BITMAP BITMAPBASE) of CBITMAP)
							(FOLDHI (ITIMES (fetch BITMAPRASTERWIDTH
									   of CBITMAP)
									(fetch BITMAPHEIGHT
									   of CBITMAP))
								WordsPerPage)))])

(COLORMAPBITS
  [LAMBDA (COLORMAP?)                                        (* agb: " 4-SEP-82 19:07")
    (COND
      ((type? COLORMAPP COLORMAP?)
	4)
      ((type? 8BITCOLORMAPP COLORMAP?)
	8)
      (T (\ILLEGAL.ARG COLORMAP?])

(\CreateColorScreenBitMap
  [LAMBDA (BITSPP DISPLAY)                                   (* hdj "15-Feb-85 17:31")
                                                             (* creates and locks the pages for the color display 
							     bit map and returns a BITMAP descriptor for it.)
    (PROG [[WIDTH (fetch (REGION WIDTH) of (fetch (WSDATA WSREGION) of (fetch (FDEV WINDOWDATA)
									  of DISPLAY]
	   (HEIGHT (fetch (REGION HEIGHT) of (fetch (WSDATA WSREGION) of (fetch (FDEV WINDOWDATA)
									    of DISPLAY]
          (COND
	    ((type? BITMAP ColorScreenBitMap)                (* reuse the same BITMAP ptr so that it will stay EQ to
							     the one in user datastructures.)
	      (replace (WSDATA WSDESTINATION) of (fetch (FDEV WINDOWDATA) of DISPLAY) with 
										ColorScreenBitMap)
	      (replace BITMAPBASE of ColorScreenBitMap with (\COLORDISPLAYBITS BITSPP WIDTH HEIGHT))
	      (replace BITMAPWIDTH of ColorScreenBitMap with (ITIMES WIDTH BITSPP))
	      (replace BITMAPRASTERWIDTH of ColorScreenBitMap with (FOLDHI (ITIMES WIDTH BITSPP)
									   BITSPERWORD))
	      (replace BITMAPHEIGHT of ColorScreenBitMap with HEIGHT)
	      (replace (BITMAP BITMAPBITSPERPIXEL) of ColorScreenBitMap with BITSPP)
	      ColorScreenBitMap)
	    (T (PROG1 (SETQ ColorScreenBitMap (create BITMAP
						      BITMAPBASE ←(\COLORDISPLAYBITS BITSPP WIDTH 
										     HEIGHT)
						      BITMAPRASTERWIDTH ←(FOLDHI (ITIMES WIDTH BITSPP)
										 BITSPERWORD)
						      BITMAPWIDTH ←(ITIMES WIDTH BITSPP)
						      BITMAPHEIGHT ← HEIGHT
						      BITMAPBITSPERPIXEL ← BITSPP))
		      (replace (WSDATA WSDESTINATION) of (fetch (FDEV WINDOWDATA) of DISPLAY)
			 with ColorScreenBitMap])

(SCREENCOLORMAP
  [LAMBDA (NEWCOLORMAP DISPLAY)                              (* hdj " 4-Feb-85 10:41")

          (* sets NEWCOLORMAP as the colormap for the display. If NIL, returns the current value. May have to unlock the old 
	  colormap and lock the new one.)


    (PROG1 \SystemColorMap (AND NEWCOLORMAP (SETQ NEWCOLORMAP (COLORMAPOF NEWCOLORMAP))
				(UNINTERRUPTABLY
                                    (\SETSCREENCOLORMAP NEWCOLORMAP DISPLAY)
                                                             (* if new color map, call machine dependent function to
							     install it.)
				    (SETQ \SystemColorMap NEWCOLORMAP))])

(MAXIMUMCOLOR
  [LAMBDA (COLORMAP)                                         (* rrb "21-SEP-82 09:19")
                                                             (* returns the largest color number in COLORMAP or in 
							     the screen colormap. If COLORMAP is not given, the 
							     color display must be on.)
    (SELECTQ (COND
	       (COLORMAP (COLORMAPBITS COLORMAP))
	       (T \COLORDISPLAYBITSPERPIXEL))
	     (4 15)
	     (8 255)
	     (SHOULDNT])

(COLORSCREENBITMAP
  [LAMBDA NIL                                                (* rrb "22-OCT-82 14:01")
                                                             (* returns the color screen bitmap)
    ColorScreenBitMap])

(\COLORDISPLAYBITS
  [LAMBDA (BITSPP WIDTH HEIGHT)                              (* hdj "11-Mar-85 21:12")
                                                             (* returns a pointer to the bits that the color board 
							     needs.)
    (DECLARE (GLOBALVARS COLORSCREENWIDTH COLORSCREENHEIGHT \COLORDISPLAYBITS \COLORDISPLAYSIZE 
			 \COLORDISPLAYBITSPERPIXEL))
    (UNINTERRUPTABLY
        (LET* ((SWIDTH (OR WIDTH COLORSCREENWIDTH))
	   (SHEIGHT (OR HEIGHT COLORSCREENHEIGHT))
	   (NPAGES (IPLUS (FOLDHI (ITIMES (FOLDHI (ITIMES SWIDTH BITSPP)
						  BITSPERWORD)
					  SHEIGHT)
				  WORDSPERPAGE)
			  ExtraColorDisplayPages)))
	  [if (NOT \COLORDISPLAYBITS)
	      then                                           (* must allocate something)
                                                             (* \ALLOCBLOCK can't hack bitmaps of the size of the 
							     1132 color screen)
		   (SETQ \COLORDISPLAYBITS (if (IGREATERP (UNFOLD NPAGES CELLSPERPAGE)
							  \MaxArrayNCells)
					       then (OR (\ALLOCPAGEBLOCK NPAGES)
							(ERROR "No room for color screen of size" 
							       NPAGES))
					     else (\ALLOCBLOCK (UNFOLD NPAGES CELLSPERPAGE)
							       NIL NIL CELLSPERPAGE]
	  (SETQ \COLORDISPLAYBITSPERPIXEL BITSPP)
	  \COLORDISPLAYBITS))])

(COLORNUMBERBITSPERPIXEL
  [LAMBDA NIL                                                (* rrb "27-OCT-82 17:25")
                                                             (* returns the number of bits per pixel that the color 
							     screen is running at.)
    \COLORDISPLAYBITSPERPIXEL])
)
(DEFINEQ

(\STARTCOLOR
  [LAMBDA (COLORMAP PTRTOBITS BITSPP DISPLAY)                (* hdj " 3-Feb-85 14:01")
    (WSOP (QUOTE STARTCOLOR)
	  (\CoerceToDisplayDevice DISPLAY)
	  COLORMAP PTRTOBITS BITSPP])

(\STOPCOLOR
  [LAMBDA (DISPLAY)                                          (* hdj " 3-Feb-85 14:01")
    (WSOP (QUOTE STOPCOLOR)
	  (\CoerceToDisplayDevice DISPLAY])

(\SETSCREENCOLORMAP
  [LAMBDA (COLORMAP DISPLAY)                                 (* hdj " 3-Feb-85 14:06")
    (WSOP (QUOTE SETSCREENCOLORMAP)
	  (\CoerceToDisplayDevice DISPLAY)
	  COLORMAP])

(COLORLEVEL
  [LAMBDA (COLORMAP COLOR# PRIMARYCOLOR NEWLEVEL DISPLAY)    (* hdj " 3-Feb-85 14:06")
    (WSOP (QUOTE COLORLEVEL)
	  (\CoerceToDisplayDevice DISPLAY)
	  COLORMAP COLOR# PRIMARYCOLOR NEWLEVEL])

(ROTATECOLORMAP
  [LAMBDA (COLORMAP STARTCOLOR THRUCOLOR DISPLAY)            (* hdj " 3-Feb-85 14:06")
    (WSOP (QUOTE ROTATECOLORMAP)
	  (\CoerceToDisplayDevice DISPLAY)
	  COLORMAP STARTCOLOR THRUCOLOR])
)
(DEFINEQ

(COLORMAPCREATE
  [LAMBDA (INTENSITIES BITSPERPIXEL)                         (* edited: " 9-SEP-82 11:47")
                                                             (* 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 COLORMAPP)))
		      (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])

(COLORMAPOF
  [LAMBDA (NEWCM BITSPERPIXEL)                               (* edited: " 8-SEP-82 12:07")
    (SETQ BITSPERPIXEL (OR BITSPERPIXEL \COLORDISPLAYBITSPERPIXEL))
    (COND
      [(COLORMAPP NEWCM)
	(COND
	  ((EQ BITSPERPIXEL (COLORMAPBITS NEWCM))
	    NEWCM)
	  (T (COLORMAPCOPY NEWCM BITSPERPIXEL]
      ((EQ NEWCM T)
	(COLORMAPCREATE NIL BITSPERPIXEL))
      (T (COLORMAPCREATE NEWCM BITSPERPIXEL])

(COLORMAPP
  [LAMBDA (COLORMAP? BITSPERPIXEL)                           (* rrb "21-OCT-82 18:32")
                                                             (* returns COLORMAP? if it is a colormap.)
    (AND (OR (AND (OR (NULL BITSPERPIXEL)
		      (EQ BITSPERPIXEL 4))
		  (type? COLORMAPP COLORMAP?))
	     (AND (OR (NULL BITSPERPIXEL)
		      (EQ BITSPERPIXEL 8))
		  (type? 8BITCOLORMAPP COLORMAP?)))
	 COLORMAP?])

(COLORMAPCOPY
  [LAMBDA (COLORMAP BITSPERPIXEL)                            (* rrb "21-OCT-82 18:32")

          (* makes a copy of a color map If COLORMAP is not a color map, it returns a new color map with default values.
	  If the colormaps are different sizes, the first 16 entries will be the same and the rest will be black)


    (COLORMAPCREATE (AND (COLORMAPP COLORMAP BITSPERPIXEL)
			 (INTENSITIESFROMCOLORMAP COLORMAP))
		    BITSPERPIXEL])

(COLORNUMBERP
  [LAMBDA (COLOR# BITSPERPIXEL NOERRFLG)                     (* rrb "13-DEC-82 13:14")
                                                             (* returns the color number from a color.)
    (PROG (LEVELS)
          (AND (COND
		 [(FIXP COLOR#)
		   (RETURN (COND
			     ((AND (IGEQ COLOR# 0)
				   (ILESSP COLOR# (EXPT 2 (OR BITSPERPIXEL \COLORDISPLAYBITSPERPIXEL))
					   )
				   COLOR#))
			     (NOERRFLG NIL)
			     (T (\ILLEGAL.ARG COLOR#]
		 [(LITATOM COLOR#)
		   (RETURN (COND
			     ((SETQ LEVELS (\LOOKUPCOLORNAME COLOR#))
                                                             (* recursively look up color number)
			       (COLORNUMBERP (CDR LEVELS)
					     BITSPERPIXEL NOERRFLG))
			     (NOERRFLG NIL)
			     (T (ERROR "Unknown color name" COLOR#]
		 ((HLSP COLOR#)                              (* HLS form convert to RGB)
		   (SETQ LEVELS (HLSTORGB COLOR#)))
		 ((RGBP COLOR#)                              (* check for RGB or HLS)
		   (SETQ LEVELS COLOR#))
		 (NOERRFLG NIL)
		 (T (\ILLEGAL.ARG COLOR#)))
	       (RETURN (COND
			 ((COLORFROMRGBLEVELS LEVELS))
			 (NOERRFLG NIL)
			 (T (ERROR COLOR# "not available in color map"])

(\LOOKUPCOLORNAME
  [LAMBDA (COLORNAME)                                        (* rrb "13-DEC-82 13:14")
                                                             (* looks up a prospective color name.
							     Returns a list whose CAR is the name and whose CDR is a
							     color spec.)
    (FASSOC COLORNAME COLORNAMES])

(HLSP
  [LAMBDA (X)                                                (* rrb "27-OCT-82 10:10")
                                                             (* return T if X is a hue lightness saturation triple.)
    (AND (LISTP X)
	 (IGREATERP (CAR X)
		    -1)
	 (IGREATERP 361 (CAR X))
	 (FLOATP (CADR X))
	 (FLOATP (CADDR X))
	 X])

(RGBP
  [LAMBDA (X)                                                (* rrb "27-OCT-82 10:15")
                                                             (* return X if it is a red green blue triple.)
    (PROG (TMP)
          (RETURN (AND (LISTP X)
		       (SMALLP (SETQ TMP (CAR X)))
		       (IGREATERP TMP -1)
		       (IGREATERP 256 TMP)
		       (SMALLP (SETQ TMP (CADR X)))
		       (IGREATERP TMP -1)
		       (IGREATERP 256 TMP)
		       (SMALLP (SETQ TMP (CADDR X)))
		       (IGREATERP TMP -1)
		       (IGREATERP 256 TMP)
		       X])

(COLORFROMRGBLEVELS
  [LAMBDA (LEVELS)                                           (* rrb "27-OCT-82 10:35")
                                                             (* looks in the colormap for a color that has the RGB 
							     levels of LEVELS)
    (BIND (CM ←(SCREENCOLORMAP)) for I from 0 to (MAXIMUMCOLOR)
       thereis (AND (EQ (COLORLEVEL CM I (QUOTE RED))
			(fetch (RGB RED) of LEVELS))
		    (EQ (COLORLEVEL CM I (QUOTE GREEN))
			(fetch (RGB GREEN) of LEVELS))
		    (EQ (COLORLEVEL CM I (QUOTE BLUE))
			(fetch (RGB BLUE) of LEVELS])

(\POSSIBLECOLOR
  [LAMBDA (COLOR?)                                           (* rrb "22-FEB-83 11:38")

          (* could COLOR? be a color indicator. True if it is a number in the right range or a LITATOM that could be a name.)


    (PROG ((MAXIMUMCOLOR 255))
          (RETURN (SELECTQ (TYPENAME COLOR?)
			   (LITATOM COLOR?)
			   (SMALLP (AND (IGEQ COLOR? 0)
					(ILEQ COLOR? MAXIMUMCOLOR)
					COLOR?))
			   (LISTP (OR (RGBP COLOR?)
				      (HLSP COLOR?)))
			   NIL])

(INTENSITIESFROMCOLORMAP
  [LAMBDA (CM)                                               (* rrb "21-OCT-82 18:29")
                                                             (* returns the intensity levels of the primary colors 
							     from a colormap. This list can be passed into 
							     COLORMAPCREATE to get an equivalent colormap.)
    (OR CM (SETQ CM (SCREENCOLORMAP)))
    (for I from 0 to (SUB1 (EXPT 2 (COLORMAPBITS CM))) collect (for PRIM
								  in (QUOTE (RED GREEN BLUE))
								  collect (COLORLEVEL CM I PRIM])

(SETCOLORINTENSITY
  [LAMBDA (COLORMAP COLOR# INTENSITIES)                      (* rrb "13-DEC-82 13:15")
                                                             (* sets the intensity levels of a color number in a 
							     color map. Does not return the previous setting.)
    (PROG ((RGB INTENSITIES))
      LP  (COND
	    [(NULL RGB)
	      (SETQ RGB (QUOTE (0 0 0]
	    ((RGBP RGB))
	    ((HLSP RGB)
	      (SETQ RGB (HLSTORGB RGB)))
	    ((SETQ RGB (CDR (\LOOKUPCOLORNAME RGB)))
	      (GO LP))
	    (T (\ILLEGAL.ARG RGB)))
          (COLORLEVEL COLORMAP COLOR# (QUOTE RED)
		      (fetch (RGB RED) of RGB))
          (COLORLEVEL COLORMAP COLOR# (QUOTE GREEN)
		      (fetch (RGB GREEN) of RGB))
          (COLORLEVEL COLORMAP COLOR# (QUOTE BLUE)
		      (fetch (RGB BLUE) of RGB])
)
(DEFINEQ

(\GENERICCOLORLEVEL
  [LAMBDA (COLORMAP COLOR# PRIMARYCOLOR NEWLEVEL)            (* bas: "25-APR-82 23:13")
                                                             (* returns the value of the intensity for color gun 
							     PRIMARYCOLOR {RED, GREEN or BLUE} in COLOR#)
    (SETQ COLOR# (COLORNUMBERP COLOR#))
    (PROG1 (IDIFFERENCE 255 (LOGAND [\GETBASE (\DTEST COLORMAP (QUOTE COLORMAPP))
					      (IPLUS COLORSOFFSETINMAP (ITIMES COLOR# INTENSITYSIZE)
						     (SELECTQ PRIMARYCOLOR
							      (RED REDOFFSET)
							      (GREEN GREENOFFSET)
							      (BLUE BLUEOFFSET)
							      (\ILLEGAL.ARG PRIMARYCOLOR]
				    255))                    (* if a new level is given, set it)
	   (COND
	     (NEWLEVEL (COND
			 ((AND (SMALLP NEWLEVEL)
			       (IGEQ NEWLEVEL 0)
			       (ILEQ NEWLEVEL 255)))
			 (T (\ILLEGAL.ARG NEWLEVEL)))
		       (\PUTBASE COLORMAP (IPLUS COLORSOFFSETINMAP (ITIMES COLOR# INTENSITYSIZE)
						 (SELECTQ PRIMARYCOLOR
							  (RED REDOFFSET)
							  (GREEN GREENOFFSET)
							  BLUEOFFSET))
				 (LOGOR (LLSH COLOR# 12)
					(SELECTQ PRIMARYCOLOR
						 (RED REDMASK)
						 (GREEN GREENMASK)
						 BLUEMASK)
					(IDIFFERENCE 255 NEWLEVEL])

(\GENERICROTATECOLORMAP
  [LAMBDA (COLORMAP STARTCOLOR THRUCOLOR)                    (* bas: "25-APR-82 12:38")
                                                             (* rotates the colors STARTCOLOR through THRUCOLOR in 
							     the color map)
    (OR (COLORMAPP COLORMAP)
	(SETQ COLORMAP (SCREENCOLORMAP)))
    (SETQ STARTCOLOR (COLORNUMBERP (OR STARTCOLOR 0)))
    (SETQ THRUCOLOR (COLORNUMBERP (OR THRUCOLOR 15)))
    [COND
      ((IGREATERP STARTCOLOR THRUCOLOR)
	(SETQ STARTCOLOR (PROG1 THRUCOLOR (SETQ THRUCOLOR STARTCOLOR]
    (PROG (LRED LBLUE LGREEN COLORADDR)                      (* save the last color)
          [PROGN [SETQ LRED (\GETBASE COLORMAP (IPLUS COLORSOFFSETINMAP REDOFFSET (ITIMES 
										    INTENSITYSIZE 
											THRUCOLOR]
		 [SETQ LBLUE (\GETBASE COLORMAP (IPLUS COLORSOFFSETINMAP BLUEOFFSET (ITIMES 
										    INTENSITYSIZE 
											THRUCOLOR]
		 (SETQ LGREEN (\GETBASE COLORMAP (IPLUS COLORSOFFSETINMAP GREENOFFSET
							(ITIMES INTENSITYSIZE THRUCOLOR]
                                                             (* move most of the colors up)
          [for I from (SUB1 (IPLUS COLORSOFFSETINMAP (ITIMES INTENSITYSIZE THRUCOLOR)))
	     to (IPLUS COLORSOFFSETINMAP (ITIMES INTENSITYSIZE STARTCOLOR)) by -1
	     do                                              (* IPLUS of constant quanity increments the color 
							     address by one color number.)
		(\PUTBASE (\ADDBASE COLORMAP (IPLUS I INTENSITYSIZE))
			  0
			  (IPLUS (\GETBASE (\ADDBASE COLORMAP I)
					   0)
				 (CONSTANT (LLSH 1 12]
          [PROGN                                             (* put the last color in the first.
							     LOGAND mask sets the color address which is stored in 
							     the leftmost 4 bits to)
		 (\PUTBASE COLORMAP (IPLUS COLORSOFFSETINMAP REDOFFSET (ITIMES STARTCOLOR 
									       INTENSITYSIZE))
			   (LOGOR (SETQ COLORADDR (LLSH STARTCOLOR 12))
				  (LOGAND (CONSTANT (SUB1 (EXPT 2 12)))
					  LRED)))
		 (\PUTBASE COLORMAP (IPLUS COLORSOFFSETINMAP BLUEOFFSET (ITIMES STARTCOLOR 
										INTENSITYSIZE))
			   (LOGOR COLORADDR (LOGAND (CONSTANT (SUB1 (EXPT 2 12)))
						    LBLUE)))
		 (\PUTBASE COLORMAP (IPLUS COLORSOFFSETINMAP GREENOFFSET (ITIMES STARTCOLOR 
										 INTENSITYSIZE))
			   (LOGOR COLORADDR (LOGAND (CONSTANT (SUB1 (EXPT 2 12)))
						    LGREEN]
          (RETURN COLORMAP])
)
(DEFINEQ

(\INSUREBITSPERPIXEL
  [LAMBDA (NBITS)                                            (* rrb "21-DEC-82 21:00")
                                                             (* determines if NBITS is a legal color bits per 
							     pixel.)
    (SELECTQ NBITS
	     (NIL                                            (* default to previous value or 4)
		  (OR \COLORDISPLAYBITSPERPIXEL 4))
	     (4                                              (* 4 is legal on both machines.)
		4)
	     (COND
	       ((AND (EQ (MACHINETYPE)
			 (QUOTE DORADO))
		     (EQ NBITS 8))
		 8)
	       (T (\ILLEGAL.ARG NBITS])

(\FAST8BIT
  [LAMBDA (A B N MAP)                                        (* edited: "10-SEP-82 16:14")
    (bind AW (I ← 0) for J from 0
       do (SETQ AW (\ADDBASE A J))
	  (OR (IGREATERP N I)
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN1 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN2 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN3 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN4 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN5 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN6 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN7 of AW)))
	  (OR (IGREATERP N (add I 1))
	      (RETURN))
	  (\PUTBASE B I (ELT MAP (fetch EN8 of AW)))
	  (add I 1])

(\MAP4
  [LAMBDA (0C 1C)                                            (* edited: "10-SEP-82 15:50")
    (SETQ 0C (COND
	(0C (COLORNUMBERP 0C 4))
	(T 0)))                                              (* Mask out but 4 bits)
    (SETQ 1C (COND
	(1C (COLORNUMBERP 1C 4))
	(T 15)))
    (PROG ((MAP (ARRAY 16 (QUOTE SMALLPOSP)
		       0 0)))
          [for I from 0 to 15 do (SETA MAP I (for J from 0 to 3
						sum (LLSH (COND
							    ((ZEROP (LOGAND I (LLSH 1 J)))
							      0C)
							    (T 1C))
							  (ITIMES J 4]
          (RETURN MAP])

(\MAP8
  [LAMBDA (0C 1C)                                            (* edited: "10-SEP-82 15:50")

          (* returns an array of words that contain the destination bitmap should contain if a black and white bitmap is blown
	  up to an 8 bit per pixel bitmap.)


    (SETQ 0C (COND
	(0C (COLORNUMBERP 0C 8))
	(T 0)))                                              (* make sure color numbers are given.)
    (SETQ 1C (COND
	(1C (COLORNUMBERP 1C 8))
	(T 255)))
    (PROG ((MAP (ARRAY 4 (QUOTE SMALLPOSP)
		       0 0)))
          [for I from 0 to 3 do (SETA MAP I (LOGOR (COND
						     ((ZEROP (LOGAND I 1))
						       0C)
						     (T 1C))
						   (LLSH (COND
							   ((ZEROP (LOGAND I 2))
							     0C)
							   (T 1C))
							 8]
          (RETURN MAP])
)
(DEFINEQ

(\GETCOLORBRUSH
  [LAMBDA (BRUSH COLOR NBITS)                                (* rrb "21-DEC-82 20:46")
                                                             (* produces a colorbitmap that is 1's where ever the 
							     brush bitmap would be 1)
    (COND
      ((AND (BITMAPP BRUSH)
	    (EQ (FETCH (BITMAP BITMAPBITSPERPIXEL) OF BRUSH)
		NBITS))
	BRUSH)
      (T (COLORIZEBITMAP [COND
			   ((LISTP BRUSH)
			     (\BRUSHBITMAP (FETCH (BRUSH BRUSHSHAPE) OF BRUSH)
					   (FETCH (BRUSH BRUSHSIZE) OF BRUSH)))
			   (T (\BRUSHBITMAP (QUOTE ROUND)
					    (OR BRUSH 1]
			 0 COLOR NBITS])

(\DDSETCOLORFONT
  [LAMBDA (DISPLAYSTREAM)                                    (* rrb " 7-SEP-83 15:05")
                                                             (* sets up the color font in a display stream)
    (PROG (FONT (DD (\GETDISPLAYDATA DISPLAYSTREAM)))
          [SETQ FONT (\GETCOLORFONT (fetch (\DISPLAYDATA DDFONT) of DD)
				    (DSPCOLOR NIL DISPLAYSTREAM)
				    (DSPBACKCOLOR NIL DISPLAYSTREAM)
				    (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch (\DISPLAYDATA 
										    DDDestination)
									     of DD]
          (replace (\DISPLAYDATA DDFONT) of DD with FONT)    (* some of this is duplicated from \SFFixFont)
          (replace PBTSOURCEBPL of (ffetch (\DISPLAYDATA DDPILOTBBT) of DD)
	     with (UNFOLD (fetch BITMAPRASTERWIDTH of (fetch CHARACTERBITMAP of FONT))
			  BITSPERWORD))                      (* the cached offsets field is used to mark that the 
							     color font has been computed)
          (replace (\DISPLAYDATA DDOFFSETSCACHE) of DD with (fetch (ARRAYP BASE)
							       of (fetch \SFOffsets of FONT)))
                                                             (* call \SFFixY to set up the source in the PBT)
          (\SFFixY DD])

(\GETCOLORFONT
  [LAMBDA (BWFONT FORECOLOR BACKCOLOR NBITS)                 (* rrb " 5-Dec-83 12:57")
                                                             (* makes a font descriptor that has a character bitmap 
							     that is colorized.)
    (OR (\COLORFONTLOOKUP BWFONT FORECOLOR BACKCOLOR NBITS)
	(\COLORFONTSTORE (create FONTDESCRIPTOR
			    using BWFONT CHARACTERBITMAP ←(COLORIZEBITMAP
				    (fetch (FONTDESCRIPTOR CHARACTERBITMAP)
				       of (PROG1 (FONTCREATE (fetch (FONTDESCRIPTOR FONTFAMILY)
								of BWFONT)
							     (fetch (FONTDESCRIPTOR FONTSIZE)
								of BWFONT)
							     (fetch (FONTDESCRIPTOR FONTFACE)
								of BWFONT)
							     (fetch (FONTDESCRIPTOR ROTATION)
								of BWFONT)
							     (fetch (FONTDESCRIPTOR FONTDEVICE)
								of BWFONT))

          (* use the character bitmap of the black and white font which must be looked up because the one in the display 
	  stream may have been colorized to a different color.)


						 ))
				    (COLORNUMBERP BACKCOLOR)
				    (COLORNUMBERP FORECOLOR)
				    NBITS))
			 BWFONT FORECOLOR BACKCOLOR NBITS])

(\COLORFONTLOOKUP
  [LAMBDA (BWFONT FORECOLOR BACKCOLOR NBITS)                 (* rrb "16-DEC-82 12:04")
                                                             (* looks in the color font cache to see if this font 
							     has been colorized yet.)
    (CDR (FASSOC NBITS (CDR (FASSOC BACKCOLOR (CDR (FASSOC FORECOLOR (CDR (FASSOC BWFONT 
										  \COLORFONTCACHE])

(\COLORFONTSTORE
  [LAMBDA (COLORIZEDFONT BWFONT FORECOLOR BACKCOLOR NBITS)   (* rrb "16-DEC-82 12:10")
                                                             (* puts a color font into the cache of colored fonts.)
    [PROG (X Y)
          (COND
	    ((NULL (SETQ X (FASSOC BWFONT \COLORFONTCACHE)))
	      (SETQ \COLORFONTCACHE (CONS [LIST BWFONT (LIST FORECOLOR (LIST BACKCOLOR
									     (CONS NBITS 
										   COLORIZEDFONT]
					  \COLORFONTCACHE)))
	    [[NULL (SETQ Y (FASSOC FORECOLOR (CDR X]
	      (NCONC1 X (LIST FORECOLOR (LIST BACKCOLOR (CONS NBITS COLORIZEDFONT]
	    [[NULL (SETQ X (FASSOC BACKCOLOR (CDR Y]
	      (NCONC1 Y (LIST BACKCOLOR (CONS NBITS COLORIZEDFONT]
	    ([NULL (SETQ Y (FASSOC NBITS (CDR X]
	      (NCONC1 X (CONS NBITS COLORIZEDFONT)))
	    ((EQ (CDR Y)
		 COLORIZEDFONT))
	    (T (RPLACD Y COLORIZEDFONT]
    COLORIZEDFONT])
)
(DEFINEQ

(CHANGECURSORSCREEN
  [LAMBDA (NEWSCREEN)                                        (* rrb "26-DEC-82 14:36")
                                                             (* moves the cursor onto the screen NEWSCREEN.)
                                                             (* for now support only the black and white and a color
							     screen.)
    (PROG1 (COND
	     (\COLORCURSORBM (COLORSCREENBITMAP))
	     (T (SCREENBITMAP)))
	   (COND
	     [(EQ NEWSCREEN (SCREENBITMAP))                  (* move to black and white.)
	       (COND
		 (\COLORCURSORBM                             (* now on color.)
                                                             (* take down current color cursor.)
				 (UNINTERRUPTABLY
                                     (\TAKEDOWNCOLORCURSOR)
                                                             (* restore saved regular cursor.)
				     (SETQ \COLORCURSORBM NIL)

          (* set flag that indicates that the color cursor is operating but currently down for a screen change to false.
	  This prevents SETCURSOR from bringing the cursor back up.)


				     (SETQ \COLORCURSORDOWN NIL)
				     (SETCURSOR (create CURSOR
							CURSORBITMAP ← \COLORCURSOR
							CURSORHOTSPOTX ← \MOUSEHOTSPOTX
							CURSORHOTSPOTY ← \MOUSEHOTSPOTY)))
				 (\SETCURSORPOSITION LASTMOUSEX LASTMOUSEY]
	     [(EQ NEWSCREEN (COLORSCREENBITMAP))             (* move to color.)
	       (COND
		 ((AND (COLORDISPLAYP)
		       (NULL \COLORCURSORBM))                (* now on black and white.)

          (* move cursor to the corresponding spot on the color screen. This is necessary because the hardware tracks from the
	  upper left but we want the area of the b&w display that corresponds to the color to be the lower left.)


		   [\SETCURSORPOSITION (IMIN LASTMOUSEX (CONSTANT (SUB1 COLORSCREENWIDTH)))
				       (IMIN (CONSTANT (SUB1 SCREENHEIGHT))
					     (IPLUS LASTMOUSEY (CONSTANT (IDIFFERENCE SCREENHEIGHT 
										COLORSCREENHEIGHT]
		   (\SETCOLORCURSORBM (fetch (CURSOR CURSORBITMAP) of (CURSOR \EMPTYCURSOR]
	     (NEWSCREEN (\ILLEGAL.ARG NEWSCREEN])

(\SETCOLORCURSORBM
  [LAMBDA (CURSORBM)                                         (* rrb "13-Dec-83 10:46")

          (* sets the global variables that are used in tracking the color cursor. \COLORCURSORBM is the one which indicates 
	  whether the cursor is on the color or bw screen; non-NIL indicates color. It is the bitmap of the colorized cursor 
	  bitmap image.)

                                                             (* this should only be called with the colorcursor 
							     taken down.)
    (PROG ((COLORSBM (COLORSCREENBITMAP))
	   NBITS CURSORCOLORBM)
          (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORSBM))
          (SETQ CURSORCOLORBM (COLORIZEBITMAP CURSORBM 0 (MAXIMUMCOLOR \SystemColorMap)
					      NBITS))
          (COND
	    ((NOT (type? PILOTBBT \ColorCursorBBT))          (* make sure cursor flashing bit blt table is set up.)
	      (SETQ \ColorCursorBBT (create PILOTBBT))
	      (replace (PILOTBBT PBTFLAGS) of \ColorCursorBBT with 0)
	      (replace (PILOTBBT PBTUSEGRAY) of \ColorCursorBBT with NIL)
	      (replace (PILOTBBT PBTDISJOINT) of \ColorCursorBBT with T)
	      (replace (PILOTBBT PBTOPERATION) of \ColorCursorBBT with 3)
	      (replace (PILOTBBT PBTSOURCETYPE) of \ColorCursorBBT with 0)))
          (UNINTERRUPTABLY
              (replace (PILOTBBT PBTDESTBPL) of \ColorCursorBBT with (UNFOLD (SETQ 
									  \COLORSCREENRASTERWIDTH
									       (fetch (BITMAP 
										BITMAPRASTERWIDTH)
										  of COLORSBM))
									     BITSPERWORD))
	      (replace (PILOTBBT PBTSOURCEBPL) of \ColorCursorBBT
		 with (UNFOLD (SETQ \COLORCURSORRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH)
							       of CURSORCOLORBM))
			      BITSPERWORD))                  (* keep a pointer to the base of the line that the 
							     cursor is on.)
	      (SETQ.NOREF \COLORSCREENCURSORLINEBASE (\ADDBASE (fetch (BITMAP BITMAPBASE)
								  of COLORSBM)
							       (ITIMES (SETQ \COLORSCREENCURSORLINE
									 (\GETBASE \EM.CURSORY 0))
								       \COLORSCREENRASTERWIDTH)))
	      (SETQ \COLORSCREENWIDTHINBITS (fetch (BITMAP BITMAPWIDTH) of COLORSBM))
	      (SETQ \COLORCURSORBASE (fetch (BITMAP BITMAPBASE) of CURSORCOLORBM))
	      (SETQ \COLORCURSORWIDTH (fetch (BITMAP BITMAPWIDTH) of CURSORCOLORBM))
	      (SETQ \COLORCURSORHEIGHT (fetch (BITMAP BITMAPHEIGHT) of CURSORCOLORBM))
	      (SETQ \COLORCURSOR CURSORBM)

          (* \COLORCURSORDOWN is used to disable the color cursor tracking by the key handler even though \COLORCURSORBM is 
	  non-NIL. It is set to T here so that if the keyboard handler runs between the time \COLORCURSORBM is set and 
	  \PUTUPCOLORCURSOR completes, the cursor won't be displayed.)


	      (SETQ \COLORCURSORDOWN T)
	      (SETQ \COLORCURSORBM CURSORCOLORBM)
	      (\PUTUPCOLORCURSOR))])

(\TAKEDOWNCOLORCURSOR
  [LAMBDA NIL                                                (* rrb "11-NOV-82 19:06")
    (COND
      ((AND \COLORCURSORBM (NULL \COLORCURSORDOWN))          (* take down the color cursor.)
                                                             (* set flag first so that keyboard handler will stop 
							     moving cursor image before we remove it.)
	(SETQ \COLORCURSORDOWN T)
	(.TAKE.DOWN.COLOR.CURSOR])

(\IFCOLORDS\TAKEDOWNCOLORCURSOR
  [LAMBDA (DS)                                               (* rrb " 7-SEP-83 15:09")
                                                             (* if DS is onto the color display, this takes down the
							     color cursor)
    (AND (EQ (fetch (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA DS))
	     (COLORSCREENBITMAP))
	 (\TAKEDOWNCOLORCURSOR])

(\PUTUPCOLORCURSOR
  [LAMBDA NIL                                                (* rrb "16-NOV-82 12:12")

          (* put up the color cursor image. Must be done without 60 cycle interrupts so that position of cursor doesn't get 
	  changed before the flag gets set to indicate tracking.)



          (* turns off keyboard interrupts {and everything else for that matter} with code cobbled from WITHOUT-INTERRUPTS.
	  Didn't use WITHOUT-INTERRUPTS because is cause flash on the b&w display taking the display down.)

                                                             (* this should always be called in an UNINTERRUPTABLE 
							     context.)
    (\PUTBASE \EM.DISPINTERRUPT 0 (PROG1 (\GETBASE \EM.DISPINTERRUPT 0)
					 (\PUTBASE \EM.DISPINTERRUPT 0 0)
					 (\SHOWCOLORCURSOR (\GETBASE \EM.CURSORX 0)
							   (\GETBASE \EM.CURSORY 0))
					 (SETQ \COLORCURSORDOWN NIL])

(\COLORCURSORDOWN
  [LAMBDA (DS)                                               (* rrb " 7-SEP-83 15:09")
                                                             (* if this DS is onto the colorscreen, it takes the 
							     cursor down.)
    (AND (NULL \COLORCURSORDOWN)
	 (EQ (fetch (\DISPLAYDATA DDDestination) of (\GETDISPLAYDATA DS))
	     (COLORSCREENBITMAP))
	 (\TAKEDOWNCOLORCURSOR])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \COLORCURSOR \COLORSCREENBITMAPBASE \COLORCURSORWIDTH \CURSORSAV \COLORCURSORDOWN 
	    \EMPTYCURSOR \ColorCursorBBT \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH 
	    \COLORSCREENWIDTHINBITS \COLORCURSORBASE \COLORCURSORWIDTH \COLORCURSORHEIGHT 
	    \COLORFONTCACHE)
)

(RPAQ? \COLORCURSOR )

(RPAQ? \CURSORSAV )

(RPAQ? \COLORFONTCACHE )
(RPAQ \EMPTYCURSOR (CURSORCREATE (READBITMAP) 0 15))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")(RPAQ \DEFAULTCOLORCURSOR (CURSORCREATE (READBITMAP) 0 15))
(16 16
"OOH@"
"OO@@"
"ON@@"
"ON@@"
"OO@@"
"OOH@"
"OOL@"
"OON@"
"LOO@"
"HGOH"
"@COL"
"@AON"
"@@OO"
"@@GN"
"@@CL"
"@@AH")(DEFINEQ

(\DRAWCOLORLINE1
  [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH NBITS COLOR)
                                                             (* rrb "10-OCT-82 12:33")
    (DECLARE (LOCALVARS . T))
    (COND
      ((EQ NBITS 4)
	(\DRAW4BPPCOLORLINE X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR))
      (T (\DRAW8BPPCOLORLINE X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR])

(\DRAW4BPPCOLORLINE
  [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
                                                             (* rrb "10-OCT-82 12:33")
    (DECLARE (LOCALVARS . T))

          (* draws a color line starting at X0,Y0 at a slope of DX/DY until reaching either XLIMIT or YLIMIT with an initial 
	  overflow bucket size of CDL in MODE. Arranged so that the clipping routines can determine what the exact location of
	  the end point of the clipped line is wrt line drawing coordinates eg. amount in overflow bucket.
	  XLIMIT and YLIMIT are the number of points to be moved in that direction.)


    (PROG (MAPPTR MASK COLORMASK (COLORMASKORG (LLSH COLOR 12))
		  WORDOFFSET)

          (* keep word offset from bitmapbase so that the YINC can be negative or positive. Used to use \ADDBASE directly but 
	  negative case was not in micro code and ran much slower.)


          [SETQ WORDOFFSET (IPLUS (ITIMES Y0 RASTERWIDTH)
				  (FOLDLO X0 (CONSTANT (LRSH BITSPERWORD 2]
          (SETQ MAPPTR (\ADDBASE BITMAPBASE WORDOFFSET))
          (SETQ MASK (\4BITMASK X0))
          (SETQ COLORMASK (LLSH COLOR (LLSH (IDIFFERENCE 3 (LOGAND X0 3))
					    2)))
          (SETQ X0 0)
          (SETQ Y0 0)
          (COND
	    [(IGEQ DX DY)                                    (* X is the fastest mover.)
	      (SELECTQ MODE
		       (INVERT (.DRAW4BPPLINEX. (QUOTE INVERT)))
		       (.DRAW4BPPLINEX. (QUOTE REPLACE/PAINT]
	    (T                                               (* Y is the fastest mover.)
	       (SELECTQ MODE
			(INVERT (.DRAW4BPPLINEY. (QUOTE INVERT)))
			(.DRAW4BPPLINEY. (QUOTE REPLACE/PAINT])

(\DRAW8BPPCOLORLINE
  [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
                                                             (* rrb "15-OCT-82 14:14")
    (DECLARE (LOCALVARS . T))

          (* draws a color line starting at X0,Y0 at a slope of DX/DY until reaching either XLIMIT or YLIMIT with an initial 
	  overflow bucket size of CDL in MODE. Arranged so that the clipping routines can determine what the exact location of
	  the end point of the clipped line is wrt line drawing coordinates eg. amount in overflow bucket.
	  XLIMIT and YLIMIT are the number of points to be moved in that direction.)


    (PROG (MAPPTR STARTBYTE WORDOFFSET)

          (* keep word offset from bitmapbase so that the YINC can be negative or positive. Used to use \ADDBASE directly but 
	  negative case was not in micro code and ran much slower.)


          [SETQ WORDOFFSET (IPLUS (ITIMES Y0 RASTERWIDTH)
				  (FOLDLO X0 (CONSTANT (LRSH BITSPERWORD 3]
          (SETQ MAPPTR (\ADDBASE BITMAPBASE WORDOFFSET))
          (SETQ STARTBYTE (LOGAND X0 1))
          (SETQ X0 0)
          (SETQ Y0 0)
          (COND
	    [(IGEQ DX DY)                                    (* X is the fastest mover.)
	      (SELECTQ MODE
		       (INVERT (.DRAW8BPPLINEX (QUOTE INVERT)))
		       (.DRAW8BPPLINEX (QUOTE REPLACE/PAINT]
	    (T                                               (* Y is the fastest mover.)
	       (SELECTQ MODE
			(INVERT (.DRAW8BPPLINEY (QUOTE INVERT)))
			(.DRAW8BPPLINEY (QUOTE REPLACE/PAINT])
)
(DECLARE: DONTCOPY DOEVAL@COMPILE 
(DECLARE: EVAL@COMPILE 

(PUTPROPS .DRAW4BPPLINEX. MACRO [(MODE)
				 (until (IGREATERP X0 XLIMIT)
				    do                       (* main loop)
				       [replace (BITMAPWORD BITS) of MAPPTR
					  with (SELECTQ MODE
							(INVERT (LOGXOR COLORMASK
									(fetch (BITMAPWORD BITS)
									   of MAPPTR)))
							(PROGN 
                                                             (* case of ERASE was change to PAINT of background 
							     color.)
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
							       (LOGOR COLORMASK
								      (LOGAND (LOGXOR MASK WORDMASK)
									      (fetch (BITMAPWORD
										       BITS)
										 of MAPPTR]
				       [COND
					 ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
					   (COND
					     ((IGREATERP (SETQ Y0 (ADD1 Y0))
							 YLIMIT)
					       (RETURN)))
					   (SETQ CDL (IDIFFERENCE CDL DX))
					   (SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								    (IPLUS WORDOFFSET YINC]
				       [COND
					 [(ZEROP (SETQ MASK (LRSH MASK 4)))
                                                             (* crossed word boundary)
					   [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								    (ADD1 WORDOFFSET]
					   (SETQ COLORMASK COLORMASKORG)
					   (SETQ MASK (CONSTANT (\4BITMASK 0]
					 (T (SETQ COLORMASK (LRSH COLORMASK 4]
				       (SETQ X0 (ADD1 X0])

(PUTPROPS .DRAW8BPPLINEX MACRO ((MODE)
				(PROG NIL
				      (COND
					((EQ STARTBYTE 1)
					  (GO 1LP)))
				  0LP                        (* main loop)
				      (\PUTBASEBYTE MAPPTR 0 (SELECTQ MODE
								      (INVERT (LOGXOR COLOR
										      (\GETBASEBYTE
											MAPPTR 0)))
								      (PROGN 
                                                             (* case of ERASE was change to PAINT of background 
							     color.)
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
									     COLOR)))
				      [COND
					([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
					  (COND
					    ((IGREATERP (SETQ Y0 (ADD1 Y0))
							YLIMIT)
					      (RETURN)))
					  (SETQ CDL (IDIFFERENCE CDL DX))
					  (SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								   (IPLUS WORDOFFSET YINC]
				      (COND
					((IGREATERP (SETQ X0 (ADD1 X0))
						    XLIMIT)
					  (RETURN)))
				  1LP (\PUTBASEBYTE MAPPTR 1 (SELECTQ MODE
								      (INVERT (LOGXOR COLOR
										      (\GETBASEBYTE
											MAPPTR 1)))
								      (PROGN 
                                                             (* case of ERASE was change to PAINT of background 
							     color.)
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
									     COLOR)))
				      [COND
					([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
					  (COND
					    ((IGREATERP (SETQ Y0 (ADD1 Y0))
							YLIMIT)
					      (RETURN)))
					  (SETQ CDL (IDIFFERENCE CDL DX))
					  (SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								   (IPLUS WORDOFFSET YINC]
				      (COND
					((IGREATERP (SETQ X0 (ADD1 X0))
						    XLIMIT)
					  (RETURN)))
				      [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
							       (ADD1 WORDOFFSET]
				      (GO 0LP))))

(PUTPROPS .DRAW8BPPLINEY MACRO ((MODE)
				(PROG NIL
				      (COND
					((EQ STARTBYTE 1)
					  (GO 1LP)))
				  0LP                        (* main loop)
				      (\PUTBASEBYTE MAPPTR 0 (SELECTQ MODE
								      (INVERT (LOGXOR COLOR
										      (\GETBASEBYTE
											MAPPTR 0)))
								      (PROGN 
                                                             (* case of ERASE was change to PAINT of background 
							     color.)
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
									     COLOR)))
				      (COND
					((IGREATERP (SETQ Y0 (ADD1 Y0))
						    YLIMIT)
					  (RETURN)))
				      [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
							       (IPLUS WORDOFFSET YINC]
				      (COND
					([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
                                                             (* moved enough in Y to move a point in X)
					  (COND
					    ((IGREATERP (SETQ X0 (ADD1 X0))
							XLIMIT)
					      (RETURN)))
					  (SETQ CDL (IDIFFERENCE CDL DY))
					  (GO 1LP)))
				      (GO 0LP)
				  1LP (\PUTBASEBYTE MAPPTR 1 (SELECTQ MODE
								      (INVERT (LOGXOR COLOR
										      (\GETBASEBYTE
											MAPPTR 1)))
								      (PROGN 
                                                             (* case of ERASE was change to PAINT of background 
							     color.)
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
									     COLOR)))
				      (COND
					((IGREATERP (SETQ Y0 (ADD1 Y0))
						    YLIMIT)
					  (RETURN)))
				      [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
							       (IPLUS WORDOFFSET YINC]
				      (COND
					([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
                                                             (* moved enough in Y to move a point in X)
					  (COND
					    ((IGREATERP (SETQ X0 (ADD1 X0))
							XLIMIT)
					      (RETURN)))
					  (SETQ CDL (IDIFFERENCE CDL DY))
					  [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								   (ADD1 WORDOFFSET]
					  (GO 0LP)))
				      (GO 1LP))))

(PUTPROPS .DRAW4BPPLINEY. MACRO [(MODE)
				 (until (IGREATERP Y0 YLIMIT)
				    do                       (* main loop)
				       [replace (BITMAPWORD BITS) of MAPPTR
					  with (SELECTQ MODE
							(INVERT (LOGXOR COLORMASK
									(fetch (BITMAPWORD BITS)
									   of MAPPTR)))
							(PROGN 
                                                             (* case is PAINT or REPLACE.
							     Legality of OPERATION has been checked by 
							     \CLIPANDDRAWLINE1)
							       (LOGOR COLORMASK
								      (LOGAND (LOGXOR MASK WORDMASK)
									      (fetch (BITMAPWORD
										       BITS)
										 of MAPPTR]
				       [COND
					 ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
					   (COND
					     ((IGREATERP (SETQ X0 (ADD1 X0))
							 XLIMIT)
					       (RETURN)))
					   (SETQ CDL (IDIFFERENCE CDL DY))
					   (COND
					     [(ZEROP (SETQ MASK (LRSH MASK 4)))
                                                             (* crossed word boundary)
					       [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
									(ADD1 WORDOFFSET]
					       (SETQ COLORMASK COLORMASKORG)
					       (SETQ MASK (CONSTANT (\4BITMASK 0]
					     (T (SETQ COLORMASK (LRSH COLORMASK 4]
				       [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET
								(IPLUS WORDOFFSET YINC]
				       (SETQ Y0 (ADD1 Y0])
)
)
(DECLARE: DONTCOPY DOEVAL@COMPILE 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \BITADDRESSOFPIXEL MACRO [OPENLAMBDA (BITSPERPIXEL PIXEL)
					       (COND
						 ((EQ BITSPERPIXEL 4)
						   (LLSH PIXEL 2))
						 (T (LLSH PIXEL 3])

(PUTPROPS COLORNUMBERBITSPERPIXEL MACRO (NIL (DECLARE (GLOBALVARS \COLORDISPLAYBITSPERPIXEL))
					     \COLORDISPLAYBITSPERPIXEL))
)
)
(DEFINEQ

(\BWTOCOLORBLT
  [LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
                                                             (* rrb "21-DEC-82 21:26")

          (* blits from a black and white bitmap into a color bitmap which has DESTNBITS bits per pixel.
	  DESTCOLORBM is a pointer to the color bitmap.)

                                                             (* assumes all datatypes and bounds have been checked)
    (SELECTQ DESTNBITS
	     [4 (PROG ((MAP (fetch (ARRAYP BASE) of (\MAP4 0COLOR 1COLOR)))
		       (SRCBASE (fetch BITMAPBASE of SOURCEBWBM))
		       (SRCHEIGHT (fetch BITMAPHEIGHT of SOURCEBWBM))
		       (SRCRW (fetch BITMAPRASTERWIDTH of SOURCEBWBM))
		       (SRCWRD (FOLDLO SLEFT BITSPERWORD))
		       (SRCOFFSET (MOD SLEFT BITSPERWORD))
		       (DESBASE (fetch BITMAPBASE of DESTCOLORBM))
		       (DESHEIGHT (fetch BITMAPHEIGHT of DESTCOLORBM))
		       (DESRW (fetch BITMAPRASTERWIDTH of DESTCOLORBM))
		       (DESWRD (FOLDLO DLEFT 4))
		       (DESOFF (MOD DLEFT 4))
		       (NBITS 4)
		       DESALIGNLEFT SCR)                     (* DESTCOLORBM is used to allow one bit per pixel 
							     bitblt operations on the bitmap.)
		      [COND
			((NEQ 0 DESOFF)                      (* save the left bits of the destination bitmap so it 
							     can be word aligned.)
			  (SETQ SCR (BITMAPCREATE 4 HEIGHT 4))
			  (BITBLT DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2))
				  DBOTTOM SCR 0 0 DESOFF HEIGHT (QUOTE INPUT)
				  (QUOTE REPLACE]
		      (for LINECOUNTER from 1 to HEIGHT
			 do 

          (* linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is 
	  necessary to get offset of line and the 1 corrects for height difference.)


			    (\4BITLINEBLT (\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT
											(IPLUS 
										      LINECOUNTER 
											  SBOTTOM))
									   SRCRW)
								   SRCWRD))
					  SRCOFFSET
					  (\ADDBASE DESBASE (IPLUS (ITIMES (IDIFFERENCE DESHEIGHT
											(IPLUS 
										      LINECOUNTER 
											  DBOTTOM))
									   DESRW)
								   DESWRD))
					  WIDTH MAP 0COLOR 1COLOR))
		      (COND
			(DESALIGNLEFT                        (* move the color bits to the right and restore the 
							     saved color bits.)
				      (BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM
					      (IPLUS DESALIGNLEFT DESOFF)
					      DBOTTOM WIDTH HEIGHT (QUOTE INPUT)
					      (QUOTE REPLACE))
				      (BITBLT SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT
					      (QUOTE INPUT)
					      (QUOTE REPLACE]
	     [8 (PROG ((MAP (fetch (ARRAYP BASE) of (\MAP8 0COLOR 1COLOR)))
		       (SRCBASE (fetch BITMAPBASE of SOURCEBWBM))
		       (SRCHEIGHT (fetch BITMAPHEIGHT of SOURCEBWBM))
		       (SRCRW (fetch BITMAPRASTERWIDTH of SOURCEBWBM))
		       (SRCWRD (FOLDLO SLEFT BITSPERWORD))
		       (SRCOFFSET (MOD SLEFT BITSPERWORD))
		       (DESBASE (fetch BITMAPBASE of DESTCOLORBM))
		       (DESHEIGHT (fetch BITMAPHEIGHT of DESTCOLORBM))
		       (DESRW (fetch BITMAPRASTERWIDTH of DESTCOLORBM))
		       (DESWRD (FOLDLO DLEFT 2))
		       (DESOFF (MOD DLEFT 2)))
		      (for LINECOUNTER from 1 to HEIGHT
			 do 

          (* linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is 
	  necessary to get offset of line and the 1 corrects for height difference.)


			    (\8BITLINEBLT (\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT
											(IPLUS 
										      LINECOUNTER 
											  SBOTTOM))
									   SRCRW)
								   SRCWRD))
					  SRCOFFSET
					  (\ADDBASE DESBASE (IPLUS (ITIMES (IDIFFERENCE DESHEIGHT
											(IPLUS 
										      LINECOUNTER 
											  DBOTTOM))
									   DESRW)
								   DESWRD))
					  DESOFF WIDTH MAP 0COLOR 1COLOR]
	     (SHOULDNT])

(\8BITLINEBLT
  [LAMBDA (SBASE SBITOFFSET DBASE DBITOFFSET WIDTH MAPBASE 0COLOR 1COLOR)
                                                             (* edited: "16-SEP-82 19:36")
                                                             (* moves one line of a black and white bitmap into a 
							     color bitmap using a mapping table.)
    [COND
      ((EQ 1 DBITOFFSET)                                     (* move the first bit specially to get to word boundary
							     in destination.)
	(\PUTBASEBYTE DBASE 1 (COND
			((ZEROP (LOGAND (\GETBASE SBASE 0)
					(\BITMASK SBITOFFSET)))
			  0COLOR)
			(T 1COLOR)))
	[COND
	  ((EQ (SETQ SBITOFFSET (ADD1 SBITOFFSET))
	       BITSPERWORD)                                  (* SBITOFFSET flowed onto next word.)
	    (SETQ SBITOFFSET 0)
	    (SETQ SBASE (\ADDBASE SBASE 1]
	(SETQ DBITOFFSET 0)
	(SETQ DBASE (\ADDBASE DBASE 1))
	(SETQ WIDTH (SUB1 WIDTH]
    (COND
      ((ZEROP (MOD SBITOFFSET 2))                            (* case of moving even aligned bits.)
	(PROG NIL
	  LP  [COND
		((AND (IGREATERP WIDTH (SUB1 BITSPERWORD))
		      (EQ SBITOFFSET 0))                     (* move a source word's worth of bits.)
		  (\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch EN1 of SBASE)))
		  (\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch EN2 of SBASE)))
		  (\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch EN3 of SBASE)))
		  (\PUTBASE DBASE 3 (\GETBASE MAPBASE (fetch EN4 of SBASE)))
		  (\PUTBASE DBASE 4 (\GETBASE MAPBASE (fetch EN5 of SBASE)))
		  (\PUTBASE DBASE 5 (\GETBASE MAPBASE (fetch EN6 of SBASE)))
		  (\PUTBASE DBASE 6 (\GETBASE MAPBASE (fetch EN7 of SBASE)))
		  (\PUTBASE DBASE 7 (\GETBASE MAPBASE (fetch EN8 of SBASE)))
		  (SETQ DBASE (\ADDBASE DBASE 8))
		  (SETQ SBASE (\ADDBASE SBASE 1))
		  (SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD)))
		((EQ WIDTH 0)
		  (RETURN))
		((EQ WIDTH 1)                                (* move last bit specially)
		  (\PUTBASEBYTE DBASE 0 (COND
				  ((ZEROP (LOGAND (\GETBASE SBASE 0)
						  (\BITMASK SBITOFFSET)))
				    0COLOR)
				  (T 1COLOR)))
		  (RETURN))
		(T                                           (* move the rest of the first word or last word two at 
							     a time.)
		   (\PUTBASEBYTE DBASE 0 (COND
				   ((ZEROP (LOGAND (\GETBASE SBASE 0)
						   (\BITMASK SBITOFFSET)))
				     0COLOR)
				   (T 1COLOR)))
		   (\PUTBASEBYTE DBASE 1 (COND
				   ([ZEROP (LOGAND (\GETBASE SBASE 0)
						   (\BITMASK (ADD1 SBITOFFSET]
				     0COLOR)
				   (T 1COLOR)))
		   (SETQ DBASE (\ADDBASE DBASE 1))
		   (SETQ WIDTH (IDIFFERENCE WIDTH 2))
		   (COND
		     ((EQ SBITOFFSET 14)
		       (SETQ SBASE (\ADDBASE SBASE 1))
		       (SETQ SBITOFFSET 0))
		     (T (SETQ SBITOFFSET (IPLUS SBITOFFSET 2]
	      (GO LP)))
      (T                                                     (* moving odd aligned bits.)
	 (PROG NIL
	   LP  [COND
		 ((AND (IGREATERP WIDTH (SUB1 BITSPERWORD))
		       (EQ SBITOFFSET 1))

          (* move a source word's worth of bits. move the 1th thru 15th bits in the first word plus the 0th bit in the next 
	  word.)


		   (\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch ODD2BIT1 of SBASE)))
		   (\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch ODD2BIT2 of SBASE)))
		   (\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch ODD2BIT3 of SBASE)))
		   (\PUTBASE DBASE 3 (\GETBASE MAPBASE (fetch ODD2BIT4 of SBASE)))
		   (\PUTBASE DBASE 4 (\GETBASE MAPBASE (fetch ODD2BIT5 of SBASE)))
		   (\PUTBASE DBASE 5 (\GETBASE MAPBASE (fetch ODD2BIT6 of SBASE)))
		   (\PUTBASE DBASE 6 (\GETBASE MAPBASE (fetch ODD2BIT7 of SBASE)))
		   (\PUTBASEBYTE DBASE 14 (COND
				   ((ZEROP (fetch BIT15 of SBASE))
				     0COLOR)
				   (T 1COLOR)))
		   (\PUTBASEBYTE DBASE 15 (COND
				   ([ZEROP (fetch BIT0 of (SETQ SBASE (\ADDBASE SBASE 1]
				     0COLOR)
				   (T 1COLOR)))
		   (SETQ DBASE (\ADDBASE DBASE 8))
		   (SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD)))
		 ((EQ WIDTH 0)
		   (RETURN))
		 ((EQ WIDTH 1)                               (* move last bit specially)
		   (\PUTBASEBYTE DBASE 0 (COND
				   ((ZEROP (LOGAND (\GETBASE SBASE 0)
						   (\BITMASK SBITOFFSET)))
				     0COLOR)
				   (T 1COLOR)))
		   (RETURN))
		 ((EQ SBITOFFSET 15)                         (* case of moving one bit from each of two words in the
							     slow case.)
		   (\PUTBASEBYTE DBASE 0 (COND
				   ((ZEROP (fetch BIT15 of SBASE))
				     0COLOR)
				   (T 1COLOR)))
		   (\PUTBASEBYTE DBASE (SETQ SBITOFFSET 1)
				 (COND
				   ([ZEROP (fetch BIT0 of (SETQ SBASE (\ADDBASE SBASE 1]
				     0COLOR)
				   (T 1COLOR)))
		   (SETQ WIDTH (IDIFFERENCE WIDTH 2))
		   (SETQ DBASE (\ADDBASE DBASE 1)))
		 (T                                          (* move the rest of the first word or the rest of last 
							     word two at a time.)
		    (\PUTBASEBYTE DBASE 0 (COND
				    ((ZEROP (LOGAND (\GETBASE SBASE 0)
						    (\BITMASK SBITOFFSET)))
				      0COLOR)
				    (T 1COLOR)))
		    (\PUTBASEBYTE DBASE 1 (COND
				    ([ZEROP (LOGAND (\GETBASE SBASE 0)
						    (\BITMASK (ADD1 SBITOFFSET]
				      0COLOR)
				    (T 1COLOR)))
		    (SETQ SBITOFFSET (IPLUS SBITOFFSET 2))
		    (SETQ WIDTH (IDIFFERENCE WIDTH 2))
		    (SETQ DBASE (\ADDBASE DBASE 1]
	       (GO LP])

(\4BITLINEBLT
  [LAMBDA (SBASE SBITOFFSET DBASE WIDTH MAPBASE 0COLOR 1COLOR)
                                                             (* rrb "15-OCT-82 09:28")

          (* moves one line of a black and white bitmap into a color bitmap using a mapping table. Destination bit offset is 
	  assumed to be 0 because \BWTOCOLORBLT arranges things so that it is.)


    (SELECTQ
      (MOD SBITOFFSET 4)
      [0                                                     (* case of moving even aligned bits.)
	 (PROG NIL
	   ONEWRDLP                                          (* SBITOFFSET is either 0, 4, 8 or 12)
	       (COND
		 ((AND (EQ SBITOFFSET 0)
		       (IGREATERP WIDTH (SUB1 BITSPERWORD)))
                                                             (* go to center loop.)
		   (GO LP))
		 ((IGREATERP 4 WIDTH)
		   [PROG ((SWORDCONTENTS (\GETBASE SBASE 0)))
		         (SELECTQ WIDTH
				  (0)
				  [1 (PUTBASEBYTE DBASE 0
						  (LOGOR (LOGAND (\GETBASEBYTE DBASE 0)
								 15)
							 (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4]
				  [2 (PUTBASEBYTE DBASE 0
						  (LOGOR (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4)
							 (COND
							   ([ZEROP (LOGAND SWORDCONTENTS
									   (\BITMASK (ADD1 SBITOFFSET]
							     0COLOR)
							   (T 1COLOR]
				  (PROGN [\PUTBASEBYTE DBASE 0
						       (LOGOR (LLSH (COND
								      ((ZEROP (LOGAND SWORDCONTENTS
										      (\BITMASK
											SBITOFFSET)))
									0COLOR)
								      (T 1COLOR))
								    4)
							      (COND
								([ZEROP (LOGAND SWORDCONTENTS
										(\BITMASK
										  (ADD1 SBITOFFSET]
								  0COLOR)
								(T 1COLOR]
					 (\PUTBASEBYTE
					   DBASE 1
					   (LOGOR (LLSH (COND
							  ([ZEROP (LOGAND SWORDCONTENTS
									  (\BITMASK (IPLUS SBITOFFSET 
											   2]
							    0COLOR)
							  (T 1COLOR))
							4)
						  (LOGAND (\GETBASE DBASE 0)
							  15]
		   (RETURN))
		 (T                                          (* move 4 bits from source to destination.)
		    [\PUTBASE DBASE 0 (\GETBASE MAPBASE (SELECTQ SBITOFFSET
								 (0 (fetch N1 of SBASE))
								 (4 (fetch N2 of SBASE))
								 (8 (fetch N3 of SBASE))
								 (fetch N4 of SBASE]
		    (SETQ DBASE (\ADDBASE DBASE 1))
		    (SETQ WIDTH (IDIFFERENCE WIDTH 4))
		    [COND
		      ((EQ (SETQ SBITOFFSET (IPLUS SBITOFFSET 4))
			   16)
			(SETQ SBITOFFSET 0)
			(SETQ SBASE (\ADDBASE SBASE 1]
		    (GO ONEWRDLP)))
	   LP  (COND
		 ((IGREATERP WIDTH (SUB1 BITSPERWORD))       (* move a source word's worth of bits.)
		   (\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch N1 of SBASE)))
		   (\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch N2 of SBASE)))
		   (\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch N3 of SBASE)))
		   (\PUTBASE DBASE 3 (\GETBASE MAPBASE (fetch N4 of SBASE)))
		   (SETQ DBASE (\ADDBASE DBASE 4))
		   (SETQ SBASE (\ADDBASE SBASE 1))
		   (SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD))
		   (GO LP))
		 (T                                          (* finish off last less than 16 bits.)
		    (GO ONEWRDLP]
      [1                                                     (* moving bits that are aligned with 1 extra bit in the
							     following word of the source.)
	 (PROG NIL
	   ONEWRDLP                                          (* SBITOFFSET is either 0, 4, 8 or 12)
	       (COND
		 ((AND (EQ SBITOFFSET 1)
		       (IGREATERP WIDTH (SUB1 BITSPERWORD)))
                                                             (* go to center loop.)
		   (GO LP))
		 ((IGREATERP 4 WIDTH)
		   [PROG ((SWORDCONTENTS (\GETBASE SBASE 0)))
		         (SELECTQ WIDTH
				  (0)
				  [1 (PUTBASEBYTE DBASE 0
						  (LOGOR (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4)
							 (LOGAND (\GETBASEBYTE DBASE 0)
								 15]
				  [2 (PUTBASEBYTE DBASE 0
						  (LOGOR (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4)
							 (COND
							   ([ZEROP (LOGAND SWORDCONTENTS
									   (\BITMASK (ADD1 SBITOFFSET]
							     0COLOR)
							   (T 1COLOR]
				  (PROGN [\PUTBASEBYTE DBASE 0
						       (LOGOR (LLSH (COND
								      ((ZEROP (LOGAND SWORDCONTENTS
										      (\BITMASK
											SBITOFFSET)))
									0COLOR)
								      (T 1COLOR))
								    4)
							      (COND
								([ZEROP (LOGAND SWORDCONTENTS
										(\BITMASK
										  (ADD1 SBITOFFSET]
								  0COLOR)
								(T 1COLOR]
					 (\PUTBASEBYTE
					   DBASE 1
					   (LOGOR (LLSH (COND
							  ([ZEROP (LOGAND SWORDCONTENTS
									  (\BITMASK (IPLUS SBITOFFSET 
											   2]
							    0COLOR)
							  (T 1COLOR))
							4)
						  (LOGAND (\GETBASE DBASE 0)
							  15]
		   (RETURN))
		 (T                                          (* move 4 bits from source to destination.)
		    [\PUTBASE DBASE 0 (\GETBASE MAPBASE (SELECTQ SBITOFFSET
								 (1 (fetch BITS1TO4 of SBASE))
								 (5 (fetch BITS5TO8 of SBASE))
								 (9 (fetch BITS9TO12 of SBASE))
								 (LOGOR (LLSH (fetch BITS13TO15
										 of SBASE)
									      1)
									(fetch BIT0
									   of (SETQ SBASE
										(\ADDBASE SBASE 1]
		    (SETQ DBASE (\ADDBASE DBASE 1))
		    (SETQ WIDTH (IDIFFERENCE WIDTH 4))
		    (COND
		      ((EQ (SETQ SBITOFFSET (IPLUS SBITOFFSET 4))
			   17)                               (* SBASE has already been incremented as part of 
							     fetching the last 4 bits.)
			(SETQ SBITOFFSET 1)))
		    (GO ONEWRDLP)))
	   LP  (COND
		 ((IGREATERP WIDTH (SUB1 BITSPERWORD))       (* move a source word's worth of bits.)
		   (\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch BITS1TO4 of SBASE)))
		   (\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch BITS5TO8 of SBASE)))
		   (\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch BITS9TO12 of SBASE)))
		   [\PUTBASE DBASE 3 (\GETBASE MAPBASE (LOGOR (LLSH (fetch BITS13TO15 of SBASE)
								    1)
							      (fetch BIT0 of (SETQ SBASE
									       (\ADDBASE SBASE 1]
		   (SETQ DBASE (\ADDBASE DBASE 4))
		   (SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD))
		   (GO LP))
		 (T                                          (* finish off last less than 16 bits.)
		    (GO ONEWRDLP]
      [2                                                     (* moving bits that are aligned with 2 extra bits in 
							     the following word of the source.)
	(PROG NIL
	  ONEWRDLP                                           (* SBITOFFSET is either 2, 6, 10 or 14)
	      (COND
		((AND (EQ SBITOFFSET 2)
		      (IGREATERP WIDTH (SUB1 BITSPERWORD)))
                                                             (* go to center loop.)
		  (GO LP))
		((IGREATERP 4 WIDTH)
		  [PROG ((SWORDCONTENTS (\GETBASE SBASE 0)))
		        (SELECTQ
			  WIDTH
			  (0)
			  [1 (PUTBASEBYTE DBASE 0 (LOGOR (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4)
							 (LOGAND (\GETBASEBYTE DBASE 0)
								 15]
			  [2 (PUTBASEBYTE DBASE 0 (LOGOR (LLSH (COND
								 ((ZEROP (LOGAND SWORDCONTENTS
										 (\BITMASK SBITOFFSET)
										 ))
								   0COLOR)
								 (T 1COLOR))
							       4)
							 (COND
							   ([ZEROP (LOGAND SWORDCONTENTS
									   (\BITMASK (ADD1 SBITOFFSET]
							     0COLOR)
							   (T 1COLOR]
			  (PROGN                             (* first two bits are always in this word.)
				 [\PUTBASEBYTE DBASE 0 (LOGOR (LLSH (COND
								      ((ZEROP (LOGAND SWORDCONTENTS
										      (\BITMASK
											SBITOFFSET)))
									0COLOR)
								      (T 1COLOR))
								    4)
							      (COND
								([ZEROP (LOGAND SWORDCONTENTS
										(\BITMASK
										  (ADD1 SBITOFFSET]
								  0COLOR)
								(T 1COLOR]
				 (\PUTBASEBYTE
				   DBASE 1
				   (LOGOR (LLSH (COND
						  ([ZEROP (COND
							    ((EQ SBITOFFSET 14)
                                                             (* the next one is in the next word if the offset is 
							     14)
							      (fetch BIT0OFNEXTWORD of SBASE))
							    (T (LOGAND SWORDCONTENTS
								       (\BITMASK (IPLUS SBITOFFSET 2]
						    0COLOR)
						  (T 1COLOR))
						4)
					  (LOGAND (\GETBASE DBASE 0)
						  15]
		  (RETURN))
		(T                                           (* move 4 bits from source to destination.)
		   [\PUTBASE DBASE 0 (\GETBASE MAPBASE (SELECTQ SBITOFFSET
								(2 (fetch BITS2TO5 of SBASE))
								(6 (fetch BITS6TO9 of SBASE))
								(10 (fetch BITS10TO13 of SBASE))
								(LOGOR (LLSH (fetch BITS14TO15
										of SBASE)
									     2)
								       (fetch BITS0TO1
									  of (SETQ SBASE
									       (\ADDBASE SBASE 1]
		   (SETQ DBASE (\ADDBASE DBASE 1))
		   (SETQ WIDTH (IDIFFERENCE WIDTH 4))
		   (COND
		     ((EQ (SETQ SBITOFFSET (IPLUS SBITOFFSET 4))
			  18)                                (* SBASE has already been incremented as part of 
							     fetching the last 4 bits.)
		       (SETQ SBITOFFSET 2)))
		   (GO ONEWRDLP)))
	  LP  (COND
		((IGREATERP WIDTH (SUB1 BITSPERWORD))        (* move a source word's worth of bits.)
		  (\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch BITS2TO5 of SBASE)))
		  (\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch BITS6TO9 of SBASE)))
		  (\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch BITS10TO13 of SBASE)))
		  [\PUTBASE DBASE 3 (\GETBASE MAPBASE (LOGOR (LLSH (fetch BITS14TO15 of SBASE)
								   2)
							     (fetch BITS0TO1
								of (SETQ SBASE (\ADDBASE SBASE 1]
		  (SETQ DBASE (\ADDBASE DBASE 4))
		  (SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD))
		  (GO LP))
		(T                                           (* finish off last less than 16 bits.)
		   (GO ONEWRDLP]
      (PROG NIL                                              (* moving bits that are aligned with 3 extra bits in 
							     the following word of the source.)
	ONEWRDLP                                             (* SBITOFFSET is either 3, 7, 11 or 15)
	    (COND
	      ((AND (EQ SBITOFFSET 3)
		    (IGREATERP WIDTH (SUB1 BITSPERWORD)))    (* go to center loop.)
		(GO LP))
	      ((IGREATERP 4 WIDTH)
		[PROG ((SWORDCONTENTS (\GETBASE SBASE 0)))
		      (SELECTQ
			WIDTH
			(0)
			[1 (PUTBASEBYTE DBASE 0 (LOGOR (LLSH (COND
							       ((ZEROP (LOGAND SWORDCONTENTS
									       (\BITMASK SBITOFFSET)))
								 0COLOR)
							       (T 1COLOR))
							     4)
						       (LOGAND (\GETBASEBYTE DBASE 0)
							       15]
			[2 (PUTBASEBYTE DBASE 0
					(LOGOR (LLSH (COND
						       ((ZEROP (LOGAND SWORDCONTENTS (\BITMASK 
										       SBITOFFSET)))
							 0COLOR)
						       (T 1COLOR))
						     4)
					       (COND
						 ([ZEROP (COND
							   ((EQ SBITOFFSET 15)
                                                             (* the next bit is in the next word if the offset is 
							     15)
							     (FETCH BIT0OFNEXTWORD OF SBASE))
							   (T (LOGAND SWORDCONTENTS
								      (\BITMASK (IPLUS SBITOFFSET 2]
						   0COLOR)
						 (T 1COLOR]
			(PROGN                               (* first two bits are always in this word.)
			       [\PUTBASEBYTE DBASE 0
					     (LOGOR (LLSH (COND
							    ((ZEROP (LOGAND SWORDCONTENTS
									    (\BITMASK SBITOFFSET)))
							      0COLOR)
							    (T 1COLOR))
							  4)
						    (COND
						      ([ZEROP (COND
								((EQ SBITOFFSET 15)
                                                             (* the next bit is in the next word if the offset is 
							     15)
								  (fetch BIT0OFNEXTWORD of SBASE))
								(T (LOGAND SWORDCONTENTS
									   (\BITMASK (IPLUS 
										       SBITOFFSET 2]
							0COLOR)
						      (T 1COLOR]
			       (\PUTBASEBYTE
				 DBASE 1
				 (LOGOR (LLSH (COND
						([ZEROP (COND
							  ((EQ SBITOFFSET 15)
                                                             (* the next one is in the next word if the offset is 
							     15)
							    (fetch BIT1OFNEXTWORD of SBASE))
							  (T (LOGAND SWORDCONTENTS
								     (\BITMASK (IPLUS SBITOFFSET 2]
						  0COLOR)
						(T 1COLOR))
					      4)
					(LOGAND (\GETBASE DBASE 0)
						15]
		(RETURN))
	      (T                                             (* move 4 bits from source to destination.)
		 [\PUTBASE DBASE 0 (\GETBASE MAPBASE (SELECTQ SBITOFFSET
							      (3 (fetch BITS3TO6 of SBASE))
							      (7 (fetch BITS7TO10 of SBASE))
							      (11 (fetch BITS11TO14 of SBASE))
							      (LOGOR (LLSH (fetch BIT15 of SBASE)
									   3)
								     (fetch BITS0TO2
									of (SETQ SBASE
									     (\ADDBASE SBASE 1]
		 (SETQ DBASE (\ADDBASE DBASE 1))
		 (SETQ WIDTH (IDIFFERENCE WIDTH 4))
		 (COND
		   ((EQ (SETQ SBITOFFSET (IPLUS SBITOFFSET 4))
			19)                                  (* SBASE has already been incremented as part of 
							     fetching the last 4 bits.)
		     (SETQ SBITOFFSET 3)))
		 (GO ONEWRDLP)))
	LP  (COND
	      ((IGREATERP WIDTH (SUB1 BITSPERWORD))          (* move a source word's worth of bits.)
		(\PUTBASE DBASE 0 (\GETBASE MAPBASE (fetch BITS3TO6 of SBASE)))
		(\PUTBASE DBASE 1 (\GETBASE MAPBASE (fetch BITS7TO10 of SBASE)))
		(\PUTBASE DBASE 2 (\GETBASE MAPBASE (fetch BITS11TO14 of SBASE)))
		[\PUTBASE DBASE 3 (\GETBASE MAPBASE (LOGOR (LLSH (fetch BIT15 of SBASE)
								 3)
							   (fetch BITS0TO2 of (SETQ SBASE
										(\ADDBASE SBASE 1]
		(SETQ DBASE (\ADDBASE DBASE 4))
		(SETQ WIDTH (IDIFFERENCE WIDTH BITSPERWORD))
		(GO LP))
	      (T                                             (* finish off last less than 16 bits.)
		 (GO ONEWRDLP])

(COLORFILL
  [LAMBDA (REGION COLOR# COLORBM OPERATION)                  (* rrb "21-DEC-82 20:54")
                                                             (* fills a region in a color bitmap with a color.
							     Calls the standard BITBLT with a texture.)
    (PROG [(COLORBM (COND
		      ((TYPENAMEP COLORBM (QUOTE BITMAP))
			COLORBM)
		      ((NULL COLORBM)
			(COLORSCREENBITMAP))
		      (T (\ILLEGAL.ARG COLORBM]
          (COND
	    ((NULL REGION)
	      (COLORFILLAREA 0 0 NIL NIL COLOR# COLORBM OPERATION))
	    (T (COLORFILLAREA (fetch (REGION LEFT) of REGION)
			      (fetch (REGION BOTTOM) of REGION)
			      (fetch (REGION WIDTH) of REGION)
			      (fetch (REGION HEIGHT) of REGION)
			      COLOR# COLORBM OPERATION])

(COLORBACKGROUND
  [LAMBDA (C)                                                (* edited: "14-SEP-82 15:29")
    (COLORFILL WHOLECOLORDISPLAY (OR C (QUOTE BLACK))
	       NIL
	       (QUOTE REPLACE])

(COLORFILLAREA
  [LAMBDA (LEFT BOTTOM WIDTH HEIGHT COLOR# COLORBM OPERATION)
                                                             (* rrb "21-DEC-82 20:54")
                                                             (* fills an area of a color bitmap with color.)
    (COND
      [COLORBM (COND
		 ((type? BITMAP COLORBM))
		 (T (\ILLEGAL.ARG COLORBM]
      ((SETQ COLORBM (COLORSCREENBITMAP)))
      (T (\ILLEGAL.ARG COLORBM)))
    (BITBLT NIL NIL NIL COLORBM LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
	    (OR OPERATION (QUOTE REPLACE))
	    COLOR#])

(COLORTEXTUREFROMCOLOR#
  [LAMBDA (COLOR# NBITS)                                     (* edited: "10-SEP-82 15:47")
                                                             (* returns a TEXTURE that is COLOR# tessellated in a 
							     pattern to put down NBITS per pixel color)
    (PROG NIL
          (COND
	    ((type? BITMAP COLOR#)                           (* already is a texture.)
	      (RETURN COLOR#)))
          (COND
	    ((NULL NBITS)                                    (* assume the size of the current color display.)
	      (SETQ NBITS \COLORDISPLAYBITSPERPIXEL)))
          (SETQ COLOR# (COLORNUMBERP COLOR# NBITS))
          (RETURN (SELECTQ NBITS
			   (4 (LOGOR (LLSH COLOR# 12)
				     (LLSH COLOR# 8)
				     (LLSH COLOR# 4)
				     COLOR#))
			   (8 (PROG ((TEXTUREBITMAP (BITMAPCREATE 16 4))
				     (BITPATTERN (LOGOR (LLSH COLOR# 8)
							COLOR#)))
				    (for I from 0 to 3 do (\BITMAPWORD TEXTUREBITMAP I BITPATTERN))
				    (RETURN TEXTUREBITMAP)))
			   (ERROR "Only 4 and 8 bits per pixel implemented."])

(\BITMAPWORD
  [LAMBDA (BM WORDN NEWBITS)                                 (* edited: " 8-SEP-82 10:54")
                                                             (* puts a words worth of bits into the WORDNth word of 
							     a bitmap.)
    (\PUTBASE (\ADDBASE (fetch (BITMAP BITMAPBASE) of BM)
			WORDN)
	      0
	      (LOGAND NEWBITS WORDMASK])
)
(DEFINEQ

(COLORIZEBITMAP
  [LAMBDA (BITMAP 0COLOR 1COLOR NBITS)                       (* rrb "21-DEC-82 21:18")

          (* creates a copy of BITMAP that is in color form allowing NBITS per pixel. 0COLOR and 1COLOR are the color numbers 
	  that get translated from 0 and 1 respectively.)


    (PROG ([CM (BITMAPCREATE (fetch BITMAPWIDTH of BITMAP)
			     (fetch BITMAPHEIGHT of BITMAP)
			     (SETQ NBITS (\INSUREBITSPERPIXEL NBITS]
	   CBMPTR)
          (\BWTOCOLORBLT BITMAP 0 0 CM 0 0 (fetch BITMAPWIDTH of BITMAP)
			 (fetch BITMAPHEIGHT of BITMAP)
			 (COLORNUMBERP 0COLOR)
			 (COLORNUMBERP 1COLOR)
			 NBITS)
          (RETURN CM])
)
[DECLARE: EVAL@COMPILE 

(DATATYPE COLORMAPP ((UNUSED1 2 WORD)
		     (COLORINTENSITIES 48 WORD)
		     (UNUSED2 14 WORD)))

(DATATYPE 8BITCOLORMAPP (COLORINTENSITIES)
			COLORINTENSITIES ←(\ALLOCBLOCK 384))

(RECORD RGB (RED GREEN BLUE))

(RECORD HLS (HUE LIGHTNESS SATURATION))
]
(/DECLAREDATATYPE (QUOTE COLORMAPP)
		  (QUOTE (WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD 
			       WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD 
			       WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD 
			       WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD 
			       WORD WORD WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE 8BITCOLORMAPP)
		  (QUOTE (POINTER)))
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD NIBBLES ((N1 BITS 4)
		      (N2 BITS 4)
		      (N3 BITS 4)
		      (N4 BITS 4)))

(BLOCKRECORD ONEOFFSETBITACCESS ((BIT0 BITS 1)
				 (BITS1TO4 BITS 4)
				 (BITS5TO8 BITS 4)
				 (BITS9TO12 BITS 4)
				 (BITS13TO15 BITS 3)))

(BLOCKRECORD TWOOFFSETBITACCESS ((BITS0TO1 BITS 2)
				 (BITS2TO5 BITS 4)
				 (BITS6TO9 BITS 4)
				 (BITS10TO13 BITS 4)
				 (BITS14TO15 BITS 2)
				 (BIT0OFNEXTWORD BITS 1)
				 (BIT1OFNEXTWORD BITS 1)
				 (BITS2TO15OFNEXTWORD BITS 14)))

(BLOCKRECORD THREEOFFSETBTACCESS ((BITS0TO2 BITS 3)
				  (BITS3TO6 BITS 4)
				  (BITS7TO10 BITS 4)
				  (BITS11TO14 BITS 4)
				  (BIT15 BITS 1)))

(BLOCKRECORD 2BITNIBBLES ((EN1 BITS 2)
			  (EN2 BITS 2)
			  (EN3 BITS 2)
			  (EN4 BITS 2)
			  (EN5 BITS 2)
			  (EN6 BITS 2)
			  (EN7 BITS 2)
			  (EN8 BITS 2)))

(BLOCKRECORD ODD2BITNIBBLES ((BIT0 BITS 1)
			     (ODD2BIT1 BITS 2)
			     (ODD2BIT2 BITS 2)
			     (ODD2BIT3 BITS 2)
			     (ODD2BIT4 BITS 2)
			     (ODD2BIT5 BITS 2)
			     (ODD2BIT6 BITS 2)
			     (ODD2BIT7 BITS 2)
			     (BIT15 BITS 1)))
]

(DECLARE: EVAL@COMPILE 

(RPAQQ \ColorScreenAddr 268)

(RPAQQ \ColorMapAddr 270)

(RPAQQ REDMASK 2048)

(RPAQQ GREENMASK 1024)

(RPAQQ BLUEMASK 512)

(RPAQQ COLORSOFFSETINMAP 2)

(RPAQQ INTENSITYSIZE 3)

(RPAQQ REDOFFSET 0)

(RPAQQ GREENOFFSET 1)

(RPAQQ BLUEOFFSET 2)

(RPAQQ \MaxBitsPerPixel 4)

(RPAQQ \MaxBitMapWidth 65535)

(RPAQQ \MaxBitMapHeight 65535)

(RPAQQ \MaxBitMapWords 131066)

(CONSTANTS (\ColorScreenAddr 268)
	   (\ColorMapAddr 270)
	   (REDMASK 2048)
	   (GREENMASK 1024)
	   (BLUEMASK 512)
	   (COLORSOFFSETINMAP 2)
	   (INTENSITYSIZE 3)
	   (REDOFFSET 0)
	   (GREENOFFSET 1)
	   (BLUEOFFSET 2)
	   (\MaxBitsPerPixel 4)
	   (\MaxBitMapWidth 65535)
	   (\MaxBitMapHeight 65535)
	   (\MaxBitMapWords 131066))
)
)



(* this should be in each device init)


(RPAQQ COLORSCREENWIDTH 640)

(RPAQQ COLORSCREENHEIGHT 480)
(DECLARE: EVAL@COMPILE 

(RPAQQ MaxBitsPerPixel 8)

(RPAQQ PagesPerSegment 256)

(RPAQQ BITSPERWORD 16)

(RPAQQ ExtraColorDisplayPages 2)

(CONSTANTS (MaxBitsPerPixel 8)
	   (PagesPerSegment 256)
	   (BITSPERWORD 16)
	   (ExtraColorDisplayPages 2))
)

(RPAQ? \SystemColorMap )

(RPAQ? \COLORDISPLAYBITS )

(RPAQ? ColorScreenBitMap )

(RPAQ? LastSystemColorMap )

(RPAQ? \DefaultColorMap )

(RPAQ? \COLORDISPLAYBITSPERPIXEL 4)

(RPAQQ \DEFAULTCOLORINTENSITIES ((0 0 0)
				 (0 0 255)
				 (0 255 0)
				 (255 0 0)
				 (255 255 0)
				 (255 0 255)
				 (0 255 255)
				 (255 255 255)
				 (128 128 128)
				 (171 171 255)
				 (252 128 0)
				 (212 182 129)
				 (0 255 132)
				 (255 0 133)
				 (0 201 39)
				 (167 1 152)))

(RPAQQ COLORNAMES ((BLACK 0 0 0)
		   (BLUE 0 0 255)
		   (GREEN 0 255 0)
		   (RED 255 0 0)
		   (YELLOW 255 255 0)
		   (MAGENTA 255 0 255)
		   (CYAN 0 255 255)
		   (WHITE 255 255 255)))

(RPAQ \DEFAULT8BITCOLORINTENSITIES [for RED from 83 to 255 by 43 join
					(for GREEN from 80 to 255 by 35 join
					     (for BLUE from 80 to 255 by 25 collect
						  (LIST RED GREEN BLUE])

(RPAQ WHOLECOLORDISPLAY (create REGION LEFT ← 0 BOTTOM ← 0 WIDTH ← COLORSCREENWIDTH HEIGHT ← 
				COLORSCREENHEIGHT))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \COLORDISPLAYBITS \COLORDISPLAYBITSPERPIXEL ColorScreenBitMap \SystemColorMap 
	    LastSystemColorMap WHOLECOLORDISPLAY \COLORCURSOR)
)
[DECLARE: EVAL@COMPILE 

(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR))
]
(PUTPROPS LLCOLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3376 11650 (COLORDISPLAY 3386 . 6324) (COLORMAPBITS 6326 . 6578) (
\CreateColorScreenBitMap 6580 . 8513) (SCREENCOLORMAP 8515 . 9203) (MAXIMUMCOLOR 9205 . 9706) (
COLORSCREENBITMAP 9708 . 9946) (\COLORDISPLAYBITS 9948 . 11335) (COLORNUMBERBITSPERPIXEL 11337 . 11648
)) (11651 12713 (\STARTCOLOR 11661 . 11872) (\STOPCOLOR 11874 . 12053) (\SETSCREENCOLORMAP 12055 . 
12263) (COLORLEVEL 12265 . 12487) (ROTATECOLORMAP 12489 . 12711)) (12714 21056 (COLORMAPCREATE 12724
 . 14167) (COLORMAPOF 14169 . 14630) (COLORMAPP 14632 . 15113) (COLORMAPCOPY 15115 . 15598) (
COLORNUMBERP 15600 . 16927) (\LOOKUPCOLORNAME 16929 . 17284) (HLSP 17286 . 17670) (RGBP 17672 . 18307)
 (COLORFROMRGBLEVELS 18309 . 18969) (\POSSIBLECOLOR 18971 . 19519) (INTENSITIESFROMCOLORMAP 19521 . 
20138) (SETCOLORINTENSITY 20140 . 21054)) (21057 25111 (\GENERICCOLORLEVEL 21067 . 22390) (
\GENERICROTATECOLORMAP 22392 . 25109)) (25112 28548 (\INSUREBITSPERPIXEL 25122 . 25782) (\FAST8BIT 
25784 . 27000) (\MAP4 27002 . 27663) (\MAP8 27665 . 28546)) (28549 33272 (\GETCOLORBRUSH 28559 . 29241
) (\DDSETCOLORFONT 29243 . 30593) (\GETCOLORFONT 30595 . 31818) (\COLORFONTLOOKUP 31820 . 32244) (
\COLORFONTSTORE 32246 . 33270)) (33273 41004 (CHANGECURSORSCREEN 33283 . 35594) (\SETCOLORCURSORBM 
35596 . 38702) (\TAKEDOWNCOLORCURSOR 38704 . 39175) (\IFCOLORDS\TAKEDOWNCOLORCURSOR 39177 . 39605) (
\PUTUPCOLORCURSOR 39607 . 40559) (\COLORCURSORDOWN 40561 . 41002)) (41759 45711 (\DRAWCOLORLINE1 41769
 . 42243) (\DRAW4BPPCOLORLINE 42245 . 44050) (\DRAW8BPPCOLORLINE 44052 . 45709)) (54286 83529 (
\BWTOCOLORBLT 54296 . 58590) (\8BITLINEBLT 58592 . 64622) (\4BITLINEBLT 64624 . 80277) (COLORFILL 
80279 . 81114) (COLORBACKGROUND 81116 . 81338) (COLORFILLAREA 81340 . 81956) (COLORTEXTUREFROMCOLOR# 
81958 . 83135) (\BITMAPWORD 83137 . 83527)) (83530 84257 (COLORIZEBITMAP 83540 . 84255)))))
STOP