(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