(FILECREATED " 8-NOV-83 20:58:45" {PHYLUM}<LISPCORE>SOURCES>IMAGEIO.;8
 12913  

      changes to:  (FNS \DISPLAYINIT)

      previous date: "14-OCT-83 16:08:10" {PHYLUM}<LISPCORE>SOURCES>IMAGEIO.;7)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT IMAGEIOCOMS)

(RPAQQ IMAGEIOCOMS
 [(FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP)
		    (FNS DSPFONT DSPLEFTMARGIN DSPLINEFEED DSPRIGHTMARGIN DSPXPOSITION DSPYPOSITION)
		    (FNS DRAWBETWEEN DRAWCIRCLE DRAWCURVE DRAWELLIPSE DRAWLINE DRAWTO FILLCIRCLE 
			 RELDRAWTO)
		    (FNS \IMAGEIOINIT)
		    (INITRECORDS IMAGEOPS)
		    (DECLARE: DONTEVAL@LOAD DOCOPY (P (\IMAGEIOINIT)))
		    (DECLARE: DONTCOPY (EXPORT (MACROS IMAGEOP)
					       (RECORDS IMAGEOPS)
					       (GLOBALVARS \NOIMAGEOPS)))
		    [COMS (* Implementation of display stream resident "files")
			  (FNS \DisplayEventFn \DISPLAYINIT)
			  (GLOBALVARS DisplayFDEV)
			  (DECLARE: DONTEVAL@LOAD DOCOPY (P (\DISPLAYINIT]
		    (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
				(NLAMA)
				(NLAML)
				(LAMA IMAGESTREAMP])
(DEFINEQ

(IMAGESTREAMP

  [LAMBDA NARGS                                              (* rmk: " 1-SEP-83 10:34")

    (PROG [STYPE (STREAM (AND (IGREATERP NARGS 0)
			      (ARG NARGS 1]
          (OR (type?
 STREAM STREAM)
	      (RETURN))
          (SETQ STYPE (fetch
 (IMAGEOPS IMAGETYPE) of
 (fetch
 (STREAM IMAGEOPS) of
 STREAM)))
          (RETURN (AND (COND
			 ((IGREATERP NARGS 1)
			   (EQMEMB (ARG NARGS 1)
				   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 TYPE)                                      (* rmk: "31-AUG-83 15:36")

    (AND (type?
 STREAM STREAM)
	 (EQMEMB TYPE (fetch
 (IMAGEOPS IMAGETYPE) of
 (fetch
 (STREAM IMAGEOPS) of
 STREAM])
)
(DEFINEQ

(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])

(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])

(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

(DRAWBETWEEN

  [LAMBDA (PT1 PT2 WIDTH OPERATION STREAM COLOR)             (* rmk: " 2-SEP-83 10:52")

                                                             (* 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])

(DRAWCIRCLE

  [LAMBDA (CENTERX CENTERY RADIUS BRUSH DASHING STREAM)      (* rmk: " 2-SEP-83 10:52")

                                                             (* DRAWCIRCLE extended for color.

							     Color is specified by either BRUSH or the DSPCOLOR of 

							     DS.)

    (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)         (* rmk: " 2-SEP-83 10:53")

    (IMAGEOP (QUOTE IMDRAWLINE)
	     (SETQ STREAM (\OUTSTREAMARG STREAM))
	     STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR])

(DRAWTO

  [LAMBDA (X Y WIDTH OPERATION STREAM COLOR)                 (* rmk: " 2-SEP-83 10:55")

                                                             (* 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])

(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])

(RELDRAWTO

  [LAMBDA (DX DY WIDTH OPERATION STREAM COLOR)               (* rmk: " 2-SEP-83 10:54")

                                                             (* 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])
)
(DEFINEQ

(\IMAGEIOINIT

  [LAMBDA NIL                                                (* rmk: "31-AUG-83 21:20")

    (DECLARE
 (GLOBALVARS \NOIMAGEOPS))
    (SETQ \NOIMAGEOPS (create
 IMAGEOPS
			      IMAGETYPE ← NIL
			      IMCLOSEFN ←(FUNCTION NILL)
			      IMXPOSITION ←(FUNCTION \ILLEGAL.ARG)
			      IMYPOSITION ←(FUNCTION \ILLEGAL.ARG)
			      IMFONT ←(FUNCTION \ILLEGAL.ARG)
			      IMLEFTMARGIN ←(FUNCTION \ILLEGAL.ARG)
			      IMRIGHTMARGIN ←(FUNCTION \ILLEGAL.ARG)
			      IMLINEFEED ←(FUNCTION \ILLEGAL.ARG)
			      IMDRAWLINE ←(FUNCTION \ILLEGAL.ARG)
			      IMDRAWCURVE ←(FUNCTION \ILLEGAL.ARG)
			      IMDRAWCIRCLE ←(FUNCTION \ILLEGAL.ARG)
			      IMDRAWELLIPSE ←(FUNCTION \ILLEGAL.ARG)
			      IMFILLCIRCLE ←(FUNCTION \ILLEGAL.ARG)
			      IMBLTSHADE ←(FUNCTION \ILLEGAL.ARG)
			      IMBITBLT ←(FUNCTION \ILLEGAL.ARG])
)
(/DECLAREDATATYPE (QUOTE IMAGEOPS)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER)))
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\IMAGEIOINIT)
)
(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))
]
(/DECLAREDATATYPE (QUOTE IMAGEOPS)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \NOIMAGEOPS)
)


(* END EXPORTED DEFINITIONS)

)



(* Implementation of display stream resident "files")


(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                                                (* rmk: " 8-NOV-83 20:58")

                                                             (* 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))
    (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.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)))
    (\DEFINEDEVICE NIL DisplayFDEV])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

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

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 IMAGESTREAMP)
)
(PUTPROPS IMAGEIO COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1088 2039 (IMAGESTREAMP 1098 . 1574) (IMAGESTREAMTYPE 1576 . 1788) (IMAGESTREAMTYPEP 
1790 . 2037)) (2040 4047 (DSPFONT 2050 . 2392) (DSPLEFTMARGIN 2394 . 2748) (DSPLINEFEED 2750 . 3053) (
DSPRIGHTMARGIN 3055 . 3425) (DSPXPOSITION 3427 . 3735) (DSPYPOSITION 3737 . 4045)) (4048 7469 (
DRAWBETWEEN 4058 . 4528) (DRAWCIRCLE 4530 . 4957) (DRAWCURVE 4959 . 5293) (DRAWELLIPSE 5295 . 5964) (
DRAWLINE 5966 . 6195) (DRAWTO 6197 . 6698) (FILLCIRCLE 6700 . 6930) (RELDRAWTO 6932 . 7467)) (7470 
8333 (\IMAGEIOINIT 7480 . 8331)) (9666 12571 (\DisplayEventFn 9676 . 10201) (\DISPLAYINIT 10203 . 
12569)))))
STOP