(FILECREATED " 4-Sep-86 17:21:44" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;121 74256  

      changes to:  (FNS OPENIMAGESTREAM)

      previous date: " 1-Jul-86 18:00:25" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;120)


(* Copyright (c) 1983, 1984, 1985, 1986 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 DSPROTATE DSPPUSHSTATE DSPPOPSTATE DSPDEFAULTSTATE DSPSCALE2 
             DSPTRANSLATE)
        (FNS DSPNEWPAGE DRAWBETWEEN DRAWCIRCLE DRAWARC DRAWCURVE DRAWELLIPSE DRAWLINE DRAWPOLYGON 
             FILLPOLYGON DRAWTO FILLCIRCLE MOVETO RELDRAWTO BITMAPIMAGESIZE SCALEDBITBLT)
        (FNS \IMAGEIOINIT \NOIMAGE.DSPFONT \UNIMPIMAGEOP)
        (COMS (* stuff to support the checking and defaulting of arguments in the device independent 
                 drawing functions.)
              (FNS INSURE.BRUSH BRUSHP \POSSIBLECOLOR)
              (DECLARE: DONTCOPY EVAL@COMPILE (RESOURCES SYSTEMBRUSH))
              (INITRESOURCES SYSTEMBRUSH)
              (FNS DASHINGP INSURE.DASHING)
              (DECLARE: DONTCOPY (EXPORT (RECORDS BRUSH)))
              (DECLARE: DONTCOPY (CONSTANTS (MICASPERPT (FQUOTIENT 635 18)))))
        (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)
              (INITVARS (\COLORDISPLAYSTREAMTYPES (QUOTE (4DISPLAY 8DISPLAY 24DISPLAY)))
                     (\DISPLAYSTREAMTYPES (CONS (QUOTE DISPLAY)
                                                \COLORDISPLAYSTREAMTYPES)))
              (FNS \DisplayEventFn \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT 
                   \DISPLAYSTREAMTYPEBPP)
              (ALISTS (IMAGESTREAMTYPES DISPLAY 4DISPLAY 8DISPLAY 24DISPLAY))
              (GLOBALVARS DisplayFDEV \4DISPLAYFDEV \8DISPLAYFDEV \24DISPLAYFDEV)
              (DECLARE: DONTEVAL@LOAD DOCOPY (P (\DISPLAYINIT)
                                                (\4DISPLAYINIT)
                                                (\8DISPLAYINIT)
                                                (\24DISPLAYINIT))))
        (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                            (NLAML)
                                                                            (LAMA IMAGESTREAMP)))))
