(FILECREATED "19-Jul-85 11:59:00" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;77 39430  

      changes to:  (FNS IMAGESTREAMP)

      previous date: "17-Jul-85 11:51:02" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;76)


(* 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)                                    (* hdj "11-Jul-85 12:47")

          (* * 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 (if (BITMAPP BRUSH)
							then (IQUOTIENT (IPLUS 2 (BITMAPHEIGHT BRUSH)
									       (BITMAPWIDTH BRUSH))
									2)
						      else (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)                                    (* jds "11-Jan-85 16:53")
                                                             (* Set the clipping region for an imagestream)
    (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)                            (* hdj "28-Jan-85 22:53")
                                                             (* fills a polygon with a given texture)
    (IMAGEOP (QUOTE IMDRAWPOLYGON)
	     (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                                                (* rmk: "12-Apr-85 09:28")
    (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)
								(\BOUT 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                                                (* hdj " 5-Jul-85 11:33")
                                                             (* 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)
				   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 (1680 8365 (IMAGESTREAMP 1690 . 2375) (IMAGESTREAMTYPE 2377 . 2589) (IMAGESTREAMTYPEP 
2591 . 3073) (OPENIMAGESTREAM 3075 . 6879) (\GOOD.DASHLST 6881 . 8363)) (8400 10112 (DRAWDASHEDLINE 
8410 . 10110)) (10113 15313 (DSPBACKCOLOR 10123 . 10434) (DSPBOTTOMMARGIN 10436 . 10764) (DSPCOLOR 
10766 . 11069) (DSPCLIPPINGREGION 11071 . 11619) (DSPRESET 11621 . 11913) (DSPFONT 11915 . 12257) (
DSPLEFTMARGIN 12259 . 12613) (DSPLINEFEED 12615 . 12918) (DSPOPERATION 12920 . 13236) (DSPRIGHTMARGIN 
13238 . 13608) (DSPTOPMARGIN 13610 . 13934) (DSPSCALE 13936 . 14283) (DSPSPACEFACTOR 14285 . 14691) (
DSPXPOSITION 14693 . 15001) (DSPYPOSITION 15003 . 15311)) (15314 21116 (DSPNEWPAGE 15324 . 15641) (
DRAWBETWEEN 15643 . 16128) (DRAWCIRCLE 16130 . 16540) (DRAWCURVE 16542 . 16876) (DRAWELLIPSE 16878 . 
17547) (DRAWLINE 17549 . 17854) (DRAWPOLYGON 17856 . 18197) (FILLPOLYGON 18199 . 18528) (DRAWTO 18530
 . 19054) (FILLCIRCLE 19056 . 19286) (MOVETO 19288 . 19604) (RELDRAWTO 19606 . 20184) (BITMAPIMAGESIZE
 20186 . 20374) (SCALEDBITBLT 20376 . 21114)) (21117 24653 (\IMAGEIOINIT 21127 . 24488) (\UNIMPIMAGEOP
 24490 . 24651)) (31581 38737 (\DisplayEventFn 31591 . 32116) (\DISPLAYINIT 32118 . 35864) (
\COLORDISPLAYINIT 35866 . 38735)))))
STOP