(FILECREATED "14-NOV-83 12:28:52" {PHYLUM}<LISP>LIBRARY>READAIS.;2 70588  

      changes to:  (FNS AISBLT INSUREAISFILE)

      previous date: "10-SEP-83 16:18:52" {PHYLUM}<LISPUSERS>READAIS.;5)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT READAISCOMS)

(RPAQQ READAISCOMS ((FNS 24BITCOLORTO8BITMAP AISBLT AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC 
			 AISBLT8TO8 AISBLT4TO4 AISBLT8TO4FSA AISBLT8TO4LESSFSA AISBLT8TO1FSA 
			 AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER 
			 SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS 
			 SHOWCOLORAIS1 THREECOLORMAP WIN WOUT WRITEAIS WRITEAIS1)
	(MACROS .8BIT.COLORLEVEL.FETCH. .GET.4BIT.AND.SPREAD.ERR. .GET.1BIT.AND.SPREAD.ERR. 
		.GET.NBIT.AND.SPREAD.ERR. .GET.LEFTMOST.4BIT .GET.LEFTMOST.BIT. 
		.GET.BESTCOLOR.AND.SPREAD.ERR. .4BIT.MODULATE.INTENSITY.VALUE. 
		.MODULATE.INTENSITY.VALUE. SQUARE)
	(P (MOVD? (QUOTE FAST.COLOR.DISTANCE)
		  (QUOTE COLOR.DISTANCE)))
	(VARS AISDIRECTORIES)
	(GLOBALVARS AISDIRECTORIES)))
