(FILECREATED "17-Sep-84 18:12:27" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;36 23961
changes to: (FNS \DISPLAYINIT)
previous date: "17-Sep-84 18:00:39" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;35)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IMAGEIOCOMS)
(RPAQQ IMAGEIOCOMS [(FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP OPENIMAGESTREAM)
(INITVARS (IMAGESTREAMTYPES NIL))
(FNS DSPBACKCOLOR DSPBOTTOMMARGIN DSPCOLOR DSPFONT DSPLEFTMARGIN DSPLINEFEED
DSPOPERATION DSPRIGHTMARGIN DSPTOPMARGIN DSPSCALE DSPSPACEFACTOR
DSPXPOSITION DSPYPOSITION)
(FNS DRAWBETWEEN DRAWCIRCLE DRAWCURVE DRAWELLIPSE DRAWLINE DRAWTO FILLCIRCLE
MOVETO RELDRAWTO)
(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)
(ALISTS (IMAGESTREAMTYPES DISPLAY))
(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: "27-Aug-84 09:54")
(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
((EQ NARGS 2)
(for X inside (ARG NARGS 1) always (EQMEMB X STYPE)))
((IGREATERP NARGS 2)
(for X from 2 to NARGS 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 TYPE) (* rmk: "27-Aug-84 09:50")
(AND (type? STREAM STREAM)
(for X inside TYPE always (EQMEMB X (fetch (IMAGEOPS IMAGETYPE) of (fetch (STREAM IMAGEOPS)
of STREAM])
(OPENIMAGESTREAM
[LAMBDA (FILE IMAGETYPE OPTIONS) (* rmk: " 7-Sep-84 15:41")
(* 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
((NULL FILE)
(SETQ LPTP T)
(SETQ FILE (QUOTE {LPT})))
((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 FILE T)))
([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 (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])
)
(RPAQ? IMAGESTREAMTYPES NIL)
(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])
(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: "14-Aug-84 14:56")
(* Sets the space factor of STREAM)
(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
(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: "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) (* 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])
(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) (* 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: "13-Sep-84 17:22")
(DECLARE (GLOBALVARS \NOIMAGEOPS))
(SETQ \NOIMAGEOPS (create IMAGEOPS
IMAGETYPE ← NIL
IMCLOSEFN ←(FUNCTION NILL)
IMXPOSITION ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DSPXPOSITION]
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 (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DSPLEFTMARGIN]
IMRIGHTMARGIN ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DSPRIGHTMARGIN]
IMLINEFEED ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DSPLINEFEED]
IMDRAWLINE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DRAWLINE]
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]
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])
(\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)
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)
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]))
]
(/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)))
(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)))
[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))
]
(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 (* rmk: "17-Sep-84 18:12")
(* 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.1BITDISPLAY)
IMBLTSHADE ←(FUNCTION \BLTSHADE.1BITDISPLAY)
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)))
(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])
)
(ADDTOVAR IMAGESTREAMTYPES (DISPLAY [OPENSTREAM (LAMBDA (FILE)
(CREATEW NIL (COND ((EQ FILE (QUOTE {LPT}))
"Display image stream")
(T FILE]
(FONTCREATE \CREATEDISPLAYFONT)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(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 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1524 5910 (IMAGESTREAMP 1534 . 2128) (IMAGESTREAMTYPE 2130 . 2342) (IMAGESTREAMTYPEP
2344 . 2642) (OPENIMAGESTREAM 2644 . 5908)) (5945 10207 (DSPBACKCOLOR 5955 . 6266) (DSPBOTTOMMARGIN
6268 . 6596) (DSPCOLOR 6598 . 6901) (DSPFONT 6903 . 7245) (DSPLEFTMARGIN 7247 . 7601) (DSPLINEFEED
7603 . 7906) (DSPOPERATION 7908 . 8224) (DSPRIGHTMARGIN 8226 . 8596) (DSPTOPMARGIN 8598 . 8922) (
DSPSCALE 8924 . 9271) (DSPSPACEFACTOR 9273 . 9585) (DSPXPOSITION 9587 . 9895) (DSPYPOSITION 9897 .
10205)) (10208 13930 (DRAWBETWEEN 10218 . 10688) (DRAWCIRCLE 10690 . 11100) (DRAWCURVE 11102 . 11436)
(DRAWELLIPSE 11438 . 12107) (DRAWLINE 12109 . 12338) (DRAWTO 12340 . 12841) (FILLCIRCLE 12843 . 13073)
(MOVETO 13075 . 13391) (RELDRAWTO 13393 . 13928)) (13931 16647 (\IMAGEIOINIT 13941 . 16482) (
\UNIMPIMAGEOP 16484 . 16645)) (19810 23404 (\DisplayEventFn 19820 . 20345) (\DISPLAYINIT 20347 . 23402
)))))
STOP