(FILECREATED "26-Jun-85 11:53:10" {ERIS}<LISPCORE>LIBRARY>READAIS.;5 71952  

      changes to:  (FNS AISBLT8TO8 AISBLT4TO4 CLOSEST.COLOR SHOWCOLORAIS)
		   (MACROS .8BIT.COLORLEVEL.FETCH.)

      previous date: "26-Jun-85 11:38:38" {ERIS}<LISPCORE>LIBRARY>READAIS.;4)


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

(PRETTYCOMPRINT READAISCOMS)

(RPAQQ READAISCOMS ((FNS 24BITCOLORTO8BITMAP AISBLT AISBLT1TO1 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 
			 PUTBITMAP.INTO.CORRECT.DESTINATION)
	(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)               (* Newman " 1-Nov-84 16:13")

          (* 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.
	  *** Last changed to eliminate problem with BLTing onto word boundaries of the screen. Now BLTs correctly into any 
	  destination without missing the window or stream.)


    (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))                  (* Save the window if one was passed in.)
          (COND
	    ((WINDOWP DEST)
	      (SETQ WINDOW DEST)))                           (* Create the bitmap to put the image in if the 
							     destination is not already a bitmap.
							     Otherwise call \ILLEGAL.ARG.)
          (COND
	    [(OR (NULL DEST)
		 (DISPLAYSTREAMP DEST)
		 (WINDOWP DEST))
	      (SETQ BITMAP (SETQ DEST (BITMAPCREATE (COND
						      (HEIGHT (IMIN HEIGHT SFILEHEIGHT))
						      (T SFILEHEIGHT))
						    (COND
						      (WIDTH (IMIN WIDTH SFILEWIDTH))
						      (T SFILEWIDTH))
						    1]
	    ((BITMAPP DEST)                                  (* destination is a bitmap or a color bitmap.)
	      (SETQ BITMAP DEST))
	    (T (\ILLEGAL.ARG DESTINATION)))
          [PROGN (SETQ LEFT 0)
		 (SETQ BOTTOM 0)
		 (OR DESTINATIONLEFT (SETQ DESTINATIONLEFT 0))
		 (OR DESTINATIONBOTTOM (SETQ DESTINATIONBOTTOM 0))
		 (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]
          [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]
          [RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
		    (.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")))
						  (1 (COND
						       ((EQ BITSPERPIXEL 1)
							 (AISBLT1TO1 OFD WIDTH HEIGHT BASE 
								     BITMAPRASTERWIDTH LEFT STARTLINE 
								     SFILEBYTESPERLINE NBITS 
								     LOBITADDRESS))
						       (T 
				       "Can only go from a 1 bit sources to a 1 bit destination.")))
						  "not a 4 or 8 bit per sample file"))
				       (COND
					 ((NOT (BITMAPP DESTINATION))
					   (PUTBITMAP.INTO.CORRECT.DESTINATION BITMAP DESTINATION]
          (COND
	    (TMP (ERROR TMP)))
          (CLOSEF OFD)
          (RETURN (COND
		    ((NULL DESTINATION)                      (* return the window if one was created.)
		      NEWWINDOW)
		    (T (CONS WIDTH HEIGHT])

(AISBLT1TO1
  [LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS 
	       LOBITADDRESS)                                 (* Newman "24-Oct-84 09:14")
                                                             (* internal function that puts pixels from a 1 bit ais 
							     file into one 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 4))
          (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])

(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)              (* hdj "26-Jun-85 11:52")
                                                             (* 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 WORD.MASK 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 WORD.MASK (LOGOR (LLSH (SUB1 (EXPT 2 NBITS))
					   (IPLUS 8 LOBITADDRESS))
				     (LLSH (SUB1 (EXPT 2 NBITS))
					   LOBITADDRESS)))
	      (SETQ COMPLWORDMASK (LOGXOR WORD.MASK 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)
						   WORD.MASK)))
			  (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)              (* hdj "26-Jun-85 11:52")
                                                             (* 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 WORD.MASK 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 WORD.MASK (SUB1 (EXPT 2 NBITS)))
		   (SETQ WORD.MASK (LOGOR (LLSH WORD.MASK (IPLUS 12 LOBITADDRESS))
					  (LLSH WORD.MASK (IPLUS 8 LOBITADDRESS))
					  (LLSH WORD.MASK (IPLUS 4 LOBITADDRESS))
					  (LLSH WORD.MASK LOBITADDRESS)))
		   (SETQ COMPLWORDMASK (LOGXOR WORD.MASK 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)
							WORD.MASK)))
			       (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)                          (* hdj "26-Jun-85 11:28")
                                                             (* returns the color from colormap that is the closest 
							     according to COLOR.DISTANCE)
    (COND
      ((type? 8BITCOLORMAP 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)
                                                             (* hdj "26-Jun-85 11:31")

          (* 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? 8BITCOLORMAP 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 " 2-Aug-84 17:24")
                                                             (* 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))
		  ((EQ BITSPERPIXEL 4)
		    (LRSH WIDTH 2))
		  (T (LRSH WIDTH 4]                          (* 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)
		       ((EQ BITSPERPIXEL 4)
			 (LRSH WIDTH 1))
		       (T (LRSH WIDTH 4)))
		     (COND
		       ((EQ BITSPERPIXEL 8)
			 LEFT)
		       ((EQ BITSPERPIXEL 4)
			 (LRSH LEFT 1))
		       (T (LRSH LEFT 4)))
		     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])

(PUTBITMAP.INTO.CORRECT.DESTINATION
  [LAMBDA (BITMAP DESTINATION)                               (* Newman "24-Oct-84 12:50")

          (* * This function puts BITMAP into DESTINATION. BITMAP should be the BITMAP created by AISBLT and DESTINATION 
	  should be the DESTINATION passed in as an argument to AISBLT. NOTE : many variables here are GLOBAL to this function
	  and LOCAL to AISBLT. --DVN)


    (COND
      [(NULL DESTINATION)
	(BITBLT BITMAP 0 0 (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]
      ((OR (WINDOWP DESTINATION)
	   (DISPLAYSTREAMP DESTINATION))
	(BITBLT BITMAP 0 0 DESTINATION))
      (T (SHOULDNT "Invalid Destination"])
)
(DECLARE: EVAL@COMPILE 
[PUTPROPS .8BIT.COLORLEVEL.FETCH. MACRO ((COLORMAP PRIMARY COLOR#)
	   (LET ((CE (COLORMAPENTRY COLORMAP COLOR#)))
		(SELECTQ PRIMARY (RED (fetch (RGB RED)
					     of CE))
			 (BLUE (fetch (RGB BLUE)
				      of CE))
			 (GREEN (fetch (RGB GREEN)
				       of CE))
			 (\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

(GLOBALVARS AISDIRECTORIES)
)
(PUTPROPS READAIS COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1214 61945 (24BITCOLORTO8BITMAP 1224 . 3749) (AISBLT 3751 . 16129) (AISBLT1TO1 16131 . 
17343) (AISBLT8TO4MODUL 17345 . 19544) (AISBLT8TOLESSFSA 19546 . 22691) (AISBLT8TO4TRUNC 22693 . 24142
) (AISBLT8TO8 24144 . 27532) (AISBLT4TO4 27534 . 31263) (AISBLT8TO4FSA 31265 . 33169) (
AISBLT8TO4LESSFSA 33171 . 36549) (AISBLT8TO1FSA 36551 . 39619) (AISBLT8TO1TRUNC 39621 . 41736) (
CLOSEST.COLOR 41738 . 42927) (GRAPHAISHISTOGRAM 42929 . 43866) (AISHISTOGRAM 43868 . 46188) (
SMOOTHEDFILTER 46190 . 47597) (SLOW.COLOR.DISTANCE 47599 . 47956) (FAST.COLOR.DISTANCE 47958 . 48309) 
(INSUREAISFILE 48311 . 49772) (SHOWCOLORAIS 49774 . 53090) (SHOWCOLORAIS1 53092 . 54770) (
THREECOLORMAP 54772 . 55682) (WIN 55684 . 55756) (WOUT 55758 . 56019) (WRITEAIS 56021 . 60397) (
WRITEAIS1 60399 . 60898) (PUTBITMAP.INTO.CORRECT.DESTINATION 60900 . 61943)))))
STOP