(DEFINEQ

(24BITCOLORTO8BITMAP
  [LAMBDA (REDOFD GREENOFD BLUEOFD WIDTH HEIGHT BASE BYTESPERLINE BITMAPRASTERWIDTH COLORMAP)
                                                             (* rrb "29-OCT-82 16:35")
                                                             (* internal function that puts pixels from an ais file 
							     into an 8 bit per pixel bitmap)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR REDOFD))
	   (NEXTLINEREDERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
					       T))
	   (NEXTLINEGREENERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
						 T))
	   (NEXTLINEBLUEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
						T))
	   THISPIXELREDERROR REDERRTABLEPTR THISPIXELGREENERROR GREENERRTABLEPTR THISPIXELBLUEERROR 
	   BLUEERRTABLEPTR REDBYTE GREENBYTE BLUEBYTE ERR COLOR)
                                                             (* error tables are 1 larger so no end check is 
							     necessary in error propagation code.)
                                                             (* initialize error tables.)
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEREDERRORTABLE I 0))
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEGREENERRORTABLE I 0))
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEBLUEERRORTABLE I 0))
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 1))
          (for Y from 0 to (ITIMES (SUB1 HEIGHT)
				   BYTESPERLINE)
	     BY BYTESPERLINE
	     do (SETQ BASE LINEBASE)
		(SETQ REDERRTABLEPTR NEXTLINEREDERRORTABLE)
		(SETQ THISPIXELREDERROR (\GETBASEPTR REDERRTABLEPTR 0))
		(\PUTBASEPTR REDERRTABLEPTR 0 0)
		(SETQ GREENERRTABLEPTR NEXTLINEGREENERRORTABLE)
		(SETQ THISPIXELGREENERROR (\GETBASEPTR GREENERRTABLEPTR 0))
		(\PUTBASEPTR GREENERRTABLEPTR 0 0)
		(SETQ BLUEERRTABLEPTR NEXTLINEBLUEERRORTABLE)
		(SETQ THISPIXELBLUEERROR (\GETBASEPTR BLUEERRTABLEPTR 0))
		(\PUTBASEPTR BLUEERRTABLEPTR 0 0)
		(SETFILEPTR REDOFD Y)
		(SETFILEPTR GREENOFD Y)
		(SETFILEPTR BLUEOFD Y)
		(for X from 1 to WIDTH
		   do [\PUTBASE BASE 0 (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.BESTCOLOR.AND.SPREAD.ERR.)
								     8)
							       (.GET.BESTCOLOR.AND.SPREAD.ERR.]
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT
  [LAMBDA (FILE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT 
		HOW FILTER NBITS LOBITADDRESS)               (* rrb " 7-SEP-83 14:33")

          (* puts an ais image from FILE into a bitmap. The arguments are the same as BITBLTs where possible.
	  HOW specifies how the number of bits per pixel is condensed if reduction is necessary; TRUNCATE is truncate;
	  FSA is Floyd-Steinberg algorithm; MODULATE is modulated with a random function. If NBITS is given, the file is 
	  reduced to that number of bits and they are put into the byte so that the low order bit is at LOBITADDRESS.)


    (PROG ((DEST DESTINATION)
	   NEWWINDOW OFD BITSPERPIXEL BASE BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH LEFT BOTTOM 
	   RIGHT TOP BITSPERSAMPLE SAMPLESPERWORD SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE DD WINDOW 
	   TMP STODX STODY STARTLINE STARTBIT BITOFFSET BITMAP)
                                                             (* check the file.)
          [COND
	    ((OR (SETQ OFD (FINDFILE FILE NIL AISDIRECTORIES))
		 (SETQ OFD FILE))
	      (SETQ OFD (GETSTREAM (OPENFILE OFD (QUOTE INPUT))
				   (QUOTE INPUT]             (* make sure the file is an AIS file and read its bits 
							     per sample, width and height.)
          (SETQ TMP (INSUREAISFILE OFD))
          (SETQ BITSPERSAMPLE (CAR TMP))
          (SETQ SFILEWIDTH (CADR TMP))
          (SETQ SFILEHEIGHT (CADDR TMP))                     (* convert the words per sample line into bytes)
          (SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP)
					1))
          [COND
	    ((NULL DEST)                                     (* default to a window on the b&W screen.
							     Later this should be on the default screen.)
                                                             (* OR will be unnecessary when FULLNAME starts working.)
	      (SETQ DEST (SETQ NEWWINDOW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (COND
										 (WIDTH (IMIN WIDTH 
										       SFILEWIDTH))
										 (T SFILEWIDTH)))
								(HEIGHTIFWINDOW
								  (COND
								    (HEIGHT (IMIN HEIGHT SFILEHEIGHT))
								    (T SFILEHEIGHT))
								  T))
						  (OR (FULLNAME OFD)
						      FILE]
          [COND
	    ((WINDOWP DEST)                                  (* get the displaystream from the window.)
	      (SETQ WINDOW DEST)
	      (SETQ DEST (WINDOWPROP DEST (QUOTE DSP]
          [COND
	    ((DISPLAYSTREAMP DEST)                           (* reduce the bits to be moved by the dimensions 
							     specified in the display stream.)
	      (OR WINDOW (SETQ WINDOW (WFROMDS DEST)))
	      (SETQ DD (\GETDISPLAYDATA DEST))
	      (SETQ DESTINATIONLEFT (\DSPTRANSFORMX (OR DESTINATIONLEFT 0)
						    DD))
	      (SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY (OR DESTINATIONBOTTOM 0)
						      DD))
	      (PROGN                                         (* compute limits clipped to the displaystream)
		     (SETQ LEFT (fetch DDClippingLeft of DD))
		     (SETQ BOTTOM (fetch DDClippingBottom of DD))
		     (SETQ RIGHT (fetch DDClippingRight of DD))
		     (SETQ TOP (fetch DDClippingTop of DD)))
	      (SETQ DEST (fetch DDDestination of DD)))
	    (T                                               (* destination is a bitmap or a color bitmap.)
	       (SETQ LEFT 0)
	       (SETQ BOTTOM 0)
	       (OR DESTINATIONLEFT (SETQ DESTINATIONLEFT 0))
	       (OR DESTINATIONBOTTOM (SETQ DESTINATIONBOTTOM 0]
          (SETQ BITMAP DEST)
          (SELECTQ (TYPENAME DEST)
		   [BITMAP (SETQ RIGHT (fetch BITMAPWIDTH of DEST))
			   (SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of DEST))
			   (COND
			     ((NULL RIGHT)                   (* set right from the bitmap)
			       (SETQ RIGHT (\PIXELOFBITADDRESS BITSPERPIXEL RIGHT]
		   (\ILLEGAL.ARG DESTINATION))
          [COND
	    (NBITS (COND
		     ((EQ NBITS BITSPERPIXEL)                (* change parameters to easy case.)
		       (SETQ NBITS NIL)
		       (SETQ LOBITADDRESS NIL))
		     ((IGREATERP NBITS BITSPERPIXEL)
		       (ERROR "Can't put this many bits into this bitmap" NBITS))
		     ((IGREATERP (IPLUS LOBITADDRESS NBITS)
				 BITSPERPIXEL)
		       (\ILLEGAL.ARG LOBITADDRESS]           (* if top wasn't set from display stream clipping 
							     values, set it from the bitmap.)
          (OR TOP (SETQ TOP (fetch BITMAPHEIGHT of DEST)))
          [PROGN (SETQ LEFT (IMAX DESTINATIONLEFT LEFT))
		 (SETQ BOTTOM (IMAX DESTINATIONBOTTOM BOTTOM))
		 [COND
		   (WIDTH                                    (* width is optional)
			  (SETQ RIGHT (IMIN (IPLUS DESTINATIONLEFT WIDTH)
					    RIGHT]
		 (COND
		   (HEIGHT                                   (* height is optional)
			   (SETQ TOP (IMIN (IPLUS DESTINATIONBOTTOM HEIGHT)
					   TOP]              (* now LEFT RIGHT BOTTOM and TOP have been set to legal 
							     values within the destination bitmap.)

          (* compute the source dimensions (left right bottom top) by intersecting the source bit map, the source area to be
	  moved with the limits of the region to be moved in the destination coordinates.)


          [PROGN                                             (* compute translation for source to destination 
							     mapping)
		 [SETQ STODX (IDIFFERENCE DESTINATIONLEFT (OR SOURCELEFT (SETQ SOURCELEFT 0]
                                                             (* compute LEFT margin)
		 (SETQ LEFT (IMAX SOURCELEFT (IDIFFERENCE LEFT STODX)
				  0))                        (* compute RIGHT margin)
		 (SETQ RIGHT (IMIN SFILEWIDTH (IDIFFERENCE RIGHT STODX)))
		 [AND WIDTH (SETQ RIGHT (IMIN RIGHT (IPLUS SOURCELEFT WIDTH]
                                                             (* compute bottom margin)
                                                             (* compute translation for source to destination 
							     mapping)
		 [SETQ STODY (IDIFFERENCE DESTINATIONBOTTOM (OR SOURCEBOTTOM (SETQ SOURCEBOTTOM 0]
		 (SETQ BOTTOM (IMAX SOURCEBOTTOM (IDIFFERENCE BOTTOM STODY)
				    0))                      (* compute TOP margin)
		 (SETQ TOP (IMIN SFILEHEIGHT (IDIFFERENCE TOP STODY)))
		 (AND HEIGHT (SETQ TOP (IMIN TOP (IPLUS SOURCEBOTTOM HEIGHT]
          (COND
	    ((OR (IGEQ LEFT RIGHT)
		 (IGEQ BOTTOM TOP))                          (* left is past right or bottom is past top;
							     there is nothing to transfer.)
	      (RETURN)))                                     (* compute the parameters for the ais file.
							     This assumes the picture is scanned from upper left to 
							     lower right.)
          (SETQ STARTLINE (IDIFFERENCE SFILEHEIGHT TOP))
          (SETQ HEIGHT (IDIFFERENCE TOP BOTTOM))
          (SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of DEST))
          (SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of DEST))
          (SETQ BASE (\ADDBASE (fetch (BITMAP BITMAPBASE) of DEST)
			       (ITIMES (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of DEST)
						    (IPLUS TOP STODY))
				       BITMAPRASTERWIDTH)))
                                                             (* reduce the region moved to fall on word boundaries in
							     the destination)
          (SETQ SAMPLESPERWORD (IQUOTIENT BITSPERWORD BITSPERPIXEL))
          (SETQ STARTBIT (IPLUS LEFT STODX))
          [COND
	    ((EQ BITSPERPIXEL 1)                             (* know how to start anywhere in b&w bitmaps.)
	      (SETQ BASE (\ADDBASE BASE (FOLDLO STARTBIT BITSPERWORD)))
	      (SETQ BITOFFSET (LOGAND STARTBIT 15))
	      (SETQ WIDTH (IDIFFERENCE RIGHT LEFT)))
	    (T                                               (* find the largest word that contains only bits to be 
							     transferred into. And set the left to start there.)
	       (SETQ TMP (LOGAND (IPLUS STARTBIT (SUB1 SAMPLESPERWORD))
				 (LOGXOR (SUB1 SAMPLESPERWORD)
					 -1)))
	       (SETQ LEFT (IPLUS LEFT (IDIFFERENCE TMP STARTBIT)))
                                                             (* set the width to be an integral number of words.)
	       (SETQ WIDTH (LOGAND (IDIFFERENCE RIGHT LEFT)
				   (LOGXOR (SUB1 SAMPLESPERWORD)
					   -1)))             (* figure in offset for starting bit.)
	       (SETQ BASE (\ADDBASE BASE (IQUOTIENT TMP SAMPLESPERWORD]
          (AND WINDOW (TOTOPW WINDOW))
          (.WHILE.TOP.IF.DS. WINDOW (NEQ BITSPERSAMPLE 1)
			     (SETQ TMP
			       (SELECTQ BITSPERSAMPLE
					(4 (COND
					     ((EQ BITSPERPIXEL 8)
					       "8 BIT IMAGE FROM A 4 BIT FILE NOT IMPLEMENTED YET.")
					     ((EQ BITSPERPIXEL 4)
					       (AISBLT4TO4 OFD HOW WIDTH HEIGHT BASE 
							   BITMAPRASTERWIDTH LEFT STARTLINE 
							   SFILEBYTESPERLINE NBITS LOBITADDRESS)
					       NIL)
					     (T 
      "Blting from a 4 bit per sample file is only implemented for 4 or 8 bit per pixel bitmaps.")))
					(8 (COND
					     ((EQ BITSPERPIXEL 8)
					       (COND
						 ((AND (EQ HOW (QUOTE FSA))
						       NBITS
						       (NEQ NBITS 8))
						   (AISBLT8TOLESSFSA OFD WIDTH HEIGHT BASE 
								     BITMAPRASTERWIDTH LEFT STARTLINE 
								     SFILEBYTESPERLINE NBITS 
								     LOBITADDRESS)
						   NIL)
						 (T (AISBLT8TO8 OFD HOW WIDTH HEIGHT BASE 
								BITMAPRASTERWIDTH LEFT STARTLINE 
								SFILEBYTESPERLINE NBITS LOBITADDRESS)
						    NIL)))
					     ((EQ BITSPERPIXEL 4)
					       (COND
						 ((EQ HOW (QUOTE FSA))
						   (COND
						     (NBITS (AISBLT8TO4LESSFSA OFD WIDTH HEIGHT BASE 
									       BITMAPRASTERWIDTH LEFT 
									       STARTLINE 
									       SFILEBYTESPERLINE 
									       NBITS LOBITADDRESS))
						     (T (AISBLT8TO4FSA OFD WIDTH HEIGHT BASE 
								       BITMAPRASTERWIDTH LEFT 
								       STARTLINE SFILEBYTESPERLINE)))
						   NIL)
						 ((OR (NULL HOW)
						      (EQ HOW (QUOTE TRUNCATE)))
						   (AISBLT8TO4TRUNC OFD WIDTH HEIGHT BASE 
								    BITMAPRASTERWIDTH LEFT STARTLINE 
								    SFILEBYTESPERLINE NBITS 
								    LOBITADDRESS))
						 ((EQ HOW (QUOTE MODULATE))
						   (AISBLT8TO4MODUL OFD WIDTH HEIGHT BASE 
								    BITMAPRASTERWIDTH LEFT STARTLINE 
								    SFILEBYTESPERLINE NBITS 
								    LOBITADDRESS))
						 (T "Unknown HOW argument")))
					     ((EQ BITSPERPIXEL 1)
					       (COND
						 ((OR (NULL HOW)
						      (EQ HOW (QUOTE FSA)))
                                                             (* default to Floyd-Steinberg algorithm when going to 
							     single bit.)
						   (AISBLT8TO1FSA OFD WIDTH HEIGHT BASE 
								  BITMAPRASTERWIDTH LEFT STARTLINE 
								  SFILEBYTESPERLINE BITOFFSET FILTER))
						 ((EQ HOW (QUOTE TRUNCATE))
						   (AISBLT8TO1TRUNC OFD WIDTH HEIGHT BASE 
								    BITMAPRASTERWIDTH LEFT STARTLINE 
								    SFILEBYTESPERLINE BITOFFSET 
								    FILTER))
						 ((EQ HOW (QUOTE MODULATE))
                                                             (* (AISBLT8TO4MODUL OFD WIDTH HEIGHT BASE 
							     BITMAPRASTERWIDTH LEFT STARTLINE SFILEBYTESPERLINE NBITS
							     LOBITADDRESS))
						   (AISBLT8TO1FSA OFD WIDTH HEIGHT BASE 
								  BITMAPRASTERWIDTH LEFT STARTLINE 
								  SFILEBYTESPERLINE BITOFFSET FILTER))
						 (T "Unknown HOW argument")))
					     (T "Unknown bit per pixel size")))
					"not a 4 or 8 bit per sample file")))
          (COND
	    (TMP (ERROR TMP)))
          (CLOSEF OFD)
          (RETURN (COND
		    ((NULL DESTINATION)                      (* return the window if one was created.)
		      NEWWINDOW)
		    (T (CONS WIDTH HEIGHT])

(AISBLT8TO4MODUL
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS 
	       LOBITADDRESS)                                 (* rrb "29-OCT-82 20:08")
                                                             (* internal function that puts pixels from an ais file 
							     into an 4 bit per pixel bitmap modulating the 8 bits.)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR OFD))
	   WORD BITSTOSET RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
                                                             (* put bits in specified positions)
                                                             (* set the maximum and minimum values for the random 
							     modulation function.)
          [SETQ MODMAX (IPLUS [SUB1 (LLSH 1 (IDIFFERENCE 6 (OR NBITS 4]
			      (SUB1 (LLSH 1 (IDIFFERENCE 5 (OR NBITS 4]
          (SETQ MODMIN (IMINUS MODMAX))
          (COND
	    ((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS)))
			 0)
		 (IGREATERP RIGHTSHIFT 4))
	      (ERROR "NBITS plus LOBITADDRESS is too large.")))
          (SETQ BITSTOSET (SUB1 (EXPT 2 NBITS)))
          (SETQ BITSTOSET (LOGOR (LLSH BITSTOSET (IPLUS 12 LOBITADDRESS))
				 (LLSH BITSTOSET (IPLUS 8 LOBITADDRESS))
				 (LLSH BITSTOSET (IPLUS 4 LOBITADDRESS))
				 (LLSH BITSTOSET LOBITADDRESS)))
          (SETQ COMPLWORDMASK (LOGXOR BITSTOSET 65535))
          (for Y from 0 to (SUB1 HEIGHT)
	     do (SETQ BASE LINEBASE)
		(SETFILEPTR OFD (IPLUS DATABEG (ITIMES Y BYTESPERLINE)))
		(for X from 1 to (LRSH WIDTH 2)
		   do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
						      COMPLWORDMASK)
					      (LOGAND (LRSH (LOGOR (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
									 8)
								   (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
									 4)
								   (.4BIT.MODULATE.INTENSITY.VALUE.
								     OFD)
								   (LRSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
									 4))
							    RIGHTSHIFT)
						      BITSTOSET)))
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TOLESSFSA
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS 
	       LOBITADDRESS FILTER)                          (* rrb "29-NOV-82 12:57")
                                                             (* internal function that goes from an 8 bit file to 
							     NBITS in LOBITADDRESS position using a Floyd-Steinberg 
							     algorithm.)
                                                             (* assumes starting addresses are all word aligned.
							     Assumes file has been left pointing at the beginning of 
							     the data. NIL)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (FILTERARRAY FILTER)
	   (DATABEG (GETFILEPTR OFD))
	   (NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
					    T))
	   THISPIXELERROR ERRTABLEPTR BYTE ERR WORD BEG END COMPLWORDMASK VAL
	   (DELBITS (IDIFFERENCE 8 NBITS))
	   [LOBITSMASK (SUB1 (EXPT 2 (IDIFFERENCE 8 NBITS]
	   (MAXVALUE (SUB1 (EXPT 2 NBITS)))
	   (INTENSITYBASE (\ALLOCBLOCK (EXPT 2 NBITS)))
	   THREEEIGHTSERR)                                   (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
							     macro)
                                                             (* initialize the intensity values for each color 
							     number.)
          (for I from 0 to (SUB1 (EXPT 2 NBITS)) as INTENSITY from 0 to 255
	     by (IQUOTIENT 255 (SUB1 (EXPT 2 NBITS))) do (\PUTBASE INTENSITYBASE I INTENSITY))
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
                                                             (* NEXTLINEERRORTABLE is 1 larger so no end check is 
							     necessary in error propagation code.)
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 1))
          (SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
          (SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						     BYTESPERLINE)))
          (COND
	    ((OR (ILESSP (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS))
			 0)
		 (IGREATERP (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS))
			    8))
	      (ERROR "NBITS plus LOBITADDRESS is too large.")))
          (SETQ COMPLWORDMASK (LOGXOR (LOGOR (LLSH MAXVALUE (IPLUS 8 LOBITADDRESS))
					     (LLSH MAXVALUE LOBITADDRESS))
				      65535))
          (for Y from BEG to END by BYTESPERLINE
	     do (SETQ BASE LINEBASE)
		(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
		(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
		(\PUTBASEPTR ERRTABLEPTR 0 0)
		(SETFILEPTR OFD Y)
		(for X from 1 to WIDTH
		   do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
						      COMPLWORDMASK)
					      (LLSH (LOGOR (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
								 8)
							   (.GET.NBIT.AND.SPREAD.ERR. OFD))
						    LOBITADDRESS)))
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TO4TRUNC
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE)
                                                             (* rrb "29-OCT-82 20:07")
                                                             (* internal function that puts pixels from an ais file 
							     into an 4 bit per pixel bitmap)
                                                             (* assumes starting addresses are all word aligned.
							     Assumes file has been left pointing at the beginning of 
							     the data. NIL)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR OFD)))                       (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 2))
          (for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
	     to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						 BYTESPERLINE))
	     by BYTESPERLINE
	     do (SETQ BASE LINEBASE)
		(SETFILEPTR OFD Y)
		(for X from 1 to WIDTH
		   do (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.LEFTMOST.4BIT OFD)
						    12)
					      (LLSH (.GET.LEFTMOST.4BIT OFD)
						    8)
					      (LLSH (.GET.LEFTMOST.4BIT OFD)
						    4)
					      (.GET.LEFTMOST.4BIT OFD)))
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TO8
  [LAMBDA (OFD MODULATIONFLG WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE 
	       BYTESPERLINE NBITS LOBITADDRESS)              (* rrb "29-OCT-82 18:27")
                                                             (* internal function that puts pixels from an ais file 
							     into an 8 bit per pixel bitmap)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR OFD))
	   WORD WORDMASK RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 1))
          [COND
	    [NBITS                                           (* put bits in specified positions)
	      [COND
		(MODULATIONFLG (COND
				 ((EQ NBITS 8)               (* turn off modulation; there's enough bits for all 
							     information.)
				   (SETQ MODULATIONFLG NIL))
				 ((EQ NBITS 7)               (* special case of 7 bits)
				   (SETQ MODMAX 1)
				   (SETQ MODMIN 0))
				 (T                          (* set the maximum and minimum values for the random 
							     modulation function.)
				    [SETQ MODMAX (SUB1 (LLSH 1 (IDIFFERENCE 6 NBITS]
				    (SETQ MODMIN (IMINUS MODMAX]
	      (COND
		((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS)))
			     0)
		     (IGREATERP RIGHTSHIFT 8))
		  (ERROR "NBITS plus LOBITADDRESS is too large.")))
	      (SETQ WORDMASK (LOGOR (LLSH (SUB1 (EXPT 2 NBITS))
					  (IPLUS 8 LOBITADDRESS))
				    (LLSH (SUB1 (EXPT 2 NBITS))
					  LOBITADDRESS)))
	      (SETQ COMPLWORDMASK (LOGXOR WORDMASK 65535))
	      (for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
		 to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						     BYTESPERLINE))
		 by BYTESPERLINE
		 do (SETQ BASE LINEBASE)
		    (SETFILEPTR OFD Y)
		    (for X from 1 to WIDTH
		       do (\PUTBASE BASE 0
				    (LOGOR (LOGAND (\GETBASE BASE 0)
						   COMPLWORDMASK)
					   (LOGAND (LRSH [COND
							   [MODULATIONFLG
							     (LOGOR (LLSH (.MODULATE.INTENSITY.VALUE.
									    (BIN OFD))
									  8)
								    (.MODULATE.INTENSITY.VALUE.
								      (BIN OFD]
							   (T (LOGOR (LLSH (BIN OFD)
									   8)
								     (BIN OFD]
							 RIGHTSHIFT)
						   WORDMASK)))
			  (SETQ BASE (\ADDBASE BASE 1)))
		    (SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
	    (T                                               (* use all of the bits)
	       (for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
		  to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						      BYTESPERLINE))
		  by BYTESPERLINE
		  do (SETQ BASE LINEBASE)
		     (SETFILEPTR OFD Y)
		     (for X from 1 to WIDTH
			do (\PUTBASE BASE 0 (WIN OFD))
			   (SETQ BASE (\ADDBASE BASE 1)))
		     (SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
          (RETURN])

(AISBLT4TO4
  [LAMBDA (OFD MODULATIONFLG WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE 
	       BYTESPERLINE NBITS LOBITADDRESS)              (* rrb "29-OCT-82 18:46")
                                                             (* internal function that puts pixels from a 4 bit ais 
							     file into a 4 bit per pixel bitmap)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR OFD))
	   WORD WORDMASK RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 2))
          [COND
	    [NBITS                                           (* put bits in specified positions)
		   [COND
		     (MODULATIONFLG (COND
				      ((EQ NBITS 4)          (* turn off modulation; there's enough bits for all 
							     information.)
					(SETQ MODULATIONFLG NIL))
				      ((EQ NBITS 3)          (* special case of 3 bits)
					(SETQ MODMAX 1)
					(SETQ MODMIN 0))
				      (T                     (* set the maximum and minimum values for the random 
							     modulation function.)
					 [SETQ MODMAX (SUB1 (LLSH 1 (IDIFFERENCE 2 NBITS]
					 (SETQ MODMIN (IMINUS MODMAX]
		   (COND
		     ((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS)))
				  0)
			  (IGREATERP RIGHTSHIFT 4))
		       (ERROR "NBITS plus LOBITADDRESS is too large.")))
		   (SETQ WORDMASK (SUB1 (EXPT 2 NBITS)))
		   (SETQ WORDMASK (LOGOR (LLSH WORDMASK (IPLUS 12 LOBITADDRESS))
					 (LLSH WORDMASK (IPLUS 8 LOBITADDRESS))
					 (LLSH WORDMASK (IPLUS 4 LOBITADDRESS))
					 (LLSH WORDMASK LOBITADDRESS)))
		   (SETQ COMPLWORDMASK (LOGXOR WORDMASK 65535))
		   (for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
		      to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
							  BYTESPERLINE))
		      by BYTESPERLINE
		      do (SETQ BASE LINEBASE)
			 (SETFILEPTR OFD Y)
			 (for X from 1 to WIDTH
			    do (\PUTBASE BASE 0
					 (LOGOR (LOGAND (\GETBASE BASE 0)
							COMPLWORDMASK)
						(LOGAND (LRSH [COND
								(NIL 
                                                             (* not implemented correctly)
								     MODULATIONFLG
								     (LOGOR (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
										  8)
									    (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
										  4)
									    (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
									    (LRSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
										  4)))
								(T (LOGOR (LLSH (BIN OFD)
										8)
									  (BIN OFD]
							      RIGHTSHIFT)
							WORDMASK)))
			       (SETQ BASE (\ADDBASE BASE 1)))
			 (SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
	    (T                                               (* use all of the bits)
	       (for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
		  to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						      BYTESPERLINE))
		  by BYTESPERLINE
		  do (SETQ BASE LINEBASE)
		     (SETFILEPTR OFD Y)
		     (for X from 1 to WIDTH
			do (\PUTBASE BASE 0 (WIN OFD))
			   (SETQ BASE (\ADDBASE BASE 1)))
		     (SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
          (RETURN])

(AISBLT8TO4FSA
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE)
                                                             (* rrb "29-OCT-82 14:06")
                                                             (* internal function that puts pixels from an ais file 
							     into an 4 bit per pixel bitmap)
                                                             (* assumes starting addresses are all word aligned.
							     Assumes file has been left pointing at the beginning of 
							     the data. NIL)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (DATABEG (GETFILEPTR OFD))
	   (NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)))
	   THISPIXELERROR ERRTABLEPTR BYTE ERR)              (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
							     macro)
                                                             (* NEXTLINEERRORTABLE is 1 larger so no end check is 
							     necessary in error propagation code.)
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 2))
          (for Y from STARTSAMPLELINE to (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
	     do (SETQ BASE LINEBASE)
		(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
		(SETQ THISPIXELERROR (\GETBASE ERRTABLEPTR 0))
		(\PUTBASE ERRTABLEPTR 0 0)
		(SETFILEPTR OFD (IPLUS DATABEG STARTBYTE (ITIMES Y BYTESPERLINE)))
		(for X from 1 to WIDTH
		   do (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
						    12)
					      (LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
						    8)
					      (LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
						    4)
					      (.GET.4BIT.AND.SPREAD.ERR. OFD)))
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TO4LESSFSA
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS 
	       LOBITADDRESS FILTER)                          (* rrb "29-NOV-82 12:58")
                                                             (* internal function that puts pixels from an ais file 
							     into an 4 bit per pixel bitmap in the positions 
							     specified by LOBITS.)
                                                             (* assumes starting addresses are all word aligned.
							     Assumes file has been left pointing at the beginning of 
							     the data. NIL)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (FILTERARRAY FILTER)
	   (DATABEG (GETFILEPTR OFD))
	   (NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
					    T))
	   THISPIXELERROR ERRTABLEPTR BYTE ERR BEG END COMPLWORDMASK VAL (DELBITS (IDIFFERENCE 8 
											    NBITS))
	   [LOBITSMASK (SUB1 (EXPT 2 (IDIFFERENCE 8 NBITS]
	   (MAXVALUE (SUB1 (EXPT 2 NBITS)))
	   (INTENSITYBASE (\ALLOCBLOCK (EXPT 2 NBITS)))
	   THREEEIGHTSERR)                                   (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
							     macro)
                                                             (* initialize the intensity values for each color 
							     number.)
          (for I from 0 to (SUB1 (EXPT 2 NBITS)) as INTENSITY from 0 to 255
	     by (IQUOTIENT 255 (SUB1 (EXPT 2 NBITS))) do (\PUTBASE INTENSITYBASE I INTENSITY))
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
                                                             (* NEXTLINEERRORTABLE is 1 larger so no end check is 
							     necessary in error propagation code.)
                                                             (* set width to width in words.)
          (SETQ WIDTH (LRSH WIDTH 2))
          (SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
          (SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						     BYTESPERLINE)))
          (COND
	    ((OR (ILESSP (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS))
			 0)
		 (IGREATERP (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS))
			    4))
	      (ERROR "NBITS plus LOBITADDRESS is too large.")))
          (SETQ COMPLWORDMASK (LOGXOR (LOGOR (LLSH MAXVALUE (IPLUS 12 LOBITADDRESS))
					     (LLSH MAXVALUE (IPLUS 8 LOBITADDRESS))
					     (LLSH MAXVALUE (IPLUS 4 LOBITADDRESS))
					     (LLSH MAXVALUE LOBITADDRESS))
				      65535))
          (for Y from BEG to END by BYTESPERLINE
	     do (SETQ BASE LINEBASE)
		(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
		(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
		(\PUTBASEPTR ERRTABLEPTR 0 0)
		(SETFILEPTR OFD Y)
		(for X from 1 to WIDTH
		   do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
						      COMPLWORDMASK)
					      (LLSH (LOGOR (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
								 12)
							   (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
								 8)
							   (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
								 4)
							   (.GET.NBIT.AND.SPREAD.ERR. OFD))
						    LOBITADDRESS)))
		      (SETQ BASE (\ADDBASE BASE 1)))
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TO1FSA
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE BITOFFSET 
	       FILTER)                                       (* rrb "29-NOV-82 11:26")
                                                             (* internal function that puts pixels from an ais file 
							     into an 1 bit per pixel bitmap propagating error with 
							     the Floyd-Steinberg algorithm.)
                                                             (* Assumes file has been left pointing at the beginning 
							     of the data.)
    (DECLARE (LOCALVARS . T))
    (PROG ((LINEBASE BASE)
	   (FILTERARRAY FILTER)
	   (DATABEG (GETFILEPTR OFD))
	   (NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
					    T))
	   THISPIXELERROR ERRTABLEPTR BYTE ERR BITPTR BMWORD BEG END VAL (FIRSTWORDBITS (IDIFFERENCE
											  BITSPERWORD 
											BITOFFSET))
	   [FINALWORDMASK (SUB1 (EXPT 2 (IDIFFERENCE BITSPERWORD (LOGAND (IPLUS BITOFFSET WIDTH)
									 15]
	   (INTENSITYBASE (\ALLOCBLOCK 2))
	   THREEEIGHTSERR)                                   (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
							     macro)
                                                             (* NEXTLINEERRORTABLE is 1 larger so no end check is 
							     necessary in error propagation code.)
                                                             (* initialize the intensity values for each color 
							     number.)
          (\PUTBASE INTENSITYBASE 0 255)
          (\PUTBASE INTENSITYBASE 1 0)
          (for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
          (SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
          (SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						     BYTESPERLINE)))
          (for Y from BEG to END by BYTESPERLINE
	     do (SETQ BASE LINEBASE)                         (* load BMWORD with the bits in the first word that 
							     won't be clobbered.)
		(SETQ BMWORD (LRSH (\GETBASE BASE 0)
				   FIRSTWORDBITS))
		(SETQ BITPTR BITOFFSET)
		(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
		(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
		(\PUTBASEPTR ERRTABLEPTR 0 0)
		(SETFILEPTR OFD Y)
		[for X from 1 to WIDTH
		   do (SETQ BMWORD (LOGOR (LLSH BMWORD 1)
					  (.GET.1BIT.AND.SPREAD.ERR. OFD)))
		      [COND
			((EQ (SETQ BITPTR (ADD1 BITPTR))
			     16)                             (* store this word and move to next word.)
			  (\PUTBASE BASE 0 BMWORD)
			  (SETQ BITPTR (SETQ BMWORD 0))
			  (SETQ BASE (\ADDBASE BASE 1]
		   finally                                   (* get the unset bits from the final word on the line.)
			   (OR (EQ BITPTR 0)
			       (\PUTBASE BASE 0 (LOGOR (LLSH BMWORD (IDIFFERENCE 16 BITPTR))
						       (LOGAND (\GETBASE BASE 0)
							       FINALWORDMASK]
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(AISBLT8TO1TRUNC
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE BITOFFSET 
	       FILTER)                                       (* rrb "21-JAN-83 13:12")
                                                             (* internal function that puts pixels from an ais file 
							     into an 1 bit per pixel bitmap 
							     (truncating the error.))
                                                             (* Assumes file has been left pointing at the beginning 
							     of the data.)
    (DECLARE (LOCALVARS . T))
    (PROG [(LINEBASE BASE)
	   (FILTERARRAY FILTER)
	   (DATABEG (GETFILEPTR OFD))
	   BYTE BITPTR BMWORD BEG END VAL (FIRSTWORDBITS (IDIFFERENCE BITSPERWORD BITOFFSET))
	   (FINALWORDMASK (SUB1 (EXPT 2 (IDIFFERENCE BITSPERWORD (LOGAND (IPLUS BITOFFSET WIDTH)
									 15]
          (SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
          (SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
						     BYTESPERLINE)))
          (for Y from BEG to END by BYTESPERLINE
	     do (SETQ BASE LINEBASE)                         (* load BMWORD with the bits in the first word that 
							     won't be clobbered.)
		(SETQ BMWORD (LRSH (\GETBASE BASE 0)
				   FIRSTWORDBITS))
		(SETQ BITPTR BITOFFSET)
		(SETFILEPTR OFD Y)
		[for X from 1 to WIDTH
		   do (SETQ BMWORD (LOGOR (LLSH BMWORD 1)
					  (.GET.LEFTMOST.BIT. OFD)))
		      [COND
			((EQ (SETQ BITPTR (ADD1 BITPTR))
			     16)                             (* store this word and move to next word.)
			  (\PUTBASE BASE 0 BMWORD)
			  (SETQ BITPTR (SETQ BMWORD 0))
			  (SETQ BASE (\ADDBASE BASE 1]
		   finally                                   (* get the unset bits from the final word on the line.)
			   (OR (EQ BITPTR 0)
			       (\PUTBASE BASE 0 (LOGOR (LLSH BMWORD (IDIFFERENCE 16 BITPTR))
						       (LOGAND (\GETBASE BASE 0)
							       FINALWORDMASK]
		(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
          (RETURN NIL])

(CLOSEST.COLOR
  [LAMBDA (COLORMAP RED GREEN BLUE)                          (* rrb "26-OCT-82 14:36")
                                                             (* returns the color from colormap that is the closest 
							     according to COLOR.DISTANCE)
    (COND
      ((type? 8BITCOLORMAPP COLORMAP)
	(PROG ((COLOR# 0)
	       (MINDIST (COLOR.DISTANCE RED GREEN BLUE (.8BIT.COLORLEVEL.FETCH. COLORMAP
										(QUOTE RED)
										0)
					(.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE GREEN)
								 0)
					(.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE BLUE)
								 0)))
	       X)
	      [for I from 1 to 255 do (COND
					((ILESSP (SETQ X (COLOR.DISTANCE RED GREEN BLUE
									 (.8BIT.COLORLEVEL.FETCH.
									   COLORMAP
									   (QUOTE RED)
									   I)
									 (.8BIT.COLORLEVEL.FETCH.
									   COLORMAP
									   (QUOTE GREEN)
									   I)
									 (.8BIT.COLORLEVEL.FETCH.
									   COLORMAP
									   (QUOTE BLUE)
									   I)))
						 MINDIST)
					  (SETQ MINDIST X)
					  (SETQ COLOR# I]
	      (RETURN COLOR#)))
      (T (ERROR "not implemented yet."])

(GRAPHAISHISTOGRAM
  [LAMBDA (HISTOGRAM W)                                      (* lmm "13-DEC-82 18:42")
                                                             (* draws a historgram of the intensity levels of a 
							     picture.)
    (PROG ([W (OR W (CREATEW (GETBOXREGION 416Q 327Q]
	   ARSIZE
	   (MAX 0)
	   (MAXELT 0))
          (for I from 0 to (SETQ ARSIZE (ARRAYSIZE HISTOGRAM)) by 40Q
	     do (DRAWLINE I 12Q I 0 1 (QUOTE REPLACE)
			  W))
          [for I from 0 to (SUB1 ARSIZE) do (COND
					      ((IGREATERP (ELT HISTOGRAM I)
							  MAX)
						(SETQ MAX (ELT HISTOGRAM I))
						(SETQ MAXELT I]
          (for I from 0 to (SUB1 ARSIZE) do (DRAWLINE I 12Q I (IPLUS 12Q
								     (IQUOTIENT (ITIMES (ELT 
											HISTOGRAM I)
											310Q)
										MAX))
						      1
						      (QUOTE REPLACE)
						      W))
          (RETURN W])

(AISHISTOGRAM
  [LAMBDA (FILE REGION)                                      (* rrb " 2-NOV-82 19:36")
                                                             (* returns an array that have the number of pixels in 
							     FILE that have each intensity.)
    (PROG (OFD DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE LEFT 
	       BOTTOM RIGHT TOP WIDTH HEIGHT BEG END)
          [COND
	    ((OR (SETQ OFD (FINDFILE FILE NIL AISDIRECTORIES))
		 (SETQ OFD FILE))
	      (SETQ OFD (GETSTREAM (OPENFILE OFD (QUOTE INPUT))
				   (QUOTE INPUT]
          (SETQ TMP (INSUREAISFILE OFD))
          (SETQ BITSPERSAMPLE (CAR TMP))
          (SETQ SFILEWIDTH (CADR TMP))
          (SETQ SFILEHEIGHT (CADDR TMP))
          (SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP)
					1))
          (SETQ DATABEG (GETFILEPTR OFD))
          (SETQ AISHISTOGRAM (ARRAY (EXPT 2 BITSPERSAMPLE)
				    NIL 0 0))
          [COND
	    [REGION (SETQ LEFT (IMAX (IMIN (fetch (REGION LEFT) of REGION)
					   (SUB1 SFILEWIDTH))
				     0))
		    (SETQ RIGHT (IMAX (IMIN SFILEWIDTH (fetch (REGION PRIGHT) of REGION))
				      0))
		    [COND
		      ((IGEQ LEFT RIGHT)
			(RETURN AISHISTOGRAM))
		      (T (SETQ WIDTH (IDIFFERENCE RIGHT LEFT]
		    (SETQ BOTTOM (IMIN (fetch (REGION BOTTOM) of REGION)
				       (SUB1 SFILEHEIGHT)))
		    (SETQ TOP (IMIN SFILEHEIGHT (fetch (REGION PTOP) of REGION)))
		    (COND
		      ((IGREATERP BOTTOM TOP)
			(RETURN AISHISTOGRAM)))
		    (SETQ BEG (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE 
										      SFILEHEIGHT TOP)
							    )
						    LEFT)))
		    (SETQ END (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE 
										      SFILEHEIGHT 
											   BOTTOM))
						    LEFT)))
		    (for LINE from BEG to END by SFILEBYTESPERLINE
		       do (SETFILEPTR OFD LINE)
			  (for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (BIN OFD))
							    (ADD1 (ELT AISHISTOGRAM TMP]
	    (T (for LINE from 1 to SFILEHEIGHT do (for BIT from 1 to SFILEBYTESPERLINE
						     do (SETA AISHISTOGRAM (SETQ TMP (BIN OFD))
							      (ADD1 (ELT AISHISTOGRAM TMP]
          (CLOSEF OFD)
          (RETURN AISHISTOGRAM])

(SMOOTHEDFILTER
  [LAMBDA (AISHISTOGRAM)                                     (* lmm "13-DEC-82 18:40")
                                                             (* returns a 400Q to 400Q mapping array that maximally 
							     distributes the intensity values by looking at the 
							     histogram array AISHISTOGRAM)
    (PROG ((ARSIZE (ARRAYSIZE AISHISTOGRAM))
	   SMOOTHARRAY TOTALPOINTS (POINTSLESS 0)
	   FILEINTENSITY
	   (NEWINTENSITY 0)
	   (POINTSPAST 0)
	   BUCKETSIZE NTOMOVE NPTS)
          (SETQ SMOOTHARRAY (ARRAY ARSIZE NIL 0 0))
          (SETQ TOTALPOINTS (for I from 0 to (SUB1 ARSIZE) sum (ELT AISHISTOGRAM I)))
          (SETQ BUCKETSIZE (IQUOTIENT TOTALPOINTS 400Q))
          [for I from 0 to (SUB1 ARSIZE) do (COND
					      [(IGREATERP [SETQ POINTSLESS (IPLUS POINTSLESS
										  (SETQ NPTS
										    (ELT AISHISTOGRAM 
											 I]
							  BUCKETSIZE)
						(SETQ NTOMOVE (IQUOTIENT POINTSLESS BUCKETSIZE))
						(SETA SMOOTHARRAY I (IPLUS NEWINTENSITY
									   (IQUOTIENT NTOMOVE 2)))
						[SETQ NEWINTENSITY (COND
						    ((IGREATERP NEWINTENSITY 377Q)
						      377Q)
						    (T (IPLUS NEWINTENSITY NTOMOVE]
						(SETQ POINTSLESS (IDIFFERENCE POINTSLESS
									      (ITIMES NTOMOVE 
										      BUCKETSIZE]
					      (T (SETA SMOOTHARRAY I NEWINTENSITY]
          (RETURN SMOOTHARRAY])

(SLOW.COLOR.DISTANCE
  [LAMBDA (RED GREEN BLUE REDENTRY GREENENTRY BLUEENTRY)     (* rrb "25-OCT-82 17:30")
                                                             (* returns a closeness measure for colors.)
    (IPLUS (SQUARE (IDIFFERENCE RED REDENTRY))
	   (SQUARE (IDIFFERENCE GREEN GREENENTRY))
	   (SQUARE (IDIFFERENCE BLUE BLUEENTRY])

(FAST.COLOR.DISTANCE
  [LAMBDA (RED GREEN BLUE REDENTRY GREENENTRY BLUEENTRY)     (* rrb "26-OCT-82 12:48")
                                                             (* returns a closeness measure for colors.)
    (IPLUS (IABS (IDIFFERENCE RED REDENTRY))
	   (IABS (IDIFFERENCE GREEN GREENENTRY))
	   (IABS (IDIFFERENCE BLUE BLUEENTRY])

(INSUREAISFILE
  [LAMBDA (OFD)                                              (* rrb "14-NOV-83 12:08")
                                                             (* make sure a file is an ais file and put fileptr at 
							     beginning of data. Returns a list of bitspersample, 
							     width and height)
    (PROG (HEADERLENGTH WIDTH HEIGHT BITSPERSAMPLE WORDSPERLINE)
          (COND
	    ((EQ (WIN OFD)
		 33962)                                      (* check for AIS password)
	      NIL)
	    (T (ERROR (FULLNAME OFD)
		      " is not an AIS file.")))
          (SETQ HEADERLENGTH (WIN OFD))
          (COND
	    ((NEQ (LRSH (WIN OFD)
			10)
		  1)                                         (* unknown raster part type -
							     ignore the raster part length NIL)
	      (ERROR "not implemented to handle raster parts of this type.")))
          (SETQ HEIGHT (WIN OFD))
          (SETQ WIDTH (WIN OFD))                             (* ignore how the scan was done for now.)
          (WIN OFD)
          (COND
	    ((NEQ (WIN OFD)
		  1)
	      (ERROR "not 1 sample per pixel.")))
          (COND
	    ((NEQ (WIN OFD)
		  1)
	      (ERROR "Coding type is not 1 - UCA" NIL)))
          (SETQ BITSPERSAMPLE (WIN OFD))
          (SETQ WORDSPERLINE (WIN OFD))
          (SETFILEPTR OFD (ITIMES 2 HEADERLENGTH))
          (RETURN (LIST BITSPERSAMPLE WIDTH HEIGHT WORDSPERLINE])

(SHOWCOLORAIS
  [LAMBDA (BASEFILE COLORMAPINFO HOW COLORBM SOURCEX SOURCEY DESTINATIONX DESTINATIONY WIDTH HEIGHT)
                                                             (* rrb "21-DEC-82 21:56")

          (* reads a color image from three files -
	  red, green and blue. returns the size (width . height) of the read image If COLORMAPINFO is a colormap, each point
	  is taken into the closed color in colormap. If COLORMAPINFO is a list of numbers totaling the number of bits in 
	  the color bitmap and a segmented colormap is created.)


    (OR COLORBM (SETQ COLORBM (COLORSCREENBITMAP)))
    (COND
      ((LISTP COLORMAPINFO)
	(PROG ((REDBITS (CAR COLORMAPINFO))
	       (GREENBITS (CADR COLORMAPINFO))
	       (BLUEBITS (CADDR COLORMAPINFO))
	       X VALUE (NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM)))
	      (SCREENCOLORMAP (THREECOLORMAP REDBITS GREENBITS BLUEBITS NBITS))
	      (SETQ X (UNPACKFILENAME BASEFILE))
	      [OR (EQ REDBITS 0)
		  (SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
								  (CONCAT (LISTGET X (QUOTE NAME))
									  "-RED")
								  (QUOTE EXTENSION)
								  "AIS")
							    X))
				      SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT 
				      HOW NIL REDBITS (IDIFFERENCE NBITS REDBITS]
	      [OR (EQ GREENBITS 0)
		  (SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
								  (CONCAT (LISTGET X (QUOTE NAME))
									  "-GREEN")
								  (QUOTE EXTENSION)
								  "AIS")
							    X))
				      SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT 
				      HOW NIL GREENBITS (IDIFFERENCE NBITS (IPLUS REDBITS GREENBITS]
	      [OR (EQ BLUEBITS 0)
		  (SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
								  (CONCAT (LISTGET X (QUOTE NAME))
									  "-BLUE")
								  (QUOTE EXTENSION)
								  "AIS")
							    X))
				      SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT 
				      HOW NIL BLUEBITS (IDIFFERENCE NBITS (IPLUS GREENBITS BLUEBITS 
										 REDBITS]
	      (RETURN VALUE)))
      [(type? 8BITCOLORMAPP COLORMAPINFO)
	(PROG (X)
	      (SCREENCOLORMAP COLORMAPINFO)
	      (SETQ X (UNPACKFILENAME BASEFILE))
	      (RETURN (SHOWCOLORAIS1 (OPENSTREAM (PACKFILENAME
						   (APPEND (LIST (QUOTE NAME)
								 (CONCAT (LISTGET X (QUOTE NAME))
									 "-RED")
								 (QUOTE EXTENSION)
								 "AIS")
							   X))
						 (QUOTE INPUT))
				     (OPENSTREAM (PACKFILENAME
						   (APPEND (LIST (QUOTE NAME)
								 (CONCAT (LISTGET X (QUOTE NAME))
									 "-GREEN")
								 (QUOTE EXTENSION)
								 "AIS")
							   X))
						 (QUOTE INPUT))
				     (OPENSTREAM (PACKFILENAME
						   (APPEND (LIST (QUOTE NAME)
								 (CONCAT (LISTGET X (QUOTE NAME))
									 "-BLUE")
								 (QUOTE EXTENSION)
								 "AIS")
							   X))
						 (QUOTE INPUT))
				     HOW COLORBM COLORMAPINFO]
      (T (\ILLEGAL.ARG COLORMAPINFO])

(SHOWCOLORAIS1
  [LAMBDA (REDOFD GREENOFD BLUEOFD HOW COLORBM COLORMAP)     (* rrb "21-DEC-82 21:57")
                                                             (* puts a color image into a color bitmap choosing 
							     colors that are closest to the ones in COLORMAP.)
    (PROG ((BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM))
	   BASE BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH WIDTH HEIGHT BITSPERSAMPLE BYTESPERLINE)
          (SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of COLORBM))
          (SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of COLORBM))
          (SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of COLORBM))
          (SETQ BASE (fetch (BITMAP BITMAPBASE) of COLORBM))
          (SETQ HEIGHT (INSUREAISFILE REDOFD))
          (COND
	    ((IGREATERP (SETQ WIDTH (CADR HEIGHT))
			BITMAPWIDTH)
	      (ERROR "Can't read AIS files whose width is greater than the target bitmap - yet.")))
          (SETQ BITSPERSAMPLE (CAR HEIGHT))
          (SETQ BYTESPERLINE (LLSH (CADDDR HEIGHT)
				   1))
          (SETQ HEIGHT (CADDR HEIGHT))
          (INSUREAISFILE GREENOFD)
          (INSUREAISFILE BLUEOFD)
          (COND
	    ((AND (EQ BITSPERPIXEL 8)
		  (EQ BITSPERSAMPLE 8))
	      (24BITCOLORTO8BITMAP REDOFD GREENOFD BLUEOFD (IMIN WIDTH BITMAPWIDTH)
				   (IMIN HEIGHT BITMAPHEIGHT)
				   BASE BYTESPERLINE BITMAPRASTERWIDTH COLORMAP))
	    (T (ERROR " can only go from three 8 bit color files into an 8 bit colormap for now.")))
          (CLOSEF REDOFD)
          (CLOSEF GREENOFD)
          (CLOSEF BLUEOFD)
          (RETURN (CONS WIDTH HEIGHT])

(THREECOLORMAP
  [LAMBDA (REDBITS GREENBITS BLUEBITS NBITS)                 (* rrb "17-NOV-82 17:08")
                                                             (* creates a color map with the specified number of bits
							     allocated per primary color. Always has the RED bits on 
							     the left.)
    (PROG [(NCOLORS (IPLUS REDBITS GREENBITS BLUEBITS))
	   [REDSTEP (IQUOTIENT 255 (SUB1 (EXPT 2 REDBITS]
	   [GREENSTEP (IQUOTIENT 255 (SUB1 (EXPT 2 GREENBITS]
	   (BLUESTEP (IQUOTIENT 255 (SUB1 (EXPT 2 BLUEBITS]
          (RETURN (COND
		    ((OR (EQ NCOLORS 8)
			 (EQ NCOLORS 4))
		      (COLORMAPCREATE [for R from 0 to 255 by REDSTEP
					 join (for G from 0 to 255 by GREENSTEP
						 join (for B from 0 to 255 by BLUESTEP
							 collect (LIST R G B]
				      NBITS))
		    (T (ERROR "not 8 bits specified"])

(WIN
  [LAMBDA (OFD)
    (LOGOR (LLSH (BIN OFD)
		 8)
	   (BIN OFD])

(WOUT
  [LAMBDA (OFD WORD)                                         (* rrb "20-OCT-82 17:24")
                                                             (* writes two bytes onto a file.)
    (BOUT OFD (LRSH WORD 8))
    (BOUT OFD (LOGAND WORD 255])

(WRITEAIS
  [LAMBDA (COLORBM FILE REGION)                              (* rrb "21-DEC-82 21:59")
                                                             (* writes a bitmap on to a file in AIS format.)
    (OR (type? BITMAP COLORBM)
	(SETQ COLORBM (COLORSCREENBITMAP)))
    (PROG ((OFD (GETSTREAM (OPENFILE FILE (QUOTE OUTPUT))
			   (QUOTE OUTPUT)))
	   (BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM))
	   BASE
	   (HEADERLENGTH 1024)
	   BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH LEFT BOTTOM WIDTH HEIGHT)
          (SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of COLORBM))
          (SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of COLORBM))
                                                             (* convert width to pixels)
          (SETQ BITMAPWIDTH (BITMAPWIDTH COLORBM))
          (SETQ BASE (fetch (BITMAP BITMAPBASE) of COLORBM))
                                                             (* calculate the dimensions of the area to be written 
							     out.)
          (COND
	    [(REGIONP REGION)
	      (SETQ LEFT (fetch (REGION LEFT) of REGION))
	      [COND
		((AND (EQ BITSPERPIXEL 4)
		      (EQ 1 (LOGAND LEFT 1)))
		  (printout T "LEFT will be reduced by 1 to fall on byte boundary.")
		  (SETQ LEFT (SUB1 LEFT]
	      (SETQ BOTTOM (fetch (REGION BOTTOM) of REGION))
	      (SETQ WIDTH (IMIN (fetch (REGION WIDTH) of REGION)
				(IDIFFERENCE BITMAPWIDTH LEFT)))
	      (SELECTQ BITSPERPIXEL
		       [8 (COND
			    ((EQ 1 (LOGAND WIDTH 1))         (* increase width to full word.)
			      (SETQ WIDTH (ADD1 WIDTH))
			      (printout T 
			"WIDTH will be increased by 1 to make each line an even number of words."]
		       [4 (COND
			    ((NEQ 0 (LOGAND WIDTH 3))        (* increase width to full word.)
			      [SETQ WIDTH (IPLUS WIDTH (IDIFFERENCE 4 (LOGAND WIDTH 3]
			      (printout T 
			  "WIDTH will be increased to make each line a number of complete words."]
		       (SHOULDNT))
	      (SETQ HEIGHT (IMIN (fetch (REGION HEIGHT) of REGION)
				 (IDIFFERENCE BITMAPHEIGHT BOTTOM]
	    (REGION (\ILLEGAL.ARG REGION))
	    (T (SETQ LEFT 0)
	       (SETQ BOTTOM 0)
	       (SETQ WIDTH BITMAPWIDTH)
	       (SETQ HEIGHT BITMAPHEIGHT)))                  (* write AIS password)
          (WOUT OFD 33962)                                   (* write header length in words -
							     must be a multiple of 1024)
          (WOUT OFD HEADERLENGTH)                            (* set type and length of raster part header)
          (WOUT OFD (LOGOR (LLSH 1 10)
			   10))                              (* Scan count)
          (WOUT OFD HEIGHT)                                  (* ScanLength)
          (WOUT OFD WIDTH)                                   (* Scan Dir)
          (WOUT OFD 3)                                       (* samples per pixel.)
          (WOUT OFD 1)                                       (* coding type -
							     UnCompressedArray)
          (WOUT OFD 1)                                       (* bits per sample)
          (WOUT OFD BITSPERPIXEL)                            (* words per sample line.)
          [WOUT OFD (COND
		  ((EQ BITSPERPIXEL 8)
		    (LRSH WIDTH 1))
		  (T (LRSH WIDTH 2]                          (* Sample lines per block -
							     no blocks is 16 bit -1)
          (WOUT OFD 65535)                                   (* padding words per block -
							     -1 if no blocks.)
          (WOUT OFD 65535)                                   (* header length is in words.)
          (SETFILEPTR OFD (ITIMES 2 HEADERLENGTH))           (* this would be a good place to dump the color map 
							     information)
          (WRITEAIS1 OFD [\ADDBASE BASE (ITIMES BITMAPRASTERWIDTH (IDIFFERENCE BITMAPHEIGHT
									       (IPLUS BOTTOM HEIGHT]
		     (COND
		       ((EQ BITSPERPIXEL 8)
			 WIDTH)
		       (T (LRSH WIDTH 1)))
		     (COND
		       ((EQ BITSPERPIXEL 8)
			 LEFT)
		       (T (LRSH LEFT 1)))
		     HEIGHT BITMAPRASTERWIDTH)
          (RETURN (CLOSEF OFD])

(WRITEAIS1
  [LAMBDA (OFD LINEBASE NBYTESPERLINE FIRSTBYTEOFFSET HEIGHT BITMAPRASTERWIDTH)
                                                             (* rrb "20-OCT-82 17:11")
                                                             (* dumps the bits from the bitmap with base BASE onto 
							     the file OFD.)
    (for Y from 1 to HEIGHT do (\BOUTS OFD LINEBASE FIRSTBYTEOFFSET NBYTESPERLINE)
			       (SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS .8BIT.COLORLEVEL.FETCH. MACRO ((COLORMAP PRIMARY COLOR#)
	   (SELECTQ PRIMARY
		    [RED (PROG [(CE (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES) of COLORMAP)
					      (LLSH COLOR# 1]
			       (RETURN (IPLUS (LLSH (fetch RedHi of CE)
						    4)
					      (fetch RedLo of CE]
		    [BLUE (fetch Blue of (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES)
						      of COLORMAP)
						   (LLSH COLOR# 1]
		    [GREEN (fetch Green of (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES)
							of COLORMAP)
						     (LLSH COLOR# 1]
		    (\ILLEGAL.ARG PRIMARYCOLOR))))

(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO [(OFD)
					   (PROGN            (* returns the 4 most significant bits taking into 
							     account the error and spreads the error into the 
							     appropriate places.)
						  (SETQ BYTE (IPLUS (BIN OFD)
								    THISPIXELERROR))
						  (PROG1 (COND
							   ((IGREATERP BYTE 255)
                                                             (* overflow case)
							     15)
							   (T (LRSH BYTE 4)))
							 (SETQ ERR (LOGAND BYTE 15))
                                                             (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/8 to one below and to the right.)
                                                             (* calculate 1/4 of error.)
							 (SETQ ERR (LRSH ERR 2))
                                                             (* 3/8 of error to next pixel plus error from previous 
							     line)
							 [SETQ THISPIXELERROR
							   (IPLUS (\GETBASE ERRTABLEPTR 1)
								  (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
							 (\PUTBASE ERRTABLEPTR 1 (LRSH ERR 1))
                                                             (* 3/8 to one below)
							 [\PUTBASE ERRTABLEPTR 0
								   (IPLUS (\GETBASE ERRTABLEPTR 0)
									  (IPLUS ERR
										 (LRSH ERR 1]
							 (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 1])

(PUTPROPS .GET.1BIT.AND.SPREAD.ERR. MACRO [(OFD)
	   (PROGN                                            (* returns the most significant bit taking into account 
							     the error and spreads the error into the appropriate 
							     places.)
		  (SETQ BYTE (IPLUS (COND
				      (FILTERARRAY (ELT FILTERARRAY (BIN OFD)))
				      (T (BIN OFD)))
				    THISPIXELERROR))
		  (PROG1 [SETQ VAL (COND
			     ((IGREATERP BYTE 255)           (* overflow case)
			       0)
			     ((IGREATERP 0 BYTE)             (* overflow case)
			       1)
			     (T (LOGXOR (LRSH BYTE 7)
					1]
			 (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL)))
                                                             (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/4 to one below and to the right.)
                                                             (* calculate 1/4 of error.)
			 (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
						      2)
						64))         (* 3/8 of error to next pixel plus error from previous 
							     line)
			 [SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2)
						     (SETQ THREEEIGHTSERR
						       (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
										     1)
									       128]
                                                             (* 1/4 of error to next one down to right.)
			 (\PUTBASEPTR ERRTABLEPTR 2 ERR)     (* 3/8 to one below)
			 (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0)
							   THREEEIGHTSERR))
			 (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2])

(PUTPROPS .GET.NBIT.AND.SPREAD.ERR. MACRO [(OFD)
	   (PROGN                                            (* returns the NBITS most significant bits taking into 
							     account the error and spreads the error into the 
							     appropriate places.)
		  (SETQ BYTE (IPLUS (COND
				      (FILTERARRAY (ELT FILTERARRAY (BIN OFD)))
				      (T (BIN OFD)))
				    THISPIXELERROR))
		  (PROG1 [SETQ VAL (COND
			     ((IGREATERP BYTE 255)           (* overflow case)
			       MAXVALUE)
			     ((IGREATERP 0 BYTE)
			       0)
			     (T (LRSH BYTE DELBITS]          (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/8 to one below and to the right.)
			 (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL)))
                                                             (* calculate 1/4 of error.)
			 (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
						      2)
						64))         (* 3/8 of error to next pixel plus error from previous 
							     line)
			 [SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2)
						     (SETQ THREEEIGHTSERR
						       (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
										     1)
									       128]
                                                             (* 1/8 of error to next one down to right.)
			 (\PUTBASEPTR ERRTABLEPTR 2 ERR)     (* 3/8 to one below)
			 (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0)
							   THREEEIGHTSERR))
			 (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2])

(PUTPROPS .GET.LEFTMOST.4BIT MACRO ((OFD)                    (* returns the 4 most significant bits)
				    (LRSH (BIN OFD)
					  4)))

(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((OFD)

          (* returns the most significant bit from an 8 bit sample. It also inverts the sign of the bit since 1 is black and
	  0 white. NIL)


				    (COND
				      ((IGREATERP (COND
						    (FILTERARRAY (ELT FILTERARRAY (BIN OFD)))
						    (T (BIN OFD)))
						  127)
					0)
				      (T 1))))

(PUTPROPS .GET.BESTCOLOR.AND.SPREAD.ERR. MACRO (NIL
	    (PROGN                                           (* returns the best matching color bits taking into 
							     account the error and spreads the error into the 
							     appropriate places.)
		   [SETQ COLOR (CLOSEST.COLOR COLORMAP (SETQ REDBYTE (IPLUS (BIN REDOFD)
									    THISPIXELREDERROR))
					      (SETQ GREENBYTE (IPLUS (BIN GREENOFD)
								     THISPIXELGREENERROR))
					      (SETQ BLUEBYTE (IPLUS (BIN BLUEOFD)
								    THISPIXELBLUEERROR]
		   (PROGN (SETQ ERR (IDIFFERENCE (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE RED)
									  COLOR)
						 REDBYTE))
			  [COND
			    [(IGREATERP ERR -1)              (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/8 to one below and to the right.)
                                                             (* calculate 1/4 of error.)
			      (SETQ ERR (LRSH ERR 2))        (* 3/8 of error to next pixel plus error from previous 
							     line)
			      [SETQ THISPIXELREDERROR (IPLUS (\GETBASEPTR REDERRTABLEPTR 2)
							     (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			      (\PUTBASEPTR REDERRTABLEPTR 2 (LRSH ERR 1))
                                                             (* 3/8 to one below)
			      (\PUTBASEPTR REDERRTABLEPTR 0 (IPLUS (\GETBASEPTR REDERRTABLEPTR 0)
								   (IPLUS ERR (LRSH ERR 1]
			    (T                               (* error is negative, do things differently.)
                                                             (* calculate 1/4 of error.)
			       (SETQ ERR (LRSH (IMINUS ERR)
					       2))           (* 3/8 of error to next pixel plus error from previous 
							     line)
			       [SETQ THISPIXELREDERROR (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 2)
								    (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			       (\PUTBASEPTR REDERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
                                                             (* 3/8 to one below)
			       (\PUTBASEPTR REDERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 
										       0)
									  (IPLUS ERR
										 (LRSH ERR 1]
			  (SETQ REDERRTABLEPTR (\ADDBASE REDERRTABLEPTR 2)))
		   (PROGN (SETQ ERR (IDIFFERENCE (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE GREEN)
									  COLOR)
						 GREENBYTE))
			  [COND
			    [(IGREATERP ERR -1)              (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/8 to one below and to the right.)
                                                             (* calculate 1/4 of error.)
			      (SETQ ERR (LRSH ERR 2))        (* 3/8 of error to next pixel plus error from previous 
							     line)
			      [SETQ THISPIXELGREENERROR (IPLUS (\GETBASEPTR GREENERRTABLEPTR 2)
							       (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			      (\PUTBASEPTR GREENERRTABLEPTR 2 (LRSH ERR 1))
                                                             (* 3/8 to one below)
			      (\PUTBASEPTR GREENERRTABLEPTR 0 (IPLUS (\GETBASEPTR GREENERRTABLEPTR 0)
								     (IPLUS ERR (LRSH ERR 1]
			    (T                               (* error is negative, do things differently.)
                                                             (* calculate 1/4 of error.)
			       (SETQ ERR (LRSH (IMINUS ERR)
					       2))           (* 3/8 of error to next pixel plus error from previous 
							     line)
			       [SETQ THISPIXELGREENERROR (IDIFFERENCE (\GETBASEPTR GREENERRTABLEPTR 2)
								      (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			       (\PUTBASEPTR GREENERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
                                                             (* 3/8 to one below)
			       (\PUTBASEPTR GREENERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR 
										 GREENERRTABLEPTR 0)
									    (IPLUS ERR
										   (LRSH ERR 1]
			  (SETQ GREENERRTABLEPTR (\ADDBASE GREENERRTABLEPTR 2)))
		   (PROGN (SETQ ERR (IDIFFERENCE (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE BLUE)
									  COLOR)
						 BLUEBYTE))
			  [COND
			    [(IGREATERP ERR -1)              (* put 3/8 of error into next pixel, 3/8 to one below 
							     and 1/8 to one below and to the right.)
                                                             (* calculate 1/4 of error.)
			      (SETQ ERR (LRSH ERR 2))        (* 3/8 of error to next pixel plus error from previous 
							     line)
			      [SETQ THISPIXELBLUEERROR (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 2)
							      (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			      (\PUTBASEPTR BLUEERRTABLEPTR 2 (LRSH ERR 1))
                                                             (* 3/8 to one below)
			      (\PUTBASEPTR BLUEERRTABLEPTR 0 (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 0)
								    (IPLUS ERR (LRSH ERR 1]
			    (T                               (* error is negative, do things differently.)
                                                             (* calculate 1/4 of error.)
			       (SETQ ERR (LRSH (IMINUS ERR)
					       2))           (* 3/8 of error to next pixel plus error from previous 
							     line)
			       [SETQ THISPIXELBLUEERROR (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR 2)
								     (IPLUS ERR (LRSH ERR 1]
                                                             (* 1/8 of error to next one down to right.)
			       (\PUTBASEPTR BLUEERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
                                                             (* 3/8 to one below)
			       (\PUTBASEPTR BLUEERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR 
										  BLUEERRTABLEPTR 0)
									   (IPLUS ERR
										  (LRSH ERR 1]
			  (SETQ BLUEERRTABLEPTR (\ADDBASE BLUEERRTABLEPTR 2)))
		   COLOR)))

(PUTPROPS .4BIT.MODULATE.INTENSITY.VALUE. MACRO ((STREAM)
						 (LOGAND (IMIN 255 (IMAX (IPLUS (BIN STREAM)
										(RAND MODMIN MODMAX))
									 0))
							 240)))

(PUTPROPS .MODULATE.INTENSITY.VALUE. MACRO ((STREAM)
					    (IMIN 255 (IMAX (IPLUS (BIN STREAM)
								   (RAND MODMIN MODMAX))
							    0))))

(PUTPROPS SQUARE MACRO [LAMBDA (X)                           (* coded this way because negative arith is not is 
							     microcode for ITIMES)
			 (COND
			   ((IGREATERP X -1)
			     (ITIMES X X))
			   (T (ITIMES (SETQ X (IMINUS X))
				      X])
)
(MOVD? (QUOTE FAST.COLOR.DISTANCE)
       (QUOTE COLOR.DISTANCE))

(RPAQQ AISDIRECTORIES ({CORE} {DSK} {PHYLUM}<AIS> {indigo}<ais>))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS AISDIRECTORIES)
)
(PUTPROPS READAIS COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1054 57680 (24BITCOLORTO8BITMAP 1064 . 3589) (AISBLT 3591 . 15339) (AISBLT8TO4MODUL 
15341 . 17540) (AISBLT8TOLESSFSA 17542 . 20687) (AISBLT8TO4TRUNC 20689 . 22138) (AISBLT8TO8 22140 . 
25205) (AISBLT4TO4 25207 . 28596) (AISBLT8TO4FSA 28598 . 30502) (AISBLT8TO4LESSFSA 30504 . 33882) (
AISBLT8TO1FSA 33884 . 36952) (AISBLT8TO1TRUNC 36954 . 39069) (CLOSEST.COLOR 39071 . 40201) (
GRAPHAISHISTOGRAM 40203 . 41140) (AISHISTOGRAM 41142 . 43462) (SMOOTHEDFILTER 43464 . 44871) (
SLOW.COLOR.DISTANCE 44873 . 45230) (FAST.COLOR.DISTANCE 45232 . 45583) (INSUREAISFILE 45585 . 47046) (
SHOWCOLORAIS 47048 . 50016) (SHOWCOLORAIS1 50018 . 51696) (THREECOLORMAP 51698 . 52608) (WIN 52610 . 
52682) (WOUT 52684 . 52945) (WRITEAIS 52947 . 57177) (WRITEAIS1 57179 . 57678)))))
STOP