(FILECREATED " 4-Oct-85 15:54:24" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;82 40050  

      changes to:  (FNS \GOOD.DASHLST)

      previous date: " 1-Oct-85 00:14:21" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;81)


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

(PRETTYCOMPRINT IMAGEIOCOMS)

(RPAQQ IMAGEIOCOMS [(FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP OPENIMAGESTREAM 
			   \GOOD.DASHLST)
	(INITVARS (IMAGESTREAMTYPES NIL))
	(FNS DRAWDASHEDLINE)
	(FNS DSPBACKCOLOR DSPBOTTOMMARGIN DSPCOLOR DSPCLIPPINGREGION DSPRESET DSPFONT DSPLEFTMARGIN 
	     DSPLINEFEED DSPOPERATION DSPRIGHTMARGIN DSPTOPMARGIN DSPSCALE DSPSPACEFACTOR 
	     DSPXPOSITION DSPYPOSITION)
	(FNS DSPNEWPAGE DRAWBETWEEN DRAWCIRCLE DRAWCURVE DRAWELLIPSE DRAWLINE DRAWPOLYGON FILLPOLYGON 
	     DRAWTO FILLCIRCLE MOVETO RELDRAWTO BITMAPIMAGESIZE SCALEDBITBLT)
	(FNS \IMAGEIOINIT \UNIMPIMAGEOP)
	(DECLARE: DONTCOPY (EXPORT (MACROS IMAGEOP)
				   (RECORDS IMAGEOPS)
				   (GLOBALVARS \NOIMAGEOPS)))
	(INITRECORDS IMAGEOPS)
	(SYSRECORDS IMAGEOPS)
	(DECLARE: DONTEVAL@LOAD DOCOPY (P (\IMAGEIOINIT)))
	[COMS (* Implementation of display stream resident "files." Done here cause it might matter 
		 that the display device get defined early so that its event fn will be evaluated as 
		 the last thing before logout)
	      (FNS \DisplayEventFn \DISPLAYINIT \COLORDISPLAYINIT)
	      (ALISTS (IMAGESTREAMTYPES DISPLAY))
	      (GLOBALVARS DisplayFDEV ColorDisplayFDEV)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (\DISPLAYINIT)
						(\COLORDISPLAYINIT]
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA IMAGESTREAMP])
(DEFINEQ

(IMAGESTREAMP
  [LAMBDA NARGS                                              (* AJB " 7-Jun-85 13:44")
    (DECLARE (GLOBALVARS \TERM.OFD \PRIMOUT.OFD))
    (PROG ([STREAM (AND (IGREATERP NARGS 0)
			(SELECTQ (ARG NARGS 1)
				 (T \TERM.OFD)
				 (NIL \PRIMOUT.OFD)
				 (ARG NARGS 1]
	   STYPE)
          (OR (type? STREAM STREAM)
	      (RETURN))
          (SETQ STYPE (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of STREAM)))
          (RETURN (AND (COND
			 ((EQ NARGS 2)
			   (for X inside (ARG NARGS 2) always (EQMEMB X STYPE)))
			 (T STYPE))
		       STREAM])

(IMAGESTREAMTYPE
  [LAMBDA (STREAM)                                           (* rmk: "20-AUG-83 17:28")
    (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS) of (\STREAMARG STREAM])

(IMAGESTREAMTYPEP
  [LAMBDA (STREAM STYPE)                                     (* AJB "16-Jul-85 15:31")

          (* * Returns T if STREAM is an imagestream of type STYPE)


    (LET ((S (SELECTQ STREAM
		      ((T NIL)
			(\GETSTREAM STREAM (QUOTE OUTPUT)
				    T))
		      STREAM)))
         (AND (type? STREAM S)
	      (for X inside STYPE always (EQMEMB X (fetch (IMAGEOPS IMAGETYPE)
						      of (fetch (STREAM IMAGEOPS) of S])

(OPENIMAGESTREAM
  [LAMBDA (FILE IMAGETYPE OPTIONS)                           (* hdj "11-Jun-85 16:17")

          (* Opens an IMAGETYPE imagestream, or if NIL, an imagestream of a type that FILE (perhaps from DEFAULTPRINTINGHOST) 
	  can print directly. If FILE is an the LPT device, then the type of the corresponding printer is used.
	  If FILE is NIL, then an LPT file on a printer from default printinghost is used, so the file will be printed on 
	  closing.)


    (DECLARE (GLOBALVARS IMAGESTREAMTYPES))
    (PROG (LPTNAME LPTP (DEFPRINTER (OR (CAR (LISTP DEFAULTPRINTINGHOST))
					DEFAULTPRINTINGHOST)))
          [COND
	    ((AND (NULL FILE)
		  (NEQ IMAGETYPE (QUOTE DISPLAY)))           (* YUCK! TAKE THIS OUT WHEN WE FIGURE OUT DISPLAY 
							     IMAGESTREAMS BETTER)
	      (SETQ LPTP T)
	      (SETQ FILE (QUOTE {LPT})))
	    ((STREAMP FILE))
	    ((EQ (FILENAMEFIELD FILE (QUOTE HOST))
		 (QUOTE LPT))
	      (SETQ LPTP T)
	      (PROG (POS)

          (* This should be (FILENAMEFIELD FILE (QUOTE NAME)) except that FILENAMEFIELD won't accept : as part of the name, 
	  thinks it marks a device field. This code is borrowed from PRINTERDEVICE)


		    (AND (SETQ POS (STRPOS "}" FILE))
			 (SETQ LPTNAME (SUBATOM FILE (ADD1 POS)
						(SUB1 (OR (STRPOS "." FILE (ADD1 POS))
							  0]
          [COND
	    [(NULL IMAGETYPE)                                (* Get the image type from FILE if it is an LPT file, 
							     otherwise choose the image type from the first printer 
							     on DEFAULTPRINTINGHOST)
                                                             (* Assume that it will be printed on the 
							     defaultprintinghost if it is an ordinary filename)
	      (COND
		((SETQ IMAGETYPE (PRINTFILETYPE.FROM.EXTENSION FILE)))
		([SETQ IMAGETYPE (CAR (MKLIST (PRINTERPROP (PRINTERTYPE (OR LPTNAME DEFPRINTER))
							   (QUOTE CANPRINT]
                                                             (* If FILE is NIL, LPTNAME must be NIL and we are going
							     to DEFPRINTER)
		  )
		(T (ERROR "Can't determine IMAGETYPE for " FILE]
	    [LPTNAME (OR (EQMEMB IMAGETYPE (PRINTERPROP (PRINTERTYPE LPTNAME)
							(QUOTE CANPRINT)))
			 (ERROR (CONCAT "Printer " LPTNAME " can't print " IMAGETYPE " files"]
	    (LPTP                                            (* This includes the NIL FILE case, cause of initial 
							     coercion)
		  (for P inside DEFAULTPRINTINGHOST when (EQMEMB IMAGETYPE (PRINTERPROP (PRINTERTYPE
											  P)
											(QUOTE 
											 CANPRINT)))
		     do (SETQ FILE (PACKFILENAME (QUOTE HOST)
						 (QUOTE LPT)
						 (QUOTE NAME)
						 P))
			(RETURN)
		     finally (ERROR (CONCAT 
				    "Can't find a printer on DEFAULTPRINTINGHOST that can print "
					    IMAGETYPE " files"]
          (RETURN (APPLY* (OR [CADR (ASSOC (QUOTE OPENSTREAM)
					   (CDR (ASSOC IMAGETYPE IMAGESTREAMTYPES]
			      (ERROR "No open function for " IMAGETYPE " streams"))
			  [COND
			    ((OR LPTP (STREAMP FILE)
				 (EQ IMAGETYPE (QUOTE DISPLAY)))
			      FILE)
			    (T                               (* Stick on default extension from PRINTFILETYPES)
			       (PACKFILENAME (QUOTE BODY)
					     FILE
					     (QUOTE EXTENSION)
					     (OR [CAR (CADR (ASSOC (QUOTE EXTENSION)
								   (CDR (ASSOC IMAGETYPE 
									       PRINTFILETYPES]
						 IMAGETYPE]
			  OPTIONS])

(\GOOD.DASHLST
  [LAMBDA (DASHING BRUSH)                                    (* rrb " 4-Oct-85 15:40")

          (* * massage the DASHING parameter to mesh well with the size of the BRUSH)


    (PROG ([DASHLST (AND DASHING (OR (AND (LISTP DASHING)
						  (EVERY DASHING (FUNCTION FIXP))
						  DASHING)
					   (\ILLEGAL.ARG DASHING]
	     BRUSHSIZE)
	    [COND
	      ((AND DASHLST (GREATERP [SETQ BRUSHSIZE (COND
					      ((NULL BRUSH)
						1)
					      ((BITMAPP BRUSH)
						(IQUOTIENT (IPLUS 2 (BITMAPHEIGHT BRUSH)
								      (BITMAPWIDTH BRUSH))
							     2))
					      (T (CADR BRUSH]
					  1))                (* adjust the dashing to take into account the brush 
							     size.)
		[COND
		  ((ODDP (LENGTH DASHLST))               (* even out the DASHLST because on and off are handled
							     differently.)
		    (SETQ DASHLST (APPEND DASHLST DASHLST]
		(SETQ DASHLST (bind NOWOFF for NDASH in DASHLST
				   collect (COND
					       (NOWOFF (SETQ NOWOFF NIL)
						       (TIMES NDASH BRUSHSIZE))
					       ((SETQ NOWOFF T)
                                                             (* make the on case be 1 for the first one and 
							     brushsize for every one after that.)
						 (ADD1 (TIMES (SUB1 NDASH)
								  BRUSHSIZE]
	    (RETURN DASHLST])
)

(RPAQ? IMAGESTREAMTYPES NIL)
(DEFINEQ

(DRAWDASHEDLINE
  [LAMBDA (X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR DASHING)
                                                             (* rrb "25-Jun-85 14:59")
    (PROG ((DASHON T)
	   DASHTAIL DASHCNT (ADJACENT (IDIFFERENCE X2 X1))
	   (OPPOSITE (IDIFFERENCE Y2 Y1))
	   (LENGTHDRAWN 0)
	   DASHLST NEWX NEWY LINELENGTH SINE COSINE)
          [SETQ LINELENGTH (FIX (SQRT (IPLUS (ITIMES ADJACENT ADJACENT)
					     (ITIMES OPPOSITE OPPOSITE]
                                                             (* expand the dashing by the width.)
          (SETQ DASHLST (bind NOWOFF for NDASH in DASHING collect (TIMES NDASH WIDTH)))
          (SETQ DASHTAIL DASHLST)
          (SETQ SINE (FQUOTIENT OPPOSITE LINELENGTH))
          (SETQ COSINE (FQUOTIENT ADJACENT LINELENGTH))
          [while (ILESSP (PLUS LENGTHDRAWN (CAR DASHTAIL))
			 LINELENGTH)
	     do (SETQ DASHCNT (CAR DASHTAIL))
		(SETQ DASHTAIL (CDR DASHTAIL))
		(add LENGTHDRAWN DASHCNT)
		(SETQ NEWX (FPLUS X1 (FTIMES COSINE DASHCNT)))
		(SETQ NEWY (FPLUS Y1 (FTIMES SINE DASHCNT)))
		(COND
		  (DASHON (DRAWLINE X1 Y1 NEWX NEWY WIDTH OPERATION STREAM COLOR))
		  (T (RELMOVETO NEWX NEWY STREAM)))
		(SETQ DASHON (NOT DASHON))
		(SETQ X1 NEWX)
		(SETQ Y1 NEWY)
		(COND
		  ((NULL DASHTAIL)
		    (SETQ DASHTAIL DASHLST)))
	     finally                                         (* do last partial segment)
		     (COND
		       (DASHON (DRAWLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR]
          (MOVETO X2 Y2 STREAM])
)
(DEFINEQ

(DSPBACKCOLOR
  [LAMBDA (COLOR STREAM)                                     (* rmk: "12-Sep-84 09:53")
                                                             (* Switches background color on stream)
    (IMAGEOP (QUOTE IMBACKCOLOR)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM COLOR])

(DSPBOTTOMMARGIN
  [LAMBDA (YPOSITION STREAM)                                 (* rmk: "26-Jun-84 13:56")
                                                             (* Sets the Y position that forces a new page)
    (IMAGEOP (QUOTE IMBOTTOMMARGIN)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM YPOSITION])

(DSPCOLOR
  [LAMBDA (COLOR STREAM)                                     (* rmk: "12-Sep-84 09:53")
                                                             (* Switches foreground color on stream)
    (IMAGEOP (QUOTE IMCOLOR)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM COLOR])

(DSPCLIPPINGREGION
  [LAMBDA (REGION STREAM)                                    (* bvm: " 4-Sep-85 20:57")
                                                             (* Set the clipping region for an imagestream)
    (AND REGION (NOT (type? REGION REGION))
	 (\ILLEGAL.ARG REGION))
    (COND
      (STREAM                                                (* special check done for NIL to stop default to 
							     primary output file.)
	      (IMAGEOP (QUOTE IMCLIPPINGREGION)
		       (SETQ STREAM (\OUTSTREAMARG STREAM))
		       STREAM REGION))
      (T (\ILLEGAL.ARG STREAM])

(DSPRESET
  [LAMBDA (STREAM)                                           (* jds "11-Jan-85 16:54")
                                                             (* resets a display stream)
    (IMAGEOP (QUOTE IMRESET)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM])

(DSPFONT
  [LAMBDA (FONT STREAM)                                      (* rmk: " 2-SEP-83 10:50")
                                                             (* sets the font that an image stream uses to print 
							     characters.)
    (IMAGEOP (QUOTE IMFONT)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM FONT])

(DSPLEFTMARGIN
  [LAMBDA (XPOSITION STREAM)                                 (* rmk: " 2-SEP-83 10:50")
                                                             (* Sets the the position that a carriage return returns
							     to)
    (IMAGEOP (QUOTE IMLEFTMARGIN)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM XPOSITION])

(DSPLINEFEED
  [LAMBDA (DELTAY STREAM)                                    (* rmk: " 2-SEP-83 10:50")
                                                             (* Sets the Xposition of STREAM)
    (IMAGEOP (QUOTE IMLINEFEED)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM DELTAY])

(DSPOPERATION
  [LAMBDA (OPERATION STREAM)                                 (* rmk: "12-Sep-84 09:56")
                                                             (* sets the operation field of a stream)
    (IMAGEOP (QUOTE IMOPERATION)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM OPERATION])

(DSPRIGHTMARGIN
  [LAMBDA (XPOSITION STREAM)                                 (* rmk: " 2-SEP-83 10:51")
                                                             (* Sets the right margin that determines when a cr is 
							     inserted by print.)
    (IMAGEOP (QUOTE IMRIGHTMARGIN)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM XPOSITION])

(DSPTOPMARGIN
  [LAMBDA (YPOSITION STREAM)                                 (* rmk: "26-Jun-84 13:55")
                                                             (* Sets the Y position that a newpage starts at)
    (IMAGEOP (QUOTE IMTOPMARGIN)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM YPOSITION])

(DSPSCALE
  [LAMBDA (SCALE STREAM)                                     (* rmk: "16-Jun-84 14:48")
                                                             (* Returns (and eventually will set) the current scale 
							     of STREAM.)
    (IMAGEOP (QUOTE IMSCALE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM SCALE])

(DSPSPACEFACTOR
  [LAMBDA (FACTOR STREAM)                                    (* rmk: "27-Nov-84 18:57")
                                                             (* Sets the space factor of STREAM)
    (AND FACTOR (OR (GREATERP FACTOR 0)
		    (\ILLEGAL.ARG FACTOR)))
    (IMAGEOP (QUOTE IMSPACEFACTOR)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM FACTOR])

(DSPXPOSITION
  [LAMBDA (XPOSITION STREAM)                                 (* rmk: " 2-SEP-83 10:51")
                                                             (* Sets the Xposition of STREAM)
    (IMAGEOP (QUOTE IMXPOSITION)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM XPOSITION])

(DSPYPOSITION
  [LAMBDA (YPOSITION STREAM)                                 (* rmk: " 2-SEP-83 10:51")
                                                             (* Sets the Yposition of STREAM)
    (IMAGEOP (QUOTE IMYPOSITION)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM YPOSITION])
)
(DEFINEQ

(DSPNEWPAGE
  [LAMBDA (STREAM)                                           (* jds "12-Jan-85 09:54")
                                                             (* Start a new page on the image stream STREAM.)
    (IMAGEOP (QUOTE IMNEWPAGE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM])

(DRAWBETWEEN
  [LAMBDA (PT1 PT2 WIDTH OPERATION STREAM COLOR DASHING)     (* hdj " 7-Nov-84 14:03")
                                                             (* draws a line bwteen two points)
    (IMAGEOP (QUOTE IMDRAWLINE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM
	     (fetch XCOORD of PT1)
	     (fetch YCOORD of PT1)
	     (fetch XCOORD of PT2)
	     (fetch YCOORD of PT2)
	     WIDTH OPERATION COLOR DASHING])

(DRAWCIRCLE
  [LAMBDA (CENTERX CENTERY RADIUS BRUSH DASHING STREAM)      (* rmk: "20-Aug-84 12:05")
                                                             (* Generic DRAWCURVE)
    (COND
      ((LESSP RADIUS 0)
	(\ILLEGAL.ARG RADIUS))
      ((EQP RADIUS 0)
	NIL)
      (T (IMAGEOP (QUOTE IMDRAWCIRCLE)
		  (SETQ STREAM (\OUTSTREAMARG STREAM))
		  STREAM CENTERX CENTERY RADIUS BRUSH DASHING])

(DRAWCURVE
  [LAMBDA (KNOTS CLOSED BRUSH DASHING STREAM)                (* rmk: " 2-SEP-83 10:52")
                                                             (* draws a spline curve with a given brush.)
    (IMAGEOP (QUOTE IMDRAWCURVE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM KNOTS CLOSED BRUSH DASHING])

(DRAWELLIPSE
  [LAMBDA (CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING STREAM)
                                                             (* rmk: " 2-SEP-83 10:53")

          (* Draws an ellipse. At ORIENTATION 0, the semimajor axis is horizontal, the semiminor axis vertical.
	  Orientation is positive in the counterclockwise direction. The current location in the stream is left at the center 
	  of the ellipse.)


    (DECLARE (LOCALVARS . T))
    (IMAGEOP (QUOTE IMDRAWELLIPSE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING])

(DRAWLINE
  [LAMBDA (X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR DASHING)
                                                             (* hdj "17-Jun-85 11:27")
    (IMAGEOP (QUOTE IMDRAWLINE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING])

(DRAWPOLYGON
  [LAMBDA (POINTS CLOSED BRUSH DASHING STREAM)               (* hdj "28-Jan-85 22:51")
                                                             (* draws a polygon with a given brush.)
    (IMAGEOP (QUOTE IMDRAWPOLYGON)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM POINTS CLOSED BRUSH DASHING])

(FILLPOLYGON
  [LAMBDA (POINTS TEXTURE STREAM)                            (* FS " 5-Sep-85 22:11")
                                                             (* fills a polygon with a given texture)
    (IMAGEOP (QUOTE IMFILLPOLYGON)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM POINTS TEXTURE])

(DRAWTO
  [LAMBDA (X Y WIDTH OPERATION STREAM COLOR DASHING)         (* hdj " 7-Nov-84 14:03")
                                                             (* draws a line fro the current position of STREAM to 
							     absolute position X,Y.)
    (IMAGEOP (QUOTE IMDRAWLINE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM
	     (IMAGEOP (QUOTE IMXPOSITION)
		      STREAM STREAM)
	     (IMAGEOP (QUOTE IMYPOSITION)
		      STREAM STREAM)
	     X Y WIDTH OPERATION COLOR DASHING])

(FILLCIRCLE
  [LAMBDA (CENTERX CENTERY RADIUS TEXTURE STREAM)            (* rmk: " 2-SEP-83 10:54")
    (IMAGEOP (QUOTE IMFILLCIRCLE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM CENTERX CENTERY RADIUS TEXTURE])

(MOVETO
  [LAMBDA (X Y STREAM)                                       (* rmk: "17-Sep-84 17:59")
                                                             (* sets both the X and Y positions in a Stream)
    (IMAGEOP (QUOTE IMMOVETO)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM X Y])

(RELDRAWTO
  [LAMBDA (DX DY WIDTH OPERATION STREAM COLOR DASHING)       (* hdj " 7-Nov-84 14:04")
                                                             (* Draws a vector from the current position)
    (PROG (ORIGX ORIGY (STRM (\OUTSTREAMARG STREAM)))
          (RETURN (IMAGEOP (QUOTE IMDRAWLINE)
			   STRM STRM (SETQ ORIGX (IMAGEOP (QUOTE IMXPOSITION)
							  STRM STRM))
			   (SETQ ORIGY (IMAGEOP (QUOTE IMYPOSITION)
						STRM STRM))
			   (IPLUS ORIGX DX)
			   (IPLUS ORIGY DY)
			   WIDTH OPERATION COLOR DASHING])

(BITMAPIMAGESIZE
  [LAMBDA (BITMAP DIMENSION STREAM)                          (* hdj "19-Dec-84 11:57")
    (IMAGEOP (QUOTE IMBITMAPSIZE)
	     STREAM STREAM BITMAP DIMENSION])

(SCALEDBITBLT
  [LAMBDA (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT 
		  SOURCETYPE OPERATION TEXTURE CLIPPINGREGION SCALE)
                                                             (* hdj "14-Feb-85 14:35")
    (IMAGEOP (QUOTE IMSCALEDBITBLT)
	     DESTINATION SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION (OR DESTINATIONLEFT 0)
	     (OR DESTINATIONBOTTOM 0)
	     WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION (if CLIPPINGREGION
									  then (fetch (REGION LEFT)
										  of CLIPPINGREGION)
									else 0)
	     (if CLIPPINGREGION
		 then (fetch (REGION LEFT) of CLIPPINGREGION)
	       else 0)
	     SCALE])
)
(DEFINEQ

(\IMAGEIOINIT
  [LAMBDA NIL                                                (* gbn "30-Sep-85 22:42")
    (DECLARE (GLOBALVARS \NOIMAGEOPS))
    (SETQ \NOIMAGEOPS (create IMAGEOPS
				      IMAGETYPE ← NIL
				      IMCLOSEFN ←(FUNCTION NILL)
				      IMXPOSITION ←[FUNCTION (LAMBDA (STREAM POS)
					  (if POS
					      then (TAB POS 0 STREAM)
					    else (POSITION NIL STREAM]
				      IMYPOSITION ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DSPYPOSITION]
				      IMFONT ←[FUNCTION (LAMBDA (STREAM FONT)
					  (DECLARE (GLOBALVARS FONTCHANGEFLG))
					  (AND FONTCHANGEFLG
						   (PROG1 (ffetch IMAGEDATA of STREAM)
							      (COND
								((EQ FONT (fetch IMAGEDATA
										 of STREAM)))
								((type? FONTCLASS FONT)
                                                             (* must be an outchar so that if the file is 
							     run-coded, the font change characters will come out 
							     in charset 0.0)
								  (\OUTCHAR STREAM
										(CONSTANT
										  (CHCON1 
										   FONTESCAPECHAR)))
								  (\BOUT STREAM
									     (fetch (FONTCLASS
											  PRETTYFONT#)
										of FONT))
								  (freplace IMAGEDATA
								     of STREAM with FONT]
				      IMLEFTMARGIN ←(FUNCTION ZERO)
				      IMRIGHTMARGIN ←(FUNCTION LINELENGTH)
				      IMLINEFEED ←(FUNCTION [LAMBDA (DY STREAM)
					  (BOUT (CHARCODE LF)
						    STREAM])
				      IMDRAWLINE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DRAWLINE]
				      IMDRAWPOLYGON ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DRAWPOLYGON]
				      IMFILLPOLYGON ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE FILLPOLYGON]
				      IMDRAWCURVE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DRAWCURVE]
				      IMDRAWCIRCLE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DRAWCIRCLE]
				      IMDRAWELLIPSE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DRAWELLIPSE]
				      IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
				      IMBLTSHADE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
				      IMBITBLT ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE BITBLT]
				      IMSCALEDBITBLT ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE SCALEDBITBLT]
				      IMSPACEFACTOR ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE DSPSPACEFACTOR]
				      IMFONTCREATE ←[FUNCTION (LAMBDA (STREAM)
					  (\UNIMPIMAGEOP STREAM (QUOTE FONTCREATE]
				      IMSTRINGWIDTH ←(FUNCTION [LAMBDA (STREAM STR RDTBL)
					  (NCHARS STR RDTBL RDTBL])
				      IMCHARWIDTH ←(FUNCTION [LAMBDA NIL 1])
				      IMCHARSET ←(FUNCTION (LAMBDA (STREAM CHARSET)

          (* If we had another illegal character set value, then we could simply fix it so that the character set didn't 
	  match anything, which would cause the character set shift to be put out on the next character)


					  (if (\IOMODEP STREAM (QUOTE OUTPUT)
								T)
					      then (\BOUT STREAM NSCHARSETSHIFT)
						       (if (EQ CHARSET T)
							   then (\BOUT STREAM NSCHARSETSHIFT)
								    (\BOUT STREAM 0)
							 else (\BOUT STREAM CHARSET])

(\UNIMPIMAGEOP
  [LAMBDA (STREAM OP)                                        (* rmk: "26-Jun-84 13:28")
    (ERROR STREAM (CONCAT "does not support " OP])
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS IMAGEOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*)
				    (CONS (COND [(EQ (CAR (LISTP (CAR ARGS)))
						     (QUOTE QUOTE))
						 (LIST (QUOTE fetch)
						       (LIST (QUOTE IMAGEOPS)
							     (CADAR ARGS))
						       (QUOTE of)
						       (LIST (QUOTE fetch)
							     (QUOTE (STREAM IMAGEOPS))
							     (QUOTE of)
							     (CADR ARGS]
						(T (HELP "IMAGEOP - OPNAME not quoted:" ARGS)))
					  (CDDR ARGS]
)
[DECLARE: EVAL@COMPILE 

(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN 
				IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE 
				IMFILLCIRCLE IMBLTSHADE IMBITBLT IMNEWPAGE IMMOVETO IMSCALE IMTERPRI 
				IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION 
				IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR 
				IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON 
				IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET)
	  IMCLOSEFN ←(FUNCTION NILL)
	  IMTERPRI ←[FUNCTION (LAMBDA (STREAM)
	      (\OUTCHAR STREAM (CHARCODE EOL]
	  IMNEWPAGE ←[FUNCTION (LAMBDA (STREAM)
	      (\OUTCHAR STREAM (CHARCODE ↑L]
	  IMOPERATION ←(FUNCTION NILL)
	  IMCOLOR ←(FUNCTION NILL)
	  IMCLIPPINGREGION ←(FUNCTION NILL)
	  IMRESET ←(FUNCTION NILL)
	  IMBACKCOLOR ←(FUNCTION NILL)
	  IMSTRINGWIDTH ←(FUNCTION [LAMBDA (STREAM STR RDTBL)
	      (STRINGWIDTH STR (DSPFONT NIL STREAM)
			     RDTBL RDTBL])
	  IMCHARWIDTH ←[FUNCTION (LAMBDA (STREAM CHARCODE)
	      (CHARWIDTH CHARCODE (DSPFONT NIL STREAM]
	  IMMOVETO ←(FUNCTION [LAMBDA (STREAM X Y)
	      (IMAGEOP (QUOTE IMXPOSITION)
		       STREAM STREAM X)
	      (IMAGEOP (QUOTE IMYPOSITION)
		       STREAM STREAM Y])
	  IMBITMAPSIZE ←[FUNCTION (LAMBDA (STREAM BITMAP DIMENSION)
	      (SELECTQ DIMENSION
			 (WIDTH (TIMES (DSPSCALE NIL STREAM)
					 (BITMAPWIDTH BITMAP)))
			 (HEIGHT (TIMES (DSPSCALE NIL STREAM)
					  (BITMAPHEIGHT BITMAP)))
			 [NIL (CONS (TIMES (DSPSCALE NIL STREAM)
					       (BITMAPWIDTH BITMAP))
				      (TIMES (DSPSCALE NIL STREAM)
					       (BITMAPHEIGHT BITMAP]
			 (\ILLEGAL.ARG DIMENSION]
	  IMWRITEPIXEL ←(FUNCTION NILL)
	  IMCHARSET ←(FUNCTION NILL)
	  IMXPOSITION ←(FUNCTION NILL)
	  IMYPOSITION ←(FUNCTION NILL)
	  IMFONT ←(FUNCTION NILL)
	  IMLEFTMARGIN ←(FUNCTION NILL)
	  IMRIGHTMARGIN ←(FUNCTION NILL)
	  IMLINEFEED ←(FUNCTION NILL)
	  IMDRAWLINE ←(FUNCTION NILL)
	  IMDRAWCURVE ←(FUNCTION NILL)
	  IMDRAWCIRCLE ←(FUNCTION NILL)
	  IMDRAWELLIPSE ←(FUNCTION NILL)
	  IMFILLCIRCLE ←(FUNCTION NILL)
	  IMBLTSHADE ←(FUNCTION NILL)
	  IMBITBLT ←(FUNCTION NILL)
	  IMSCALE ←(FUNCTION NILL)
	  IMTOPMARGIN ←(FUNCTION NILL)
	  IMBOTTOMMARGIN ←(FUNCTION NILL)
	  IMSPACEFACTOR ←(FUNCTION NILL)
	  IMFONTCREATE ←(FUNCTION NILL)
	  IMCHARWIDTHY ←(FUNCTION NILL)
	  IMDRAWPOLYGON ←(FUNCTION NILL)
	  IMFILLPOLYGON ←(FUNCTION NILL)
	  IMSCALEDBITBLT ←(FUNCTION NILL))
]
(/DECLAREDATATYPE (QUOTE IMAGEOPS)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER))
		  (QUOTE ((IMAGEOPS 0 POINTER)
			  (IMAGEOPS 2 POINTER)
			  (IMAGEOPS 4 POINTER)
			  (IMAGEOPS 6 POINTER)
			  (IMAGEOPS 8 POINTER)
			  (IMAGEOPS 10 POINTER)
			  (IMAGEOPS 12 POINTER)
			  (IMAGEOPS 14 POINTER)
			  (IMAGEOPS 16 POINTER)
			  (IMAGEOPS 18 POINTER)
			  (IMAGEOPS 20 POINTER)
			  (IMAGEOPS 22 POINTER)
			  (IMAGEOPS 24 POINTER)
			  (IMAGEOPS 26 POINTER)
			  (IMAGEOPS 28 POINTER)
			  (IMAGEOPS 30 POINTER)
			  (IMAGEOPS 32 POINTER)
			  (IMAGEOPS 34 POINTER)
			  (IMAGEOPS 36 POINTER)
			  (IMAGEOPS 38 POINTER)
			  (IMAGEOPS 40 POINTER)
			  (IMAGEOPS 42 POINTER)
			  (IMAGEOPS 44 POINTER)
			  (IMAGEOPS 46 POINTER)
			  (IMAGEOPS 48 POINTER)
			  (IMAGEOPS 50 POINTER)
			  (IMAGEOPS 52 POINTER)
			  (IMAGEOPS 54 POINTER)
			  (IMAGEOPS 56 POINTER)
			  (IMAGEOPS 58 POINTER)
			  (IMAGEOPS 60 POINTER)
			  (IMAGEOPS 62 POINTER)
			  (IMAGEOPS 64 POINTER)
			  (IMAGEOPS 66 POINTER)
			  (IMAGEOPS 68 POINTER)
			  (IMAGEOPS 70 POINTER)
			  (IMAGEOPS 72 POINTER)))
		  (QUOTE 74))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NOIMAGEOPS)
)


(* END EXPORTED DEFINITIONS)

)
(/DECLAREDATATYPE (QUOTE IMAGEOPS)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER))
		  (QUOTE ((IMAGEOPS 0 POINTER)
			  (IMAGEOPS 2 POINTER)
			  (IMAGEOPS 4 POINTER)
			  (IMAGEOPS 6 POINTER)
			  (IMAGEOPS 8 POINTER)
			  (IMAGEOPS 10 POINTER)
			  (IMAGEOPS 12 POINTER)
			  (IMAGEOPS 14 POINTER)
			  (IMAGEOPS 16 POINTER)
			  (IMAGEOPS 18 POINTER)
			  (IMAGEOPS 20 POINTER)
			  (IMAGEOPS 22 POINTER)
			  (IMAGEOPS 24 POINTER)
			  (IMAGEOPS 26 POINTER)
			  (IMAGEOPS 28 POINTER)
			  (IMAGEOPS 30 POINTER)
			  (IMAGEOPS 32 POINTER)
			  (IMAGEOPS 34 POINTER)
			  (IMAGEOPS 36 POINTER)
			  (IMAGEOPS 38 POINTER)
			  (IMAGEOPS 40 POINTER)
			  (IMAGEOPS 42 POINTER)
			  (IMAGEOPS 44 POINTER)
			  (IMAGEOPS 46 POINTER)
			  (IMAGEOPS 48 POINTER)
			  (IMAGEOPS 50 POINTER)
			  (IMAGEOPS 52 POINTER)
			  (IMAGEOPS 54 POINTER)
			  (IMAGEOPS 56 POINTER)
			  (IMAGEOPS 58 POINTER)
			  (IMAGEOPS 60 POINTER)
			  (IMAGEOPS 62 POINTER)
			  (IMAGEOPS 64 POINTER)
			  (IMAGEOPS 66 POINTER)
			  (IMAGEOPS 68 POINTER)
			  (IMAGEOPS 70 POINTER)
			  (IMAGEOPS 72 POINTER)))
		  (QUOTE 74))
[ADDTOVAR SYSTEMRECLST

(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN 
				IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE 
				IMFILLCIRCLE IMBLTSHADE IMBITBLT IMNEWPAGE IMMOVETO IMSCALE IMTERPRI 
				IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION 
				IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR 
				IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON 
				IMSCALEDBITBLT IMWRITEPIXEL IMCHARSET))
]
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\IMAGEIOINIT)
)



(* Implementation of display stream resident "files." Done here cause it might matter that the
 display device get defined early so that its event fn will be evaluated as the last thing 
before logout)

(DEFINEQ

(\DisplayEventFn
  [LAMBDA (FDEV EVENT)                                       (* bvm: "25-MAY-83 12:32")
    (SELECTQ EVENT
	     (BEFORELOGOUT (DISPLAYBEFOREEXIT (QUOTE LOGOUT)))
	     (AFTERLOGOUT (DISPLAYAFTERENTRY (QUOTE LOGOUT)))
	     (BEFOREMAKESYS (DISPLAYBEFOREEXIT (QUOTE MAKESYS)))
	     (AFTERMAKESYS (DISPLAYAFTERENTRY (QUOTE MAKESYS)))
	     ((BEFORESYSOUT BEFORESAVEVM)
	       (DISPLAYBEFOREEXIT (QUOTE SYSOUT)))
	     ((AFTERSYSOUT AFTERSAVEVM)
	       (DISPLAYAFTERENTRY (QUOTE SYSOUT)))
	     NIL])

(\DISPLAYINIT
  [LAMBDA NIL                                                (* FS " 5-Sep-85 21:39")
                                                             (* Initializes global variables for the Display device)

          (* Display Streams are referred to only by themselves so they do not need directory operations.
	  Most of the fields in the DisplayDevice are empty to avoid something bad happening.)


    (DECLARE (GLOBALVARS DisplayFDEV \DISPLAYIMAGEOPS \DisplayDeviceMethods \DisplayDeviceData))
    (SETQ \DisplayDeviceMethods (create WSOPS
					WSCHANGEBACKGROUND ←(FUNCTION \CHANGEBACKGROUND.DISPLAY)
					WSCHANGEBACKGROUNDBORDER ←(FUNCTION 
					  \CHANGEBACKGROUNDBORDER.DISPLAY)))
    (SETQ \DisplayDeviceData
      (create WSDATA
	      WSDESTINATION ← "Destination"
	      WSREGION ←(create REGION
				LEFT ← 0
				BOTTOM ← 0
				WIDTH ← 1024
				HEIGHT ← 808)
	      WSBACKGROUND ← NIL))
    (SETQ \DISPLAYIMAGEOPS (create IMAGEOPS
				   IMAGETYPE ←(QUOTE DISPLAY)
				   IMFONT ←(FUNCTION \DSPFONT.DISPLAY)
				   IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.DISPLAY)
				   IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.DISPLAY)
				   IMLINEFEED ←(FUNCTION \DSPLINEFEED.DISPLAY)
				   IMXPOSITION ←(FUNCTION \DSPXPOSITION.DISPLAY)
				   IMYPOSITION ←(FUNCTION \DSPYPOSITION.DISPLAY)
				   IMCLOSEFN ←(FUNCTION NILL)
				   IMDRAWCURVE ←(FUNCTION \DRAWCURVE.DISPLAY)
				   IMFILLCIRCLE ←(QUOTE \FILLCIRCLE.DISPLAY)
				   IMDRAWLINE ←(FUNCTION \DRAWLINE.DISPLAY)
				   IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.DISPLAY)
				   IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.DISPLAY)
				   IMFILLPOLYGON ←(FUNCTION POLYSHADE.DISPLAY)
				   IMBITBLT ←(FUNCTION \BITBLT.1BITDISPLAY)
				   IMBLTSHADE ←(FUNCTION \BLTSHADE.1BITDISPLAY)
				   IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
				   IMSCALE ←(FUNCTION [LAMBDA NIL 1])
				   IMSPACEFACTOR ←(FUNCTION NILL)
				   IMFONTCREATE ←(QUOTE DISPLAY)
				   IMCOLOR ←(FUNCTION NILL)
				   IMBACKCOLOR ←(FUNCTION NILL)
				   IMOPERATION ←(FUNCTION \DSPOPERATION.DISPLAY)
				   IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.DISPLAY)
				   IMCHARWIDTH ←(FUNCTION \CHARWIDTH.DISPLAY)
				   IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.DISPLAY)
				   IMRESET ←(FUNCTION \DSPRESET.DISPLAY)))
    (SETQ DisplayFDEV (create FDEV
			      DEVICENAME ←(QUOTE DISPLAY)
			      RESETABLE ← NIL
			      RANDOMACCESSP ← NIL
			      PAGEMAPPED ← NIL
			      CLOSEFILE ←(FUNCTION NILL)
			      DELETEFILE ←(FUNCTION NILL)
			      GETFILEINFO ←(FUNCTION NILL)
			      OPENFILE ←(FUNCTION [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
				  NAME])
			      READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
			      SETFILEINFO ←(FUNCTION NILL)
			      GENERATEFILES ←(FUNCTION \GENERATENOFILES)
			      TRUNCATEFILE ←(FUNCTION NILL)
			      WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
			      GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG FDEV)
				  NAME])
			      REOPENFILE ←(FUNCTION [LAMBDA (NAME)
				  NAME])
			      EVENTFN ←(FUNCTION \DisplayEventFn)
			      DIRECTORYNAMEP ←(FUNCTION NILL)
			      HOSTNAMEP ←(FUNCTION NILL)
			      BIN ←(FUNCTION \ILLEGAL.DEVICEOP)
			      BOUT ←(FUNCTION \DSPPRINTCHAR)
			      PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
			      BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
			      BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
			      BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
			      WINDOWOPS ← \DisplayDeviceMethods
			      WINDOWDATA ← \DisplayDeviceData
			      DEVICEINFO ←(create DISPLAYSTATE)))
    (\DEFINEDEVICE (QUOTE LFDISPLAY)
		   DisplayFDEV])

(\COLORDISPLAYINIT
  [LAMBDA NIL                                                (* hdj " 6-Mar-85 17:34")
    (DECLARE (GLOBALVARS \COLORDISPLAYIMAGEOPS ColorDisplayFDEV))
    (SETQ \COLORDISPLAYIMAGEOPS (create IMAGEOPS
					IMAGETYPE ←(QUOTE (COLOR DISPLAY))
					IMFONT ←(FUNCTION \DSPFONT.COLORDISPLAY)
					IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.DISPLAY)
					IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.DISPLAY)
					IMLINEFEED ←(FUNCTION \DSPLINEFEED.DISPLAY)
					IMXPOSITION ←(FUNCTION \DSPXPOSITION.DISPLAY)
					IMYPOSITION ←(FUNCTION \DSPYPOSITION.DISPLAY)
					IMCLOSEFN ←(FUNCTION NILL)
					IMDRAWCURVE ←(FUNCTION \DRAWCURVE.DISPLAY)
					IMFILLCIRCLE ←(QUOTE \FILLCIRCLE.DISPLAY)
					IMDRAWLINE ←(FUNCTION \DRAWLINE.DISPLAY)
					IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.DISPLAY)
					IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.DISPLAY)
					IMBITBLT ←(FUNCTION \BITBLT.COLORDISPLAY)
					IMBLTSHADE ←(FUNCTION \BLTSHADE.COLORDISPLAY)
					IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
					IMSCALE ←(FUNCTION [LAMBDA NIL 1])
					IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
					IMFONTCREATE ←(QUOTE DISPLAY)
					IMCOLOR ←(FUNCTION \DSPCOLOR.DISPLAY)
					IMBACKCOLOR ←(FUNCTION \DSPBACKCOLOR.DISPLAY)
					IMOPERATION ←(FUNCTION \DSPOPERATION.DISPLAY)
					IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.DISPLAY)
					IMCHARWIDTH ←(FUNCTION \CHARWIDTH.DISPLAY)
					IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.DISPLAY)
					IMRESET ←(FUNCTION \DSPRESET.DISPLAY)))
    (SETQ ColorDisplayFDEV (create FDEV
				   DEVICENAME ←(QUOTE (COLOR DISPLAY))
				   RESETABLE ← NIL
				   RANDOMACCESSP ← NIL
				   PAGEMAPPED ← NIL
				   CLOSEFILE ←(FUNCTION NILL)
				   DELETEFILE ←(FUNCTION NILL)
				   GETFILEINFO ←(FUNCTION NILL)
				   OPENFILE ←(FUNCTION [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
				       NAME])
				   READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
				   SETFILEINFO ←(FUNCTION NILL)
				   GENERATEFILES ←(FUNCTION \GENERATENOFILES)
				   TRUNCATEFILE ←(FUNCTION NILL)
				   WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
				   GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG FDEV)
				       NAME])
				   REOPENFILE ←(FUNCTION [LAMBDA (NAME)
				       NAME])
				   EVENTFN ←(FUNCTION NILL)
				   DIRECTORYNAMEP ←(FUNCTION NILL)
				   HOSTNAMEP ←(FUNCTION NILL)
				   BIN ←(FUNCTION \ILLEGAL.DEVICEOP)
				   BOUT ←(FUNCTION \DSPPRINTCHAR)
				   PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
				   BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
				   BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
				   BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
				   DEVICEINFO ←(create DISPLAYSTATE)
				   WINDOWOPS ← NIL))
    (\DEFINEDEVICE NIL ColorDisplayFDEV])
)

(ADDTOVAR IMAGESTREAMTYPES (DISPLAY [OPENSTREAM (LAMBDA (FILE)
							  (GETSTREAM (CREATEW NIL
									      (COND
										((EQ FILE
										     (QUOTE {LPT}))
										 
									   "Display image stream")
										(T FILE]
				      (FONTCREATE \CREATEDISPLAYFONT)
				      (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DisplayFDEV ColorDisplayFDEV)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\DISPLAYINIT)
(\COLORDISPLAYINIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA IMAGESTREAMP)
)
(PUTPROPS IMAGEIO COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1688 8390 (IMAGESTREAMP 1698 . 2383) (IMAGESTREAMTYPE 2385 . 2597) (IMAGESTREAMTYPEP 
2599 . 3101) (OPENIMAGESTREAM 3103 . 6907) (\GOOD.DASHLST 6909 . 8388)) (8425 10137 (DRAWDASHEDLINE 
8435 . 10135)) (10138 15519 (DSPBACKCOLOR 10148 . 10467) (DSPBOTTOMMARGIN 10469 . 10805) (DSPCOLOR 
10807 . 11118) (DSPCLIPPINGREGION 11120 . 11754) (DSPRESET 11756 . 12048) (DSPFONT 12050 . 12400) (
DSPLEFTMARGIN 12402 . 12763) (DSPLINEFEED 12765 . 13076) (DSPOPERATION 13078 . 13402) (DSPRIGHTMARGIN 
13404 . 13782) (DSPTOPMARGIN 13784 . 14116) (DSPSCALE 14118 . 14473) (DSPSPACEFACTOR 14475 . 14881) (
DSPXPOSITION 14883 . 15199) (DSPYPOSITION 15201 . 15517)) (15520 21373 (DSPNEWPAGE 15530 . 15847) (
DRAWBETWEEN 15849 . 16334) (DRAWCIRCLE 16336 . 16770) (DRAWCURVE 16772 . 17114) (DRAWELLIPSE 17116 . 
17797) (DRAWLINE 17799 . 18104) (DRAWPOLYGON 18106 . 18447) (FILLPOLYGON 18449 . 18777) (DRAWTO 18779
 . 19303) (FILLCIRCLE 19305 . 19543) (MOVETO 19545 . 19861) (RELDRAWTO 19863 . 20441) (BITMAPIMAGESIZE
 20443 . 20631) (SCALEDBITBLT 20633 . 21371)) (21374 25214 (\IMAGEIOINIT 21384 . 25041) (\UNIMPIMAGEOP
 25043 . 25212)) (32074 39336 (\DisplayEventFn 32084 . 32661) (\DISPLAYINIT 32663 . 36463) (
\COLORDISPLAYINIT 36465 . 39334)))))
STOP