(DEFINEQ

(IMAGESTREAMP
  (LAMBDA NARGS                                              (* lmm " 7-Jan-86 16:27")
    (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 " 4-Sep-86 11:49")
                                                  (* ;; "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)))
          (SETQ FILE (\CONVERT-PATHNAME FILE))
          (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 '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 
                                                                           "13-Feb-86 17:40")
            
            (* * massage the DASHING parameter to mesh well with the size of the 
            BRUSH)

    (PROG [(DASHLST (INSURE.DASHING DASHING))
           (BRUSHSIZE (COND
                         ((LITATOM BRUSH)                                  (* handles NULL and 
                                                                           function name case.)
                          1)
                         ((BITMAPP BRUSH)
                          (IQUOTIENT (IPLUS 2 (BITMAPHEIGHT BRUSH)
                                            (BITMAPWIDTH BRUSH))
                                 2))
                         (T (fetch (BRUSH BRUSHSIZE) of BRUSH]
          [COND
             ((AND DASHLST (GREATERP BRUSHSIZE 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)))

(DSPROTATE
  (LAMBDA (ROTATION STREAM)                                  (* hdj "22-Oct-85 12:15")
                                                             (* Sets the rotation of STREAM)
    (IMAGEOP (QUOTE IMROTATE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM ROTATION)))

(DSPPUSHSTATE
  (LAMBDA (STREAM)                                           (* hdj "25-Nov-85 11:49")

          (* * push a new graphics context for STREAM)


    (IMAGEOP (QUOTE IMPUSHSTATE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM)))

(DSPPOPSTATE
  (LAMBDA (STREAM)                                           (* hdj "25-Nov-85 11:50")

          (* * pop a the graphics context for STREAM)


    (IMAGEOP (QUOTE IMPOPSTATE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM)))

(DSPDEFAULTSTATE
  (LAMBDA (STREAM)                                           (* hdj "30-Dec-85 17:39")

          (* * push a new graphics context for STREAM)


    (IMAGEOP (QUOTE IMDEFAULTSTATE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM)))

(DSPSCALE2
  (LAMBDA (Sx Sy STREAM)                                     (* hdj " 2-Jan-86 18:38")
                                                             (* Sets the scaling of STREAM)
    (IMAGEOP (QUOTE IMSCALE2)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM Sx Sy)))

(DSPTRANSLATE
  (LAMBDA (Tx Ty STREAM)                                     (* hdj " 2-Jan-86 18:37")
                                                             (* Sets the translation of STREAM)
    (IMAGEOP (QUOTE IMTRANSLATE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM Tx Ty)))
)
(DEFINEQ

(DSPNEWPAGE
  [LAMBDA (STREAM)                                                     (* jds 
                                                                           " 9-Feb-86 17:18")
            
            (* * Start a new page on the image stream STREAM.)

    (AND (STREAMPROP (SETQ STREAM (\OUTSTREAMARG STREAM))
                (QUOTE BEFORENEWPAGEFN))
         (APPLY* (STREAMPROP STREAM (QUOTE BEFORENEWPAGEFN))
                STREAM))                                                   (* Let the stream's 
                                                                           creator get control 
                                                                           before and after the 
                                                                           page break, if he wants 
                                                                           it.)
    (IMAGEOP (QUOTE IMNEWPAGE)
           (SETQ STREAM (\OUTSTREAMARG STREAM))
           STREAM)
    (AND (STREAMPROP STREAM (QUOTE AFTERNEWPAGEFN))
         (APPLY* (STREAMPROP STREAM (QUOTE AFTERNEWPAGEFN))
                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)      (* rrb "30-Oct-85 14:22")
                                                             (* Generic DRAWCIRCLE)
    (COND
      ((LESSP RADIUS 0)
	(\ILLEGAL.ARG RADIUS))
      ((EQP RADIUS 0)
	NIL)
      (T (IMAGEOP (QUOTE IMDRAWCIRCLE)
		  (SETQ STREAM (\OUTSTREAMARG STREAM))
		  STREAM CENTERX CENTERY RADIUS (INSURE.BRUSH BRUSH STREAM)
		  (INSURE.DASHING DASHING))))))

(DRAWARC
  (LAMBDA (CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING STREAM)
                                                             (* rrb "31-Oct-85 09:18")
                                                             (* Draws an arc of a given brush and dashing.
							     NDEGREES can be either positive 
							     (counterclockwise) or negative 
							     (clockwise).)
    (IMAGEOP (QUOTE IMDRAWARC)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES (INSURE.BRUSH BRUSH STREAM)
	     (INSURE.DASHING DASHING))))

(DRAWCURVE
  [LAMBDA (KNOTS CLOSED BRUSH DASHING STREAM)                      (* edited: 
                                                                       "31-Mar-86 20:07")
                                                                       (* draws a spline curve 
                                                                       with a given brush.)
    (LET ((VALIDBRUSH BRUSH))
         (if (NOT (BRUSHP BRUSH))
             then (SETQ VALIDBRUSH (INSURE.BRUSH BRUSH STREAM)))
         (IMAGEOP (QUOTE IMDRAWCURVE)
                (SETQ STREAM (\OUTSTREAMARG STREAM))
                STREAM KNOTS CLOSED VALIDBRUSH (INSURE.DASHING DASHING))
         (if (NEQ VALIDBRUSH BRUSH)
             then (FREERESOURCE SYSTEMBRUSH VALIDBRUSH])

(DRAWELLIPSE
  (LAMBDA (CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING STREAM)
                                                             (* rrb "30-Oct-85 14:26")

          (* 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 (INSURE.BRUSH
	       BRUSH STREAM)
	     (INSURE.DASHING 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)               (* rrb "30-Oct-85 14:26")
                                                             (* draws a polygon with a given brush.)
    (IMAGEOP (QUOTE IMDRAWPOLYGON)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM POINTS CLOSED (INSURE.BRUSH BRUSH STREAM)
	     (INSURE.DASHING DASHING))))

(FILLPOLYGON
  [LAMBDA (POINTS TEXTURE STREAM OPERATION WINDNUMBER)                 (* rrb 
                                                                           " 5-Mar-86 15:39")
                                                                           (* fills a polygon 
                                                                           with a given texture)
    (COND
       ((NOT (OR (EQUAL WINDNUMBER 0)
                 (EQUAL WINDNUMBER 1)))
        (SETQ WINDNUMBER 1)))
    (IMAGEOP (QUOTE IMFILLPOLYGON)
           (SETQ STREAM (\OUTSTREAMARG STREAM))
           STREAM POINTS TEXTURE (OR OPERATION (DSPOPERATION NIL STREAM))
           WINDNUMBER])

(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)                 (* rrb 
                                                                           "21-Feb-86 09:23")
                                                                           (* Draws a vector 
                                                                           from the current 
                                                                           position)
    (PROG (ORIGX ORIGY (STRM (\OUTSTREAMARG STREAM)))
          (RETURN (COND
                     ((NOT (AND (ZEROP DX)
                                (ZEROP DX)))                               (* documented to not 
                                                                           draw anything if DX and 
                                                                           DY are both 0)
                      (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                                                              (* lmm 
                                                                           " 4-Mar-86 14:50")
    (DECLARE (GLOBALVARS \NOIMAGEOPS))
    (SETQ \NOIMAGEOPS (create IMAGEOPS
                             IMAGETYPE ← NIL
                             IMCLOSEFN ←(FUNCTION NILL)
                             IMXPOSITION ←(FUNCTION (LAMBDA (STREAM POS)
                                                      (LET ((OPOS (POSITION STREAM)))
                                                           (PROG1 OPOS
                                                                  (if POS
                                                                      then (SPACES (DIFFERENCE POS 
                                                                                          OPOS)
                                                                                  STREAM))))))
                             IMYPOSITION ←(FUNCTION (LAMBDA (STREAM N)
                                                      (PROG1 (AND \#DISPLAYLINES (NEQ 
                                                                                  \CURRENTDISPLAYLINE 
                                                                                      -1)
                                                                  (DIFFERENCE \#DISPLAYLINES 
                                                                         \CURRENTDISPLAYLINE))
                                                             (if N
                                                                 then (\UNIMPIMAGEOP STREAM
                                                                             (QUOTE DSPYPOSITION)))))
                                           )
                             IMFONT ←(FUNCTION \NOIMAGE.DSPFONT)
                             IMLEFTMARGIN ←(FUNCTION ZERO)
                             IMRIGHTMARGIN ←(FUNCTION (LAMBDA (STREAM N)
                                                        (LINELENGTH N STREAM)))
                             IMLINEFEED ←(FUNCTION (LAMBDA (STREAM DY)
                                                     (PROG1 -1 (AND DY (IF (NEQ DY -1)
                                                                           THEN (ERROR DY 
                                                                   "Illegal DSPLINEFEED for terminal"
                                                                                       ))))))
                             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)))))))))

(\NOIMAGE.DSPFONT
  (LAMBDA (STREAM FONT)                                                    (* lmm 
                                                                           " 4-Mar-86 14:50")
    (LET ((OLDFONT (ffetch IMAGEDATA of STREAM)))
         (PROG1 OLDFONT (AND (NEQ OLDFONT 0)
                             (LET ((FONTN (OR (SMALLP FONT)
                                              (AND (type? FONTCLASS FONT)
                                                   (fetch (FONTCLASS PRETTYFONT#) of FONT)))))
                                  (COND
                                     ((AND FONTN (NEQ FONTN OLDFONT))      (* must be an outchar 
                                                                           so that if the file is 
                                                                           run-coded, the font 
                                                                           change characters will 
                                                                           come out in charset 0.0)
                                      (COND
                                         ((NEQ FONTN 0)
                                          (BOUT STREAM (CONSTANT (CHCON1 FONTESCAPECHAR)))
                                          (BOUT STREAM FONTN)))
                                      (freplace IMAGEDATA of STREAM with FONTN)))))))))

(\UNIMPIMAGEOP
  (LAMBDA (STREAM OP)                                        (* rmk: "26-Jun-84 13:28")
    (ERROR STREAM (CONCAT "does not support " OP))))
)



(* stuff to support the checking and defaulting of arguments in the device independent drawing 
functions.)

(DEFINEQ

(INSURE.BRUSH
  [LAMBDA (BRUSH STREAM NOERRORFLG)                                (* edited: 
                                                                       "31-Mar-86 20:07")
                                                                       (* returns a full brush 
                                                                       if BRUSH is interpretable 
                                                                       as a brush)
    (COND
       ((BRUSHP BRUSH))
       ((NUMBERP BRUSH)
        (LET ((SYSTEMBRUSH (NEWRESOURCE SYSTEMBRUSH)))
             (replace (BRUSH BRUSHSHAPE) of SYSTEMBRUSH with (QUOTE ROUND))
             (replace (BRUSH BRUSHSIZE) of SYSTEMBRUSH with BRUSH)
             (replace (BRUSH BRUSHCOLOR) of SYSTEMBRUSH with (DSPCOLOR NIL STREAM))
         SYSTEMBRUSH))
       ((NULL BRUSH)                                                   (* Defaults to ROUND, 1 
                                                                       screen point and the 
                                                                       current stream color)
        (LET ((SYSTEMBRUSH (NEWRESOURCE SYSTEMBRUSH)))
             (replace (BRUSH BRUSHSHAPE) of SYSTEMBRUSH with (QUOTE ROUND))
             (replace (BRUSH BRUSHCOLOR) of SYSTEMBRUSH with (DSPCOLOR NIL STREAM))
             (replace (BRUSH BRUSHSIZE) of SYSTEMBRUSH with (DSPSCALE NIL STREAM))
                                                                       (* the default brush 
                                                                       should be 1 screen point 
                                                                       wide.)
         SYSTEMBRUSH))
       (NOERRORFLG NIL)
       (T (\ILLEGAL.ARG BRUSH])

(BRUSHP
  (LAMBDA (BRUSH?)                                                     (* rrb 
                                                                           "13-Feb-86 17:37")
                                                                           (* checks if BRUSH? 
                                                                           is a legal brush)
    (DECLARE (GLOBALVARS KNOWN.BRUSHES))
    (COND
       ((LITATOM BRUSH?)                                                   (* the name of a 
                                                                           function to be applied 
                                                                           at each point.)
        (AND (\DEFINEDP BRUSH?)
             BRUSH?))
       ((AND (MEMB (CAR (LISTP BRUSH?))
                   KNOWN.BRUSHES)
             (NUMBERP (CAR (LISTP (CDR BRUSH?))))
             (OR (NULL (CDDR BRUSH?))
                 (AND (OR (\POSSIBLECOLOR (CAR (LISTP (CDDR BRUSH?))))
                          (NULL (CAR (LISTP (CDDR BRUSH?)))))
                      (NULL (CDDDR BRUSH?)))))
        BRUSH?))))

(\POSSIBLECOLOR
  (LAMBDA (COLOR?)                                                    (* kbr: 
                                                                          "15-Feb-86 22:20")
                                                                          (* could COLOR? be a 
                                                                          color indicator.
                                                                          True if it is a number 
                                                                          in the right range or a 
                                                                          LITATOM that could be a 
                                                                          name.)
    (SELECTQ (TYPENAME COLOR?)
        (LITATOM COLOR?)
        ((SMALLP FIXP) 
             (AND (IGEQ COLOR? 0)
                  (ILEQ COLOR? (MASK.1'S 0 24))
                  COLOR?))
        (LISTP (OR (RGBP COLOR?)
                   (HLSP COLOR?)))
        NIL)))
)
(DECLARE: DONTCOPY EVAL@COMPILE 
(DECLARE: EVAL@COMPILE 
(PUTDEF (QUOTE SYSTEMBRUSH)
       (QUOTE RESOURCES)
       (QUOTE (NEW (CREATE BRUSH)
                   FREE
                   (PUSH \SYSTEMBRUSHES (PROG1 . ARGS))
                   GET
                   (OR (POP \SYSTEMBRUSHES)
                       (NEWRESOURCE SYSTEMBRUSH))
                   INIT
                   (SETQ \SYSTEMBRUSHES NIL))))
)
)
(SETQ \SYSTEMBRUSHES NIL)
(DEFINEQ

(DASHINGP
  (LAMBDA (DASHING)                                          (* rrb "30-Oct-85 11:33")
                                                             (* return DASHING if it is a legal DASHING Note that 
							     NIL is a legal dashing and this will return NIL.)
    (AND (LISTP DASHING)
	   (for X in DASHING always (NUMBERP X))
	   DASHING)))

(INSURE.DASHING
  (LAMBDA (DASHING NOERRORFLG)                               (* rrb "30-Oct-85 11:35")
                                                             (* checks to make sure DASHING is a legal dashing 
							     spec.)
    (COND
      (DASHING (COND
		 ((DASHINGP DASHING))
		 (NOERRORFLG NIL)
		 (T (\ILLEGAL.ARG DASHING)))))))
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR)
              BRUSHSHAPE ← (QUOTE ROUND)
              BRUSHSIZE ← 1)
]


(* END EXPORTED DEFINITIONS)

)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQ MICASPERPT (FQUOTIENT 635 18))

(CONSTANTS (MICASPERPT (FQUOTIENT 635 18)))
)
)
(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 IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE 
                 IMPOPSTATE IMDEFAULTSTATE)
          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)
          IMROTATE ← (FUNCTION NILL)
          IMDRAWARC ← (FUNCTION NILL)
          IMTRANSLATE ← (FUNCTION NILL)
          IMPUSHSTATE ← (FUNCTION NILL)
          IMPOPSTATE ← (FUNCTION NILL)
          IMSCALE2 ← (FUNCTION NILL)
          IMDEFAULTSTATE ← (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 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)
               (IMAGEOPS 74 POINTER)
               (IMAGEOPS 76 POINTER)
               (IMAGEOPS 78 POINTER)
               (IMAGEOPS 80 POINTER)
               (IMAGEOPS 82 POINTER)
               (IMAGEOPS 84 POINTER)
               (IMAGEOPS 86 POINTER)))
       (QUOTE 88))
(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 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)
               (IMAGEOPS 74 POINTER)
               (IMAGEOPS 76 POINTER)
               (IMAGEOPS 78 POINTER)
               (IMAGEOPS 80 POINTER)
               (IMAGEOPS 82 POINTER)
               (IMAGEOPS 84 POINTER)
               (IMAGEOPS 86 POINTER)))
       (QUOTE 88))
[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 IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE 
                 IMPOPSTATE IMDEFAULTSTATE))
]
(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)


(RPAQ? \COLORDISPLAYSTREAMTYPES (QUOTE (4DISPLAY 8DISPLAY 24DISPLAY)))

(RPAQ? \DISPLAYSTREAMTYPES (CONS (QUOTE DISPLAY)
                                 \COLORDISPLAYSTREAMTYPES))
(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                                                         (* kbr: 
                                                                          "20-Feb-86 17:13")
                                                                          (* 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))
    (SETQ \DisplayDeviceData
     (create WSDATA
            WSDESTINATION ←"Destination"
            WSREGION ←(create REGION
                             LEFT ← 0
                             BOTTOM ← 0
                             WIDTH ← 1024
                             HEIGHT ← 808)))
    (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.DISPLAY)
                                  IMBLTSHADE ←(FUNCTION \BLTSHADE.DISPLAY)
                                  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)
                                  IMDRAWARC ←(FUNCTION \DRAWARC.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)))

(\4DISPLAYINIT
  (LAMBDA NIL                                                         (* kbr: 
                                                                          "20-Feb-86 19:08")
    (DECLARE (GLOBALVARS \4DISPLAYIMAGEOPS \4DISPLAYFDEV))
    (SETQ \4DISPLAYIMAGEOPS (create IMAGEOPS
                                   IMAGETYPE ←(QUOTE 4DISPLAY)
                                   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.DISPLAY)
                                   IMBLTSHADE ←(FUNCTION \BLTSHADE.DISPLAY)
                                   IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
                                   IMSCALE ←(FUNCTION (LAMBDA NIL 1))
                                   IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
                                   IMFONTCREATE ←(QUOTE 4DISPLAY)
                                   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)
                                   IMDRAWARC ←(FUNCTION \DRAWARC.DISPLAY)))
    (SETQ \4DISPLAYFDEV (create FDEV
                               DEVICENAME ←(QUOTE 4DISPLAY)
                               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 \4DISPLAYFDEV)))

(\8DISPLAYINIT
  (LAMBDA NIL                                                         (* kbr: 
                                                                          "20-Feb-86 19:08")
    (DECLARE (GLOBALVARS \8DISPLAYIMAGEOPS \8DISPLAYFDEV))
    (SETQ \8DISPLAYIMAGEOPS (create IMAGEOPS
                                   IMAGETYPE ←(QUOTE 8DISPLAY)
                                   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.DISPLAY)
                                   IMBLTSHADE ←(FUNCTION \BLTSHADE.DISPLAY)
                                   IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
                                   IMSCALE ←(FUNCTION (LAMBDA NIL 1))
                                   IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
                                   IMFONTCREATE ←(QUOTE 8DISPLAY)
                                   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)
                                   IMDRAWARC ←(FUNCTION \DRAWARC.DISPLAY)))
    (SETQ \8DISPLAYFDEV (create FDEV
                               DEVICENAME ←(QUOTE 8DISPLAY)
                               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 \8DISPLAYFDEV)))

(\24DISPLAYINIT
  (LAMBDA NIL                                                         (* kbr: 
                                                                          "20-Feb-86 19:09")
    (DECLARE (GLOBALVARS \24DISPLAYIMAGEOPS \24DISPLAYFDEV))
    (SETQ \24DISPLAYIMAGEOPS (create IMAGEOPS
                                    IMAGETYPE ←(QUOTE 24DISPLAY)
                                    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.DISPLAY)
                                    IMBLTSHADE ←(FUNCTION \BLTSHADE.DISPLAY)
                                    IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
                                    IMSCALE ←(FUNCTION (LAMBDA NIL 1))
                                    IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
                                    IMFONTCREATE ←(QUOTE 24DISPLAY)
                                    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)
                                    IMDRAWARC ←(FUNCTION \DRAWARC.DISPLAY)))
    (SETQ \24DISPLAYFDEV (create FDEV
                                DEVICENAME ←(QUOTE 24DISPLAY)
                                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 \24DISPLAYFDEV)))

(\DISPLAYSTREAMTYPEBPP
  (LAMBDA (DISPLAYSTREAMTYPE)                                         (* kbr: 
                                                                          " 6-Feb-86 18:14")
    (SELECTQ DISPLAYSTREAMTYPE
        (DISPLAY 1)
        (4DISPLAY 4)
        (8DISPLAY 8)
        (24DISPLAY 24)
        (SHOULDNT))))
)

(ADDTOVAR IMAGESTREAMTYPES (DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                                  (FONTCREATE \CREATEDISPLAYFONT)
                                  (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
                           (4DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                                  (FONTCREATE \CREATEDISPLAYFONT)
                                  (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
                           (8DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                                  (FONTCREATE \CREATEDISPLAYFONT)
                                  (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
                           (24DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                                  (FONTCREATE \CREATEDISPLAYFONT)
                                  (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS DisplayFDEV \4DISPLAYFDEV \8DISPLAYFDEV \24DISPLAYFDEV)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\DISPLAYINIT)
(\4DISPLAYINIT)
(\8DISPLAYINIT)
(\24DISPLAYINIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA IMAGESTREAMP)
)
(PUTPROPS IMAGEIO COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3154 11919 (IMAGESTREAMP 3164 . 3813) (IMAGESTREAMTYPE 3815 . 4030) (IMAGESTREAMTYPEP 
4032 . 4549) (OPENIMAGESTREAM 4551 . 9416) (\GOOD.DASHLST 9418 . 11917)) (11954 13696 (DRAWDASHEDLINE 
11964 . 13694)) (13697 20845 (DSPBACKCOLOR 13707 . 14027) (DSPBOTTOMMARGIN 14029 . 14366) (DSPCOLOR 
14368 . 14680) (DSPCLIPPINGREGION 14682 . 15321) (DSPRESET 15323 . 15616) (DSPFONT 15618 . 15969) (
DSPLEFTMARGIN 15971 . 16334) (DSPLINEFEED 16336 . 16648) (DSPOPERATION 16650 . 16975) (DSPRIGHTMARGIN 
16977 . 17356) (DSPTOPMARGIN 17358 . 17691) (DSPSCALE 17693 . 18048) (DSPSPACEFACTOR 18050 . 18454) (
DSPXPOSITION 18456 . 18773) (DSPYPOSITION 18775 . 19092) (DSPROTATE 19094 . 19402) (DSPPUSHSTATE 19404
 . 19674) (DSPPOPSTATE 19676 . 19943) (DSPDEFAULTSTATE 19945 . 20221) (DSPSCALE2 20223 . 20527) (
DSPTRANSLATE 20529 . 20843)) (20846 29969 (DSPNEWPAGE 20856 . 22001) (DRAWBETWEEN 22003 . 22489) (
DRAWCIRCLE 22491 . 22979) (DRAWARC 22981 . 23606) (DRAWCURVE 23608 . 24405) (DRAWELLIPSE 24407 . 25148
) (DRAWLINE 25150 . 25456) (DRAWPOLYGON 25458 . 25853) (FILLPOLYGON 25855 . 26551) (DRAWTO 26553 . 
27078) (FILLCIRCLE 27080 . 27319) (MOVETO 27321 . 27638) (RELDRAWTO 27640 . 29006) (BITMAPIMAGESIZE 
29008 . 29197) (SCALEDBITBLT 29199 . 29967)) (29970 37552 (\IMAGEIOINIT 29980 . 35934) (
\NOIMAGE.DSPFONT 35936 . 37377) (\UNIMPIMAGEOP 37379 . 37550)) (37669 41731 (INSURE.BRUSH 37679 . 
39540) (BRUSHP 39542 . 40688) (\POSSIBLECOLOR 40690 . 41729)) (42175 42959 (DASHINGP 42185 . 42580) (
INSURE.DASHING 42582 . 42957)) (53736 72970 (\DisplayEventFn 53746 . 54328) (\DISPLAYINIT 54330 . 
59606) (\4DISPLAYINIT 59608 . 63923) (\8DISPLAYINIT 63925 . 68240) (\24DISPLAYINIT 68242 . 72622) (
\DISPLAYSTREAMTYPEBPP 72624 . 72968)))))
STOP