(FILECREATED " 6-Mar-85 17:46:17" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;60 33779
changes to: (FNS \COLORDISPLAYINIT)
previous date: "19-Feb-85 13:24:22" {ERIS}<LISPCORE>SOURCES>IMAGEIO.;59)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IMAGEIOCOMS)
(RPAQQ IMAGEIOCOMS [(FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP OPENIMAGESTREAM)
(INITVARS (IMAGESTREAMTYPES NIL))
(FNS DRAWDASHEDLINE)
(FNS DSPBACKCOLOR DSPBOTTOMMARGIN DSPCOLOR DSPCLIPPINGREGION DSPRESET DSPFONT DSPLEFTMARGIN
DSPLINEFEED DSPOPERATION DSPRIGHTMARGIN DSPTOPMARGIN DSPSCALE DSPSPACEFACTOR
DSPXPOSITION DSPYPOSITION)
(FNS DSPNEWPAGE DRAWBETWEEN DRAWCIRCLE DRAWCURVE DRAWELLIPSE DRAWLINE DRAWPOLYGON FILLPOLYGON
DRAWTO FILLCIRCLE MOVETO RELDRAWTO BITMAPIMAGESIZE SCALEDBITBLT)
(FNS \IMAGEIOINIT \UNIMPIMAGEOP)
(DECLARE: DONTCOPY (EXPORT (MACROS IMAGEOP)
(RECORDS IMAGEOPS)
(GLOBALVARS \NOIMAGEOPS)))
(INITRECORDS IMAGEOPS)
(SYSRECORDS IMAGEOPS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\IMAGEIOINIT)))
[COMS (* Implementation of display stream resident "files." Done here cause it might matter
that the display device get defined early so that its event fn will be evaluated as
the last thing before logout)
(FNS \DisplayEventFn \DISPLAYINIT \COLORDISPLAYINIT)
(ALISTS (IMAGESTREAMTYPES DISPLAY))
(GLOBALVARS DisplayFDEV ColorDisplayFDEV)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\DISPLAYINIT)
(\COLORDISPLAYINIT]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA IMAGESTREAMP])
(DEFINEQ
(IMAGESTREAMP
[LAMBDA NARGS (* 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) (* hdj "28-Jan-85 21:43")
(* 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.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 (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
(DRAWDASHEDLINE
[LAMBDA (X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR DASHING)
(* hdj "28-Nov-84 09:30")
(PROG ((DASHON T)
(DASHTAIL DASHING)
DASHCNT
(ADJACENT (IDIFFERENCE X2 X1))
(OPPOSITE (IDIFFERENCE Y2 Y1))
(LENGTHDRAWN 0)
NEWX NEWY LINELENGTH SINE COSINE)
[SETQ LINELENGTH (FIX (SQRT (IPLUS (ITIMES ADJACENT ADJACENT)
(ITIMES OPPOSITE OPPOSITE]
(SETQ SINE (FQUOTIENT OPPOSITE LINELENGTH))
(SETQ COSINE (FQUOTIENT ADJACENT LINELENGTH))
(while (ILESSP LENGTHDRAWN 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)))
(if DASHON
then (DRAWLINE X1 Y1 NEWX NEWY WIDTH OPERATION STREAM COLOR)
else (RELMOVETO NEWX NEWY STREAM))
(SETQ DASHON (NOT DASHON))
(SETQ X1 NEWX)
(SETQ Y1 NEWY)
(if (NULL DASHTAIL)
then (SETQ DASHTAIL DASHING])
)
(DEFINEQ
(DSPBACKCOLOR
[LAMBDA (COLOR STREAM) (* rmk: "12-Sep-84 09:53")
(* Switches background color on stream)
(IMAGEOP (QUOTE IMBACKCOLOR)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM COLOR])
(DSPBOTTOMMARGIN
[LAMBDA (YPOSITION STREAM) (* rmk: "26-Jun-84 13:56")
(* Sets the Y position that forces a new page)
(IMAGEOP (QUOTE IMBOTTOMMARGIN)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM YPOSITION])
(DSPCOLOR
[LAMBDA (COLOR STREAM) (* rmk: "12-Sep-84 09:53")
(* Switches foreground color on stream)
(IMAGEOP (QUOTE IMCOLOR)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM COLOR])
(DSPCLIPPINGREGION
[LAMBDA (REGION STREAM) (* jds "11-Jan-85 16:53")
(* Set the clipping region for an imagestream)
(COND
(STREAM (* special check done for NIL to stop default to
primary output file.)
(IMAGEOP (QUOTE IMCLIPPINGREGION)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM REGION))
(T (\ILLEGAL.ARG STREAM])
(DSPRESET
[LAMBDA (STREAM) (* jds "11-Jan-85 16:54")
(* resets a display stream)
(IMAGEOP (QUOTE IMRESET)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM])
(DSPFONT
[LAMBDA (FONT STREAM) (* rmk: " 2-SEP-83 10:50")
(* sets the font that an image stream uses to print
characters.)
(IMAGEOP (QUOTE IMFONT)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM FONT])
(DSPLEFTMARGIN
[LAMBDA (XPOSITION STREAM) (* rmk: " 2-SEP-83 10:50")
(* Sets the the position that a carriage return returns
to)
(IMAGEOP (QUOTE IMLEFTMARGIN)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM XPOSITION])
(DSPLINEFEED
[LAMBDA (DELTAY STREAM) (* rmk: " 2-SEP-83 10:50")
(* Sets the Xposition of STREAM)
(IMAGEOP (QUOTE IMLINEFEED)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM DELTAY])
(DSPOPERATION
[LAMBDA (OPERATION STREAM) (* rmk: "12-Sep-84 09:56")
(* sets the operation field of a stream)
(IMAGEOP (QUOTE IMOPERATION)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM OPERATION])
(DSPRIGHTMARGIN
[LAMBDA (XPOSITION STREAM) (* rmk: " 2-SEP-83 10:51")
(* Sets the right margin that determines when a cr is
inserted by print.)
(IMAGEOP (QUOTE IMRIGHTMARGIN)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM XPOSITION])
(DSPTOPMARGIN
[LAMBDA (YPOSITION STREAM) (* rmk: "26-Jun-84 13:55")
(* Sets the Y position that a newpage starts at)
(IMAGEOP (QUOTE IMTOPMARGIN)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM YPOSITION])
(DSPSCALE
[LAMBDA (SCALE STREAM) (* rmk: "16-Jun-84 14:48")
(* Returns (and eventually will set) the current scale
of STREAM.)
(IMAGEOP (QUOTE IMSCALE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM SCALE])
(DSPSPACEFACTOR
[LAMBDA (FACTOR STREAM) (* rmk: "27-Nov-84 18:57")
(* Sets the space factor of STREAM)
(AND FACTOR (OR (GREATERP FACTOR 0)
(\ILLEGAL.ARG FACTOR)))
(IMAGEOP (QUOTE IMSPACEFACTOR)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM FACTOR])
(DSPXPOSITION
[LAMBDA (XPOSITION STREAM) (* rmk: " 2-SEP-83 10:51")
(* Sets the Xposition of STREAM)
(IMAGEOP (QUOTE IMXPOSITION)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM XPOSITION])
(DSPYPOSITION
[LAMBDA (YPOSITION STREAM) (* rmk: " 2-SEP-83 10:51")
(* Sets the Yposition of STREAM)
(IMAGEOP (QUOTE IMYPOSITION)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM YPOSITION])
)
(DEFINEQ
(DSPNEWPAGE
[LAMBDA (STREAM) (* jds "12-Jan-85 09:54")
(* Start a new page on the image stream STREAM.)
(IMAGEOP (QUOTE IMNEWPAGE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM])
(DRAWBETWEEN
[LAMBDA (PT1 PT2 WIDTH OPERATION STREAM COLOR DASHING) (* hdj " 7-Nov-84 14:03")
(* draws a line bwteen two points)
(IMAGEOP (QUOTE IMDRAWLINE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM
(fetch XCOORD of PT1)
(fetch YCOORD of PT1)
(fetch XCOORD of PT2)
(fetch YCOORD of PT2)
WIDTH OPERATION COLOR DASHING])
(DRAWCIRCLE
[LAMBDA (CENTERX CENTERY RADIUS BRUSH DASHING STREAM) (* rmk: "20-Aug-84 12:05")
(* Generic DRAWCURVE)
(COND
((LESSP RADIUS 0)
(\ILLEGAL.ARG RADIUS))
((EQP RADIUS 0)
NIL)
(T (IMAGEOP (QUOTE IMDRAWCIRCLE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM CENTERX CENTERY RADIUS BRUSH DASHING])
(DRAWCURVE
[LAMBDA (KNOTS CLOSED BRUSH DASHING STREAM) (* rmk: " 2-SEP-83 10:52")
(* draws a spline curve with a given brush.)
(IMAGEOP (QUOTE IMDRAWCURVE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM KNOTS CLOSED BRUSH DASHING])
(DRAWELLIPSE
[LAMBDA (CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING STREAM)
(* rmk: " 2-SEP-83 10:53")
(* Draws an ellipse. At ORIENTATION 0, the semimajor axis is horizontal, the semiminor axis vertical.
Orientation is positive in the counterclockwise direction. The current location in the stream is left at the
center of the ellipse.)
(DECLARE (LOCALVARS . T))
(IMAGEOP (QUOTE IMDRAWELLIPSE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING])
(DRAWLINE
[LAMBDA (X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR DASHING)
(* hdj "28-Nov-84 09:29")
(COND
(DASHING (DRAWDASHEDLINE X1 Y1 X2 Y2 WIDTH OPERATION STREAM COLOR DASHING))
(T (IMAGEOP (QUOTE IMDRAWLINE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING])
(DRAWPOLYGON
[LAMBDA (POINTS CLOSED BRUSH DASHING STREAM) (* hdj "28-Jan-85 22:51")
(* draws a polygon with a given brush.)
(IMAGEOP (QUOTE IMDRAWPOLYGON)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM POINTS CLOSED BRUSH DASHING])
(FILLPOLYGON
[LAMBDA (POINTS TEXTURE STREAM) (* hdj "28-Jan-85 22:53")
(* fills a polygon with a given texture)
(IMAGEOP (QUOTE IMDRAWPOLYGON)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM POINTS TEXTURE])
(DRAWTO
[LAMBDA (X Y WIDTH OPERATION STREAM COLOR DASHING) (* hdj " 7-Nov-84 14:03")
(* draws a line fro the current position of STREAM to
absolute position X,Y.)
(IMAGEOP (QUOTE IMDRAWLINE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM
(IMAGEOP (QUOTE IMXPOSITION)
STREAM STREAM)
(IMAGEOP (QUOTE IMYPOSITION)
STREAM STREAM)
X Y WIDTH OPERATION COLOR DASHING])
(FILLCIRCLE
[LAMBDA (CENTERX CENTERY RADIUS TEXTURE STREAM) (* rmk: " 2-SEP-83 10:54")
(IMAGEOP (QUOTE IMFILLCIRCLE)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM CENTERX CENTERY RADIUS TEXTURE])
(MOVETO
[LAMBDA (X Y STREAM) (* rmk: "17-Sep-84 17:59")
(* sets both the X and Y positions in a Stream)
(IMAGEOP (QUOTE IMMOVETO)
(SETQ STREAM (\OUTSTREAMARG STREAM))
STREAM X Y])
(RELDRAWTO
[LAMBDA (DX DY WIDTH OPERATION STREAM COLOR DASHING) (* hdj " 7-Nov-84 14:04")
(* Draws a vector from the current position)
(PROG (ORIGX ORIGY (STRM (\OUTSTREAMARG STREAM)))
(RETURN (IMAGEOP (QUOTE IMDRAWLINE)
STRM STRM (SETQ ORIGX (IMAGEOP (QUOTE IMXPOSITION)
STRM STRM))
(SETQ ORIGY (IMAGEOP (QUOTE IMYPOSITION)
STRM STRM))
(IPLUS ORIGX DX)
(IPLUS ORIGY DY)
WIDTH OPERATION COLOR DASHING])
(BITMAPIMAGESIZE
[LAMBDA (BITMAP DIMENSION STREAM) (* hdj "19-Dec-84 11:57")
(IMAGEOP (QUOTE IMBITMAPSIZE)
STREAM STREAM BITMAP DIMENSION])
(SCALEDBITBLT
[LAMBDA (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT
SOURCETYPE OPERATION TEXTURE CLIPPINGREGION SCALE)
(* hdj "14-Feb-85 14:35")
(IMAGEOP (QUOTE IMSCALEDBITBLT)
DESTINATION SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION (OR DESTINATIONLEFT 0)
(OR DESTINATIONBOTTOM 0)
WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION (if CLIPPINGREGION
then (fetch (REGION LEFT)
of CLIPPINGREGION)
else 0)
(if CLIPPINGREGION
then (fetch (REGION LEFT) of CLIPPINGREGION)
else 0)
SCALE])
)
(DEFINEQ
(\IMAGEIOINIT
[LAMBDA NIL (* hdj "28-Jan-85 22:49")
(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]
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])
(\UNIMPIMAGEOP
[LAMBDA (STREAM OP) (* rmk: "26-Jun-84 13:28")
(ERROR STREAM (CONCAT "does not support " OP])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS IMAGEOP MACRO [ARGS (CONS (QUOTE SPREADAPPLY*)
(CONS (COND
[(EQ (CAR (LISTP (CAR ARGS)))
(QUOTE QUOTE))
(LIST (QUOTE fetch)
(LIST (QUOTE IMAGEOPS)
(CADAR ARGS))
(QUOTE of)
(LIST (QUOTE fetch)
(QUOTE (STREAM IMAGEOPS))
(QUOTE of)
(CADR ARGS]
(T (HELP "IMAGEOP - OPNAME not quoted:" ARGS)))
(CDDR ARGS])
)
[DECLARE: EVAL@COMPILE
(DATATYPE IMAGEOPS (IMAGETYPE IMCLOSEFN IMXPOSITION IMYPOSITION IMFONT IMLEFTMARGIN IMRIGHTMARGIN
IMLINEFEED IMDRAWLINE IMDRAWCURVE IMDRAWCIRCLE IMDRAWELLIPSE
IMFILLCIRCLE IMBLTSHADE IMBITBLT IMNEWPAGE IMMOVETO IMSCALE IMTERPRI
IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION
IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE
IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT
IMPIXEL)
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]
IMPIXEL ←(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)))
(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)))
[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
IMPIXEL))
]
(DECLARE: DONTEVAL@LOAD DOCOPY
(\IMAGEIOINIT)
)
(* Implementation of display stream resident "files." Done here cause it might matter that the
display device get defined early so that its event fn will be evaluated as the last thing
before logout)
(DEFINEQ
(\DisplayEventFn
[LAMBDA (FDEV EVENT) (* bvm: "25-MAY-83 12:32")
(SELECTQ EVENT
(BEFORELOGOUT (DISPLAYBEFOREEXIT (QUOTE LOGOUT)))
(AFTERLOGOUT (DISPLAYAFTERENTRY (QUOTE LOGOUT)))
(BEFOREMAKESYS (DISPLAYBEFOREEXIT (QUOTE MAKESYS)))
(AFTERMAKESYS (DISPLAYAFTERENTRY (QUOTE MAKESYS)))
((BEFORESYSOUT BEFORESAVEVM)
(DISPLAYBEFOREEXIT (QUOTE SYSOUT)))
((AFTERSYSOUT AFTERSAVEVM)
(DISPLAYAFTERENTRY (QUOTE SYSOUT)))
NIL])
(\DISPLAYINIT
[LAMBDA NIL (* hdj "11-Feb-85 15:36")
(* Initializes global variables for the Display device)
(* Display Streams are referred to only by themselves so they do not need directory operations.
Most of the fields in the DisplayDevice are empty to avoid something bad happening.)
(DECLARE (GLOBALVARS DisplayFDEV \DISPLAYIMAGEOPS \DisplayDeviceMethods \DisplayDeviceData))
(SETQ \DisplayDeviceMethods (create WSOPS
WSCHANGEBACKGROUND ←(FUNCTION \CHANGEBACKGROUND.DISPLAY)
WSCHANGEBACKGROUNDBORDER ←(FUNCTION
\CHANGEBACKGROUNDBORDER.DISPLAY)))
(SETQ \DisplayDeviceData
(create WSDATA
WSDESTINATION ← ScreenBitMap
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)
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)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.DISPLAY)
IMRESET ←(FUNCTION \DSPRESET.DISPLAY)))
(SETQ DisplayFDEV (create FDEV
DEVICENAME ←(QUOTE DISPLAY)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
CLOSEFILE ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION NILL)
OPENFILE ←(FUNCTION [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
NAME])
READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG FDEV)
NAME])
REOPENFILE ←(FUNCTION [LAMBDA (NAME)
NAME])
EVENTFN ←(FUNCTION \DisplayEventFn)
DIRECTORYNAMEP ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
BIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BOUT ←(FUNCTION \DSPPRINTCHAR)
PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
WINDOWOPS ← \DisplayDeviceMethods
WINDOWDATA ← \DisplayDeviceData
DEVICEINFO ←(create DISPLAYSTATE)))
(\DEFINEDEVICE (QUOTE LFDISPLAY)
DisplayFDEV])
(\COLORDISPLAYINIT
[LAMBDA NIL (* hdj " 6-Mar-85 17:34")
(DECLARE (GLOBALVARS \COLORDISPLAYIMAGEOPS ColorDisplayFDEV))
(SETQ \COLORDISPLAYIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE (COLOR DISPLAY))
IMFONT ←(FUNCTION \DSPFONT.COLORDISPLAY)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.DISPLAY)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.DISPLAY)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.DISPLAY)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.DISPLAY)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.DISPLAY)
IMCLOSEFN ←(FUNCTION NILL)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.DISPLAY)
IMFILLCIRCLE ←(QUOTE \FILLCIRCLE.DISPLAY)
IMDRAWLINE ←(FUNCTION \DRAWLINE.DISPLAY)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.DISPLAY)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.DISPLAY)
IMBITBLT ←(FUNCTION \BITBLT.COLORDISPLAY)
IMBLTSHADE ←(FUNCTION \BLTSHADE.COLORDISPLAY)
IMNEWPAGE ←(FUNCTION \NEWPAGE.DISPLAY)
IMSCALE ←(FUNCTION [LAMBDA NIL 1])
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
IMFONTCREATE ←(QUOTE DISPLAY)
IMCOLOR ←(FUNCTION \DSPCOLOR.DISPLAY)
IMBACKCOLOR ←(FUNCTION \DSPBACKCOLOR.DISPLAY)
IMOPERATION ←(FUNCTION \DSPOPERATION.DISPLAY)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.DISPLAY)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.DISPLAY)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.DISPLAY)
IMRESET ←(FUNCTION \DSPRESET.DISPLAY)))
(SETQ ColorDisplayFDEV (create FDEV
DEVICENAME ←(QUOTE (COLOR DISPLAY))
RESETABLE ← NIL
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
CLOSEFILE ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION NILL)
OPENFILE ←(FUNCTION [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
NAME])
READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG FDEV)
NAME])
REOPENFILE ←(FUNCTION [LAMBDA (NAME)
NAME])
EVENTFN ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
BIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BOUT ←(FUNCTION \DSPPRINTCHAR)
PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
DEVICEINFO ←(create DISPLAYSTATE)
WINDOWOPS ← NIL))
(\DEFINEDEVICE NIL ColorDisplayFDEV])
)
(ADDTOVAR IMAGESTREAMTYPES (DISPLAY [OPENSTREAM (LAMBDA (FILE)
(GETSTREAM (CREATEW NIL
(COND
((EQ FILE (QUOTE {LPT}))
"Display image stream")
(T FILE]
(FONTCREATE \CREATEDISPLAYFONT)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DisplayFDEV ColorDisplayFDEV)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\DISPLAYINIT)
(\COLORDISPLAYINIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA IMAGESTREAMP)
)
(PUTPROPS IMAGEIO COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1671 6391 (IMAGESTREAMP 1681 . 2275) (IMAGESTREAMTYPE 2277 . 2489) (IMAGESTREAMTYPEP
2491 . 2789) (OPENIMAGESTREAM 2791 . 6389)) (6426 7658 (DRAWDASHEDLINE 6436 . 7656)) (7659 12859 (
DSPBACKCOLOR 7669 . 7980) (DSPBOTTOMMARGIN 7982 . 8310) (DSPCOLOR 8312 . 8615) (DSPCLIPPINGREGION 8617
. 9165) (DSPRESET 9167 . 9459) (DSPFONT 9461 . 9803) (DSPLEFTMARGIN 9805 . 10159) (DSPLINEFEED 10161
. 10464) (DSPOPERATION 10466 . 10782) (DSPRIGHTMARGIN 10784 . 11154) (DSPTOPMARGIN 11156 . 11480) (
DSPSCALE 11482 . 11829) (DSPSPACEFACTOR 11831 . 12237) (DSPXPOSITION 12239 . 12547) (DSPYPOSITION
12549 . 12857)) (12860 18763 (DSPNEWPAGE 12870 . 13187) (DRAWBETWEEN 13189 . 13674) (DRAWCIRCLE 13676
. 14086) (DRAWCURVE 14088 . 14422) (DRAWELLIPSE 14424 . 15093) (DRAWLINE 15095 . 15501) (DRAWPOLYGON
15503 . 15844) (FILLPOLYGON 15846 . 16175) (DRAWTO 16177 . 16701) (FILLCIRCLE 16703 . 16933) (MOVETO
16935 . 17251) (RELDRAWTO 17253 . 17831) (BITMAPIMAGESIZE 17833 . 18021) (SCALEDBITBLT 18023 . 18761))
(18764 21814 (\IMAGEIOINIT 18774 . 21649) (\UNIMPIMAGEOP 21651 . 21812)) (25908 33086 (
\DisplayEventFn 25918 . 26443) (\DISPLAYINIT 26445 . 30213) (\COLORDISPLAYINIT 30215 . 33084)))))
STOP