(FILECREATED "15-Dec-86 16:16:28" {DSK}<LISPFILES>4045>V1.4>4045XLPSTREAM.;4 111418
changes to: (FNS 4045XLP.HELP.GET.PORT)
previous date: "15-Dec-86 07:02:27" {DSK}<LISPFILES>4045>V1.4>4045XLPSTREAM.;3)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT 4045XLPSTREAMCOMS)
(RPAQQ 4045XLPSTREAMCOMS [(VARS (4045XLPSTREAM.VERSION 1.4))
(* * Main stream functions)
(FNS \4045XLPINIT OPEN4045XLPSTREAM \CLOSE4045XLPSTREAM 4045.OUTCHARFN 4045.OUTCHARFN1)
(* * Font methods)
(FNS \CREATE4045FONT \CREATECHARSET.4045 \SEARCH4045FONTS \CHANGECHARSET.4045XLP)
(* * DSPxx fns)
(FNS \DSPXPOSITION.4045XLP \DSPYPOSITION.4045XLP \DSPBOTTOMMARGIN.4045XLP
\DSPTOPMARGIN.4045XLP \DSPLEFTMARGIN.4045XLP \DSPRIGHTMARGIN.4045XLP
\DSPCLIPPINGREGION.4045XLP \DSPSPACEFACTOR.4045XLP \DSPLINEFEED.4045XLP \DSPFONT.4045)
(* * Stream manipulation functions)
(FNS BEGINPAGE.4045XLP ENDPAGE.4045XLP NEWPAGE.4045XLP NEWLINE.4045XLP SETXY.4045XLP
\MOVETO.4045XLP \BOLDMODE.4045XLP \MEDIUMMODE.4045XLP \FIXLINELENGTH.4045XLP
\CHARWIDTH.4045XLP \STRINGWIDTH.4045XLP)
(* * Misc. stream functions)
(FNS CreateImageData.4045XLP FixMargins.4045XLP 4045XLP.Error 4045XLPPageNumber
4045XLPIn2700ModeP \SEND4045XLPCOMMAND MakePosition.4045XLP 4045XLP.SCALEBRUSH
Landscape.4045XLP SendFileHeading.4045XLP 4045XLPHeading)
(* * Bitmap Functions)
(FNS 4045XLP.EncodedSixelofBitmap \BLTSHADE.4045XLP \4045XLP.ROUND.BITMAP
\SCALEDBITBLT.4045XLP \GENERICBITBLT.4045XLP \BITBLT.4045XLP \BLACKBOX.4045XLP
\WINDOWCMD.4045XLP)
(* Page bitmap fns)
(FNS 4045XLP.RESET 4045XLP.GETBMSTR 4045XLP.GET.BITMAP 4045XLP.RELEASE.BITMAP
\ScaledBltBigBitmap.4045XLP ChangePageBitmap.4045XLP)
(* * Drawing algorithms)
(FNS \DRAWCIRCLE.4045XLP \FILLCIRCLE.4045XLP \DRAWPOLYGON.4045XLP \FILLPOLYGON.4045XLP
\DRAWELLIPSE.4045XLP \DRAWCURVE.4045XLP \DRAWLINE.4045XLP \DRAWLINE1.4045XLP)
(* * Default Printing Code)
(FNS 4045XLPFILEP 4045XLP.BITMAPSCALE 4045XLPPRINT 4045XLPBITMAPFILE 4045XLP.PRINTTEXT
4045XLP.HOSTNAMEP 4045XLP.CHECK.OUTPUTFILE 4045XLP.PRINTHEADERPAGE
4045XLP.PRINT.ERRORPAGE 4045XLP.PROMPT)
(* * Port initializing and parameter setting code)
(FNS 4045XLP.HELP.GET.PORT 4045XLP.GET.PORT 4045XLP.RELEASE.PORT 4045XLP.INIT.PORT
4045XLP.INIT.RS232 4045XLP.INIT.TTY 4045XLP.INIT.CENTRONICS 4045XLP.SET.PARAMETERS
4045XLP.GET.PARAMETERS)
(* * SYSTEM PATCHES * *)
(* patch to FONT to fix the unparsing of otherfds in a font class. Without the patch, the
fontclass would be built without having a size for the otherfds font which causes breaks
hardcopying and reading the files.)
(FNS FONTCLASSUNPARSE)
(* Patch to tedit.hardcopy to make it work with imagetypes other than press and interpress)
(FNS TEDIT.HARDCOPY)
(* * Records)
(RECORDS 4045XLP.PARAMETERS)
(DECLARE: EVAL@LOAD DONTCOPY (RECORDS SIXEL 4045XLPDATA 4045XLPBITMAP)
(MACROS \4045XLPBackingStream 4045XLP.HAS.BITMAP 4045XLPPage 4045XLPGetErrors
4045XLPLandscapeP 4045XLP.HEADING))
(INITRECORDS 4045XLPDATA SIXEL 4045XLPBITMAP)
(* * Variables and initialization)
(* The NSTO4045Cxxx arrays contain the mappings from the charset specified by xxx to the
(one)
charset of 4045.0 C0 allows charcodes <32 for special commands ie. esc's and LF's etc.)
(VARS \ASCIITOASCII \NSTO4045NULL \NSTO4045C41 \NSTO4045C357 \NSTO4045C356 \NSTO4045C361
\NSTO4045C46 \NSTO4045C0 \4045WIDTHSARRAY (LINESPERPAGE 57))
(INITVARS (4045XLP.MONITOR (CREATE.MONITORLOCK (QUOTE 4045XLP)))
(\4045XLP.BITMAPREC)
(4045XLP.DEFAULTS))
[ADDVARS [PRINTERTYPES ((4045XLP)
(CANPRINT (4045XLP))
(STATUS TRUE)
(SEND 4045XLPPRINT)
(HOSTNAMEP 4045XLP.HOSTNAMEP)
(BITMAPSCALE 4045XLP.BITMAPSCALE)
(BITMAPFILE (4045XLPBITMAPFILE FILE BITMAP SCALEFACTOR REGION
ROTATION TITLE]
(PRINTFILETYPES (4045XLP (TEST 4045XLPFILEP)
(EXTENSION (4045XLP))
(CONVERSION (TEXT 4045XLP.PRINTTEXT TEDIT
[LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY
FILE PFILE T NIL NIL NIL
(QUOTE 4045XLP))
(CLOSEF? FILE)
PFILE]
TEDIT \TEDIT.HARDCOPY]
(* * Initializing stuff)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS [4045XLPFileHeading (CONCAT (CHARACTER
(CHARCODE ESC))
"+P"
(CHARACTER
(CHARCODE LF))
(CHARACTER
(CHARCODE ESC))
"+P"
(CHARACTER
(CHARCODE LF))
(CHARACTER
(CHARCODE ESC))
"+X"
(CHARACTER
(CHARCODE LF]
(4045XLPDefaultScale (FQUOTIENT 300 72))
(4045XLPDefaultSpaceFactor 1)
(4045XLPDefaultRegionBottom 100)
(4045XLPDefaultXPosition 0)
(4045XLPDefaultYPosition 0)
(4045XLPDefaultRegionLeft 150)
(4045XLPDefaultPageWidth 2550)
(4045XLPDefaultPageHeight 3300)
(4045XLPDefaultLineFeedHeight 51)
(4045XLPLandscapePageBMRaster 102)
(4045XLPLandscapePageBMWidth 1632)
(4045XLPLandscapePageBMHeight 1275)
(4045XLPDefaultLandscapeCharsPerLine 150)
(4045XLPDefaultLandscapeTop 2400)
(4045XLPDefaultLandscapeRight 3150)
(4045XLPLandscapeHeading 2450)
(4045XLPDefaultLandscapeRegion (CREATEREGION
0 0 3300 2550))
(4045XLPDefaultLandscapeFontHeight 39)
(4045XLPDefaultLandscapeFontAscent 31)
(4045XLPDefaultLandscapeFontDescent 8)
(4045XLPDefaultLandscapeFontBox 22)
(4045XLPDefaultLandscapeFontDX 4)
(4045XLPDefaultLandscapeFontWidths
(ARRAY 256 (QUOTE WORD)
22 0))
(4045XLPPortraitHeading 3150)
(4045XLPPortraitPageBMRaster 80)
(4045XLPPortraitPageBMWidth 1272)
(4045XLPPortraitPageBMHeight 1650)
(4045XLPDefaultPortraitCharsPerLine 115)
(4045XLPDefaultPortraitTop 3000)
(4045XLPDefaultPortraitRight 2400)
(4045XLPDefaultPortraitRegion (CREATEREGION 0 0
2550
3300))
(4045XLPDefaultPortraitFontHeight 50)
(4045XLPDefaultPortraitFontAscent 40)
(4045XLPDefaultPortraitFontDescent 10)
(4045XLPDefaultPortraitFontBox 32)
(4045XLPDefaultPortraitFontDX 4)
(4045XLPDefaultPortraitFontWidths
(ARRAY 256 (QUOTE WORD)
30 0))
(4045XLPPageBitmapPages 516)
(4045XLP.DOTSPERPOINT (FQUOTIENT 300 72))
4045XLP.DOTSPERMICA))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\4045XLPINIT)
(push DEFAULTPRINTINGHOST (QUOTE 4045XLP))
(SETQ DEFAULTPRINTERTYPE (QUOTE 4045XLP])
(RPAQQ 4045XLPSTREAM.VERSION 1.4)
(* * Main stream functions)
(DEFINEQ
(\4045XLPINIT
[LAMBDA NIL (* was: "10-Dec-86 17:24")
(DECLARE (GLOBALVARS \4045XLPIMAGEOPS 4045XLPFDEV IMAGESTREAMTYPES 4045XLP.DEFAULTS
\4045XLP.BITMAPREC))
[SETQ \4045XLPIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE 4045XLP)
IMCLOSEFN ←(FUNCTION \CLOSE4045XLPSTREAM)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.4045XLP)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.4045XLP)
IMFONT ←(FUNCTION \DSPFONT.4045)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.4045XLP)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.4045XLP)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.4045XLP)
IMDRAWLINE ←(FUNCTION \DRAWLINE.4045XLP)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.4045XLP)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.4045XLP)
IMFILLCIRCLE ←(FUNCTION \FILLCIRCLE.4045XLP)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.4045XLP)
IMDRAWPOLYGON ←(FUNCTION \DRAWPOLYGON.4045XLP)
IMFILLPOLYGON ←(FUNCTION \FILLPOLYGON.4045XLP)
IMBLTSHADE ←(FUNCTION \BLTSHADE.4045XLP)
IMBITBLT ←(FUNCTION \BITBLT.4045XLP)
IMMOVETO ←(FUNCTION \MOVETO.4045XLP)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT 300 72]
IMTERPRI ←(FUNCTION NEWLINE.4045XLP)
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.4045XLP)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.4045XLP)
IMFONTCREATE ←(QUOTE 4045XLP)
IMNEWPAGE ←(FUNCTION NEWPAGE.4045XLP)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.4045XLP)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.4045XLP)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.4045XLP)
IMSCALEDBITBLT ←(FUNCTION \SCALEDBITBLT.4045XLP)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.4045XLP)
IMBITMAPSIZE ←(FUNCTION (LAMBDA (STREAM BITMAP DIMENSION)
(SELECTQ DIMENSION
(WIDTH (TIMES 4 (BITMAPWIDTH BITMAP)))
(HEIGHT (TIMES 4 (BITMAPHEIGHT BITMAP)))
[NIL (CONS (TIMES 4 (BITMAPWIDTH BITMAP))
(TIMES 4 (BITMAPHEIGHT BITMAP]
(\ILLEGAL.ARG DIMENSION]
(SETQ 4045XLPFDEV (create FDEV
DEVICENAME ←(LIST (QUOTE 4045XLP)
(QUOTE PRINTER))
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 4045.OUTCHARFN)
PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)))
[push IMAGESTREAMTYPES (QUOTE (4045XLP (OPENSTREAM OPEN4045XLPSTREAM)
(FONTCREATE \CREATE4045FONT)
(FONTSAVAILABLE \SEARCH4045FONTS)
(CREATECHARSET \CREATECHARSET.4045]
(* * Set all the fontclasses up so text printing works ok.)
(SETFONTCLASSCOMPONENT DEFAULTFONT (QUOTE 4045XLP)
(QUOTE (TITAN 10 MRR)))
(SETFONTCLASSCOMPONENT BOLDFONT (QUOTE 4045XLP)
(QUOTE (TITAN 10 BRR)))
(SETFONTCLASSCOMPONENT BIGFONT (QUOTE 4045XLP)
(QUOTE (TITAN 12 BRR)))
(SETFONTCLASSCOMPONENT LITTLEFONT (QUOTE 4045XLP)
(QUOTE (TITAN 8 BRR)))
(SETFONTCLASSCOMPONENT FONT5 (QUOTE 4045XLP)
(QUOTE (TITAN 10 MRR)))
(SETFONTCLASSCOMPONENT FONT6 (QUOTE 4045XLP)
(QUOTE (TITAN 10 MRR)))
(SETFONTCLASSCOMPONENT FONT7 (QUOTE 4045XLP)
(QUOTE (TITAN 10 MRR)))
(* * create the default initialization codes for using the stream)
(COND
(4045XLP.DEFAULTS)
(T (SETQ 4045XLP.DEFAULTS (create 4045XLP.PARAMETERS
PORT ←(QUOTE {RS232})
LANGUAGE ← 2700
SLUG ← NIL
MESSAGESTREAM ← PROMPTWINDOW
PRINTERRORS ← NIL
PRINTHEADER ← NIL
WINDOWTITLE ← NIL
LANDSCAPE ← NIL))
(4045XLP.HELP.GET.PORT)))
(* * make SURE you only do this once!!!)
[COND
(\4045XLP.BITMAPREC)
(T (SETQ \4045XLP.BITMAPREC (create 4045XLPBITMAP
BITMAPDIRTY ← NIL
MONITOR ←(CREATE.MONITORLOCK)
BITMAP ←(create BITMAP
BITMAPBASE ←(\ALLOCPAGEBLOCK
4045XLPPageBitmapPages)
BITMAPRASTERWIDTH ←
4045XLPPortraitPageBMRaster
BITMAPWIDTH ←
4045XLPPortraitPageBMWidth
BITMAPHEIGHT ←
4045XLPPortraitPageBMHeight]
NIL])
(OPEN4045XLPSTREAM
[LAMBDA (4045XLPFILE OPTIONS) (* was: "10-Dec-86 08:29")
(* * Opens a 4045XLP stream, to which user can perform DIG operations)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS \4045XLPIMAGEOPS 4045XLPFDEV))
(LET* [(LandscapeP (COND
((AND (NOT (LISTGET OPTIONS (QUOTE PORTRAIT)))
(OR (LISTGET OPTIONS (QUOTE LANDSCAPE))
(ffetch (4045XLP.PARAMETERS LANDSCAPE) of 4045XLP.DEFAULTS)
))
T)
(T NIL)))
[4045XLPDEFAULTFONT (COND
(LandscapeP (FONTCREATE (QUOTE TITAN)
10
(QUOTE MRR)
90
(QUOTE 4045XLP)))
(T (FONTCREATE (QUOTE TITAN)
10
(QUOTE MRR)
0
(QUOTE 4045XLP]
(4045XLPSTREAM (create STREAM
DEVICE ← 4045XLPFDEV
ACCESS ←(QUOTE OUTPUT)
USERCLOSEABLE ← T
OUTCHARFN ←(FUNCTION 4045.OUTCHARFN)
IMAGEOPS ← \4045XLPIMAGEOPS
IMAGEDATA ←(CreateImageData.4045XLP LandscapeP)
F1 ←[OPENSTREAM 4045XLPFILE (QUOTE OUTPUT)
NIL
(QUOTE ((TYPE BINARY]
F5 ← NIL
LINELENGTH ←(COND
(LandscapeP 4045XLPDefaultLandscapeCharsPerLine)
(T 4045XLPDefaultPortraitCharsPerLine]
(* Set the fullfilename up correctly)
(replace FULLFILENAME of 4045XLPSTREAM with (FULLNAME (\4045XLPBackingStream
4045XLPSTREAM)))
(* * send the header string so we know it's a 4045xlp file to the file)
(SendFileHeading.4045XLP (\4045XLPBackingStream 4045XLPSTREAM))
(* Set up the stream properties correctly)
(4045XLP.Error (QUOTE CLEAR)
4045XLPSTREAM)
(4045XLPPageNumber 0 4045XLPSTREAM)
[4045XLPHeading 4045XLPSTREAM (COND
[(EQ (LISTGET OPTIONS (QUOTE HEADING))
T)
(CONCAT (OR (LISTGET OPTIONS (QUOTE DOCUMENT.NAME))
(FULLNAME 4045XLPFILE))
" "
(GETFILEINFO 4045XLPFILE (QUOTE CREATIONDATE]
(T (LISTGET OPTIONS (QUOTE HEADING]
(* Set the stream mode (default is 2700))
(STREAMPROP 4045XLPSTREAM (QUOTE 2700MODE)
(EQ (OR (LISTGET OPTIONS (QUOTE MODE))
(ffetch (4045XLP.PARAMETERS LANGUAGE) of 4045XLP.DEFAULTS))
2700)) (* Make sure the stream gets positioned and set up
correctly)
(FixMargins.4045XLP 4045XLPSTREAM LandscapeP (4045XLPIn2700ModeP 4045XLPSTREAM))
[COND
(LandscapeP (Landscape.4045XLP 4045XLPSTREAM (4045XLPIn2700ModeP 4045XLPSTREAM]
(DSPFONT 4045XLPDEFAULTFONT 4045XLPSTREAM)
(DSPLINEFEED (FONTPROP 4045XLPDEFAULTFONT (QUOTE HEIGHT))
4045XLPSTREAM)
(BEGINPAGE.4045XLP 4045XLPSTREAM)
(\MEDIUMMODE.4045XLP 4045XLPSTREAM)
4045XLPSTREAM])
(\CLOSE4045XLPSTREAM
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 14:17")
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(ENDPAGE.4045XLP 4045XLPSTREAM)
(AND (ffetch (4045XLP.PARAMETERS PRINTERRORS) of 4045XLP.DEFAULTS)
(4045XLP.PRINT.ERRORPAGE 4045XLPSTREAM)
(ENDPAGE.4045XLP 4045XLPSTREAM))
(\SEND4045XLPCOMMAND "+X" (\4045XLPBackingStream 4045XLPSTREAM))
(CLOSEF (\4045XLPBackingStream 4045XLPSTREAM))
4045XLPSTREAM])
(4045.OUTCHARFN
[LAMBDA (4045XLPSTREAM CHARCODE) (* was: " 8-Dec-86 14:18")
(* * Send out a character to the stream. outcharfn1 is the ns-4045 translator and code that does the actual
character output.)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
NSCODE)
[SETQ NSCODE (COND
((\FATCHARCODEP CHARCODE)
CHARCODE)
(T (\GETBASE (ffetch 4045XLPNSTRANSTABLE of 4045XLPDATA)
CHARCODE] (* Select on NSCODE.)
(SELCHARQ NSCODE
(↑F)
(EOL (NEWLINE.4045XLP 4045XLPSTREAM))
[LF (\DSPXPOSITION.4045XLP 4045XLPSTREAM (PROG1 (\DSPXPOSITION.4045XLP
4045XLPSTREAM)
(NEWLINE.4045XLP
4045XLPSTREAM]
(↑L (NEWPAGE.4045XLP 4045XLPSTREAM))
(4045.OUTCHARFN1 NSCODE 4045XLPSTREAM 4045XLPDATA])
(4045.OUTCHARFN1
[LAMBDA (NSCODE 4045XLPSTREAM 4045XLPDATA) (* was: " 5-Dec-86 17:18")
(* * this is a printable character, so translate the ns code into a code that the 4045 can handle.)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(LET ((BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(SLUG (NUMBERP (ffetch (4045XLP.PARAMETERS SLUG) of 4045XLP.DEFAULTS)))
(CLIPPINGREGION (ffetch (4045XLPDATA 4045XLPCLIPPINGREGION) of 4045XLPDATA))
NEWXPOS YPOS TRANSCODE) (* first change the charset of the stream to pick the
right translation block)
[COND
((NEQ (\CHARSET NSCODE)
(ffetch (4045XLPDATA 4045XLPCHARSET) of 4045XLPDATA))
(\CHANGECHARSET.4045XLP 4045XLPDATA (\CHARSET NSCODE]
(* now translate the charcode from NS to a 4045
recognizable charcode)
(SETQ TRANSCODE (\GETBASE (ffetch (4045XLPDATA 4045XLPCSTRANSTABLE) of 4045XLPDATA)
(\CHAR8CODE NSCODE)))
[COND
((EQ TRANSCODE 255)
(* The character has translated to a slug, see if the user wants to save the printing errors, and also if he has
redefined the slug character.)
(AND (ffetch (4045XLP.PARAMETERS PRINTERRORS) of 4045XLP.DEFAULTS)
(4045XLP.Error NSCODE 4045XLPSTREAM))
(AND SLUG (SETQ TRANSCODE SLUG] (* Increment the xposition the correct ammount)
[SETQ NEWXPOS (add (ffetch (4045XLPDATA 4045XLPXPOS) of 4045XLPDATA)
(SELCHARQ (\CHAR8CODE TRANSCODE)
(SPACE (ffetch (4045XLPDATA 4045XLPSPACEWIDTH)
of 4045XLPDATA))
(\FGETWIDTH (ffetch (4045XLPDATA 4045XLPWIDTHSCACHE)
of 4045XLPDATA)
(\CHAR8CODE TRANSCODE]
(if (IGREATERP NEWXPOS (ffetch (4045XLPDATA 4045XLPRIGHT) of 4045XLPDATA))
then (NEWLINE.4045XLP 4045XLPSTREAM))
(SETQ YPOS (ffetch (4045XLPDATA 4045XLPYPOS) of 4045XLPDATA))
(if (AND (ILESSP NEWXPOS (ffetch (REGION RIGHT) of CLIPPINGREGION))
(IGREATERP NEWXPOS (ffetch (REGION LEFT) of CLIPPINGREGION))
(ILESSP YPOS (ffetch (REGION TOP) of CLIPPINGREGION))
(IGREATERP YPOS (ffetch (REGION BOTTOM) of CLIPPINGREGION)))
then (* within the clipping region, so reset the character
position)
(freplace (STREAM CHARPOSITION) of 4045XLPSTREAM
with (ADD1 (ffetch (STREAM CHARPOSITION) of 4045XLPSTREAM)))
(* accented characters have their accent character
codes stored as the charset of the character.)
(AND (NOT (ZEROP (\CHARSET TRANSCODE)))
(BOUT BACKINGSTREAM (\CHARSET TRANSCODE)))
(BOUT BACKINGSTREAM (\CHAR8CODE TRANSCODE])
)
(* * Font methods)
(DEFINEQ
(\CREATE4045FONT
[LAMBDA (FAMILY SIZE FONTFACE ROTATION DEVICE) (* was: " 8-Dec-86 16:16")
(* Creates a font descriptor for a 4045 font for hardcopy. Doesn't matter what font we are trying to create, will
always create this descriptor, but with different names.)
(DECLARE (GLOBALVARS \ASCIITONS \4045WIDTHSARRAY))
(LET (CSINFO FD)
[COND
[(FMEMB ROTATION (QUOTE (90 270)))
(SETQ FD
(create FONTDESCRIPTOR
FONTDEVICE ← DEVICE
FONTFAMILY ← FAMILY
FONTSIZE ← SIZE
FONTFACE ← FONTFACE
\SFFACECODE ←(\FACECODE FONTFACE)
ROTATION ← ROTATION
OTHERDEVICEFONTPROPS ←(ffetch (ARRAYP BASE) of \ASCIITONS)
FONTSCALE ← 4045XLPDefaultScale
FBBOX ← 4045XLPDefaultLandscapeFontBox
\SFDescent ← 4045XLPDefaultLandscapeFontDescent
FBBDX ← 4045XLPDefaultLandscapeFontDX
\SFHeight ← 4045XLPDefaultLandscapeFontHeight
\SFAscent ← 4045XLPDefaultLandscapeFontAscent
FIRSTCHAR ← 32
LASTCHAR ← 255
\SFWidths ← 4045XLPDefaultLandscapeFontWidths))
(SETQ CSINFO (create CHARSETINFO
CHARSETASCENT ← 4045XLPDefaultLandscapeFontAscent
CHARSETDESCENT ← 4045XLPDefaultLandscapeFontDescent
WIDTHS ←(ffetch (ARRAYP BASE) of
4045XLPDefaultLandscapeFontWidths]
(T (SETQ CSINFO (create CHARSETINFO
CHARSETASCENT ← 40
CHARSETDESCENT ← 10
WIDTHS ←(ffetch (ARRAYP BASE) of
4045XLPDefaultPortraitFontWidths)))
(SETQ FD
(create FONTDESCRIPTOR
FONTDEVICE ← DEVICE
FONTFAMILY ← FAMILY
FONTSIZE ← SIZE
FONTFACE ← FONTFACE
\SFFACECODE ←(\FACECODE FONTFACE)
ROTATION ← ROTATION
OTHERDEVICEFONTPROPS ←(ffetch (ARRAYP BASE) of \ASCIITONS)
FONTSCALE ← 4045XLPDefaultScale
FBBOX ← 4045XLPDefaultPortraitFontBox
\SFDescent ← 4045XLPDefaultPortraitFontDescent
FBBDX ← 4
\SFHeight ← 4045XLPDefaultPortraitFontHeight
\SFAscent ← 4045XLPDefaultPortraitFontAscent
FIRSTCHAR ← 32
LASTCHAR ← 255
\SFWidths ← 4045XLPDefaultPortraitFontWidths]
(\RPLPTR (ffetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FD)
0 CSINFO)
FD])
(\CREATECHARSET.4045
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET) (* was: " 8-Dec-86 14:20")
(* * Build the CHARSETINFO for a 4045 font.)
(LET (CSINFO)
(COND
((FMEMB ROTATION (QUOTE (90 270)))
(SETQ CSINFO (create CHARSETINFO
WIDTHS ←(ffetch (ARRAYP BASE) of
4045XLPDefaultLandscapeFontWidths)
CHARSETASCENT ← 4045XLPDefaultLandscapeFontAscent
CHARSETDESCENT ← 4045XLPDefaultLandscapeFontDescent)))
(T (create CHARSETINFO
WIDTHS ←(ffetch (ARRAYP BASE) of 4045XLPDefaultPortraitFontWidths)
CHARSETASCENT ← 4045XLPDefaultPortraitFontAscent
CHARSETDESCENT ← 4045XLPDefaultPortraitFontDescent)))
CSINFO])
(\SEARCH4045FONTS
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE) (* was: " 4-Nov-86 12:48")
(* * returns a list of the form (family size face rotation 4045xlp) for any font matching the specs.
* is used as wildcard.)
(DECLARE (GLOBALVARS DISPLAYFONTDIRECTORIES))
(bind FONTSFOUND THISFONT (FILENAMEPATTERN ←(\FONTFILENAME FAMILY PSIZE FACE)) for DIR
inside DISPLAYFONTDIRECTORIES do [for FONTFILE in (DIRECTORY (PACKFILENAME
(QUOTE DIRECTORY)
DIR
(QUOTE BODY)
FILENAMEPATTERN))
when [PROGN (SETQ THISFONT (
\FONTINFOFROMFILENAME FONTFILE
DEVICE))
(AND (OR (EQ FAMILY
(QUOTE *))
(EQ FAMILY
(CAR THISFONT)))
(OR (EQ PSIZE (QUOTE
*))
(EQ PSIZE (CADR
THISFONT)))
(OR (EQ FACE (QUOTE
*))
(EQUAL FACE
(CADDR
THISFONT]
do (* make sure the file is appropriate e.g. the
directory pattern for CLASSIC if SIZE is * will match
CLASSICTHIN10 as well.)
(OR (MEMBER THISFONT FONTSFOUND)
(SETQ FONTSFOUND (CONS THISFONT
FONTSFOUND]
finally (RETURN FONTSFOUND])
(\CHANGECHARSET.4045XLP
[LAMBDA (4045XLPDATA CHARSET) (* was: " 8-Dec-86 14:48")
(DECLARE (GLOBALVARS \NSTO4045NULL \NSTO4045C357 \NSTO4045C356 \NSTO4045C46 \NSTO4045C41
\NSTO4045C0 \NSTO4045C361))
(PROG (TRANSTABLE) (* change the transtable for different charsets.
the widths are loaded only once.)
(SETQ TRANSTABLE (SELECTQ CHARSET
(0 \NSTO4045C0)
(33 \NSTO4045C41)
(38 \NSTO4045C46)
(238 \NSTO4045C356)
(239 \NSTO4045C357)
(241 \NSTO4045C361)
\NSTO4045NULL))
(freplace (4045XLPDATA 4045XLPCSTRANSTABLE) of 4045XLPDATA
with (ffetch (ARRAYP BASE) of TRANSTABLE))
(freplace 4045XLPCHARSET of 4045XLPDATA with CHARSET])
)
(* * DSPxx fns)
(DEFINEQ
(\DSPXPOSITION.4045XLP
[LAMBDA (4045XLPSTREAM XPOSITION) (* was: " 8-Dec-86 11:15")
(PROG1 (ffetch (4045XLPDATA 4045XLPXPOS) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)
)
(COND
(XPOSITION (SETXY.4045XLP 4045XLPSTREAM XPOSITION (ffetch (4045XLPDATA 4045XLPYPOS)
of (ffetch (STREAM
IMAGEDATA)
of 4045XLPSTREAM])
(\DSPYPOSITION.4045XLP
[LAMBDA (4045XLPSTREAM YPOSITION) (* was: " 8-Dec-86 11:15")
(PROG1 (ffetch (4045XLPDATA 4045XLPYPOS) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)
)
(COND
(YPOSITION (SETXY.4045XLP 4045XLPSTREAM (ffetch (4045XLPDATA 4045XLPXPOS)
of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM))
YPOSITION])
(\DSPBOTTOMMARGIN.4045XLP
[LAMBDA (4045XLPSTREAM YPOSITION) (* was: " 8-Dec-86 14:58")
(PROG1 (ffetch (4045XLPDATA 4045XLPBOTTOM) of (ffetch (STREAM IMAGEDATA) of
4045XLPSTREAM))
(COND
(YPOSITION (freplace (4045XLPDATA 4045XLPBOTTOM) of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM)
with YPOSITION])
(\DSPTOPMARGIN.4045XLP
[LAMBDA (4045XLPSTREAM YPOSITION) (* was: " 8-Dec-86 14:59")
(PROG1 (ffetch (4045XLPDATA 4045XLPTOP) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
(COND
(YPOSITION (freplace (4045XLPDATA 4045XLPTOP) of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM)
with YPOSITION])
(\DSPLEFTMARGIN.4045XLP
[LAMBDA (4045XLPSTREAM XPOSITION) (* was: " 8-Dec-86 15:00")
(PROG1 (ffetch (4045XLPDATA 4045XLPLEFT) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)
)
(COND
(XPOSITION (freplace (4045XLPDATA 4045XLPLEFT) of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM)
with XPOSITION)
(\FIXLINELENGTH.4045XLP 4045XLPSTREAM])
(\DSPRIGHTMARGIN.4045XLP
[LAMBDA (4045XLPSTREAM XPOSITION) (* was: " 8-Dec-86 15:01")
(PROG1 (ffetch (4045XLPDATA 4045XLPRIGHT) of (ffetch (STREAM IMAGEDATA) of
4045XLPSTREAM))
(COND
(XPOSITION (freplace (4045XLPDATA 4045XLPRIGHT) of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM)
with XPOSITION)
(\FIXLINELENGTH.4045XLP 4045XLPSTREAM])
(\DSPCLIPPINGREGION.4045XLP
[LAMBDA (4045XLPSTREAM REGION) (* was: " 8-Dec-86 15:01")
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)))
(PROG1 (ffetch (4045XLPDATA 4045XLPCLIPPINGREGION) of 4045XLPDATA)
(AND REGION (UNINTERRUPTABLY
(freplace (4045XLPDATA 4045XLPCLIPPINGREGION) of 4045XLPDATA
with REGION))])
(\DSPSPACEFACTOR.4045XLP
[LAMBDA (4045XLPSTREAM FACTOR) (* was: " 8-Dec-86 15:03")
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)))
(PROG1 (ffetch (4045XLPDATA 4045XLPSPACEFACTOR) of 4045XLPDATA)
(COND
(FACTOR [freplace (4045XLPDATA 4045XLPSPACEWIDTH) of 4045XLPDATA
with (FIXR (TIMES FACTOR (\FGETWIDTH (ffetch (4045XLPDATA
4045XLPWIDTHSCACHE)
of 4045XLPDATA)
(CHARCODE SPACE]
(* Doing the multiply first will insure that FACTOR is
a number)
(freplace (4045XLPDATA 4045XLPSPACEWIDTH) of 4045XLPDATA
with FACTOR])
(\DSPLINEFEED.4045XLP
[LAMBDA (4045XLPSTREAM DELTAY) (* was: " 8-Dec-86 15:03")
(* sets the amount that a line feed increases the y
coordinate by.)
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)))
(PROG1 (ffetch (4045XLPDATA 4045XLPLINEFEED) of 4045XLPDATA)
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace (4045XLPDATA 4045XLPLINEFEED) of 4045XLPDATA with DELTAY)
)
(T (\ILLEGAL.ARG DELTAY])
(\DSPFONT.4045
[LAMBDA (4045XLPSTREAM FONT) (* was: " 8-Dec-86 16:17")
(* Change fonts (or return the current font) for a
4045XLP stream)
(DECLARE (GLOBALVARS \ASCIITONS \DEFAULTCHARSET))
(PROG ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
(Landscape (4045XLPLandscapeP 4045XLPSTREAM))
OLDFONT)
(SETQ OLDFONT (ffetch (4045XLPDATA 4045XLPFONT) of 4045XLPDATA))
(AND (NULL FONT)
(RETURN OLDFONT))
(COND
([EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT (QUOTE 4045XLP))
(FONTCOPY OLDFONT FONT]
(* There was no change, or they were only asking for
the old font. Just return it.)
(RETURN OLDFONT))) (* Remember the new font, first checking to be sure
the rotation is correct)
[COND
(Landscape (AND [NOT (FMEMB (FONTPROP FONT (QUOTE ROTATION))
(QUOTE (90 270]
(FONTCOPY FONT (QUOTE ROTATION)
90)))
(T (AND (NOT (EQ (FONTPROP FONT (QUOTE ROTATION))
0))
(FONTCOPY FONT (QUOTE ROTATION)
0]
(freplace (4045XLPDATA 4045XLPFONT) of 4045XLPDATA with FONT)
[freplace (4045XLPDATA 4045XLPWIDTHSCACHE) of 4045XLPDATA
with (ffetch (ARRAYP BASE) of (COND
(Landscape 4045XLPDefaultLandscapeFontWidths)
(T 4045XLPDefaultPortraitFontWidths]
[freplace (4045XLPDATA 4045XLPSPACEWIDTH) of 4045XLPDATA
with (FIXR (TIMES (ffetch (4045XLPDATA 4045XLPSPACEFACTOR) of 4045XLPDATA)
(\FGETWIDTH (ffetch (4045XLPDATA 4045XLPWIDTHSCACHE)
of 4045XLPDATA)
(CHARCODE SPACE]
(freplace (4045XLPDATA 4045XLPNSTRANSTABLE) of 4045XLPDATA
with (ffetch (ARRAYP BASE) of \ASCIITONS))
(\CHANGECHARSET.4045XLP 4045XLPDATA \DEFAULTCHARSET)
(SELECTQ (FONTPROP FONT (QUOTE WEIGHT))
(BOLD (if (NEQ (FONTPROP OLDFONT (QUOTE WEIGHT))
(QUOTE BOLD))
then (\BOLDMODE.4045XLP 4045XLPSTREAM)))
(if (EQ (FONTPROP OLDFONT (QUOTE WEIGHT))
(QUOTE BOLD))
then (\MEDIUMMODE.4045XLP 4045XLPSTREAM)))
(\FIXLINELENGTH.4045XLP 4045XLPSTREAM)
(RETURN OLDFONT])
)
(* * Stream manipulation functions)
(DEFINEQ
(BEGINPAGE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:07")
(* Start up a new page on the stream.
Make sure to change the pagenumber and charpos too!)
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
(PageNum (4045XLPPageNumber (ADD1 (4045XLPPageNumber NIL 4045XLPSTREAM))
4045XLPSTREAM))) (* change the charposition to reflect the new page.)
(freplace (STREAM CHARPOSITION) of 4045XLPSTREAM with 0)
(4045XLPHeading 4045XLPSTREAM NIL PageNum)
[SETXY.4045XLP 4045XLPSTREAM (ffetch (4045XLPDATA 4045XLPLEFT) of 4045XLPDATA)
(DIFFERENCE (ffetch (4045XLPDATA 4045XLPTOP) of 4045XLPDATA)
(FONTASCENT (ffetch (4045XLPDATA 4045XLPFONT)
of 4045XLPDATA]
NIL])
(ENDPAGE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: "10-Nov-86 08:48")
(* * Ends a page on the 4045xlpstream)
(DECLARE (GLOBALVARS \4045XLP.BITMAPREC))
(LET* ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
(4045XLPBITMAP (ffetch (4045XLPBITMAP BITMAP) of \4045XLP.BITMAPREC)))
(COND
((4045XLP.HAS.BITMAP 4045XLPDATA) (* we wrote on the bitmap, so now print it)
(4045XLP.PROMPT "Formatting the drawing ...")
(\ScaledBltBigBitmap.4045XLP 4045XLPBITMAP 0 0 4045XLPSTREAM 0 0 2)
(4045XLP.RELEASE.BITMAP 4045XLPDATA)))
(BOUT (\4045XLPBackingStream 4045XLPSTREAM)
(CHARCODE FF))
(FORCEOUTPUT (\4045XLPBackingStream 4045XLPSTREAM)
T])
(NEWPAGE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:08")
(ENDPAGE.4045XLP 4045XLPSTREAM)
(BEGINPAGE.4045XLP 4045XLPSTREAM])
(NEWLINE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:08")
(* Do a newline on the page, and if you have to start
on a new page. Don't forget to reset the charposition)
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
NEWYPOS)
(SETQ NEWYPOS (IDIFFERENCE (ffetch (4045XLPDATA 4045XLPYPOS) of 4045XLPDATA)
(ffetch (4045XLPDATA 4045XLPLINEFEED) of 4045XLPDATA)))
(COND
((ILESSP NEWYPOS (ffetch (4045XLPDATA 4045XLPBOTTOM) of 4045XLPDATA))
(NEWPAGE.4045XLP 4045XLPSTREAM))
(T (SETXY.4045XLP 4045XLPSTREAM (ffetch (4045XLPDATA 4045XLPLEFT) of 4045XLPDATA)
NEWYPOS)))
(freplace (STREAM CHARPOSITION) of 4045XLPSTREAM with 0])
(SETXY.4045XLP
[LAMBDA (4045XLPSTREAM X Y) (* was: " 9-Dec-86 15:42")
(* Move to (X,Y) on the page.)
(freplace (4045XLPDATA 4045XLPXPOS) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)
with X)
(freplace (4045XLPDATA 4045XLPYPOS) of (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)
with Y)
[COND
[(4045XLPIn2700ModeP 4045XLPSTREAM)
(COND
((4045XLPLandscapeP 4045XLPSTREAM)
(\SEND4045XLPCOMMAND (CONCAT "a" (IDIFFERENCE 4045XLPDefaultPageWidth
(IPLUS Y
4045XLPDefaultLandscapeFontHeight))
","
(FIXR X))
(\4045XLPBackingStream 4045XLPSTREAM)))
(T (\SEND4045XLPCOMMAND (CONCAT "a" (FIXR X)
","
(FIXR Y))
(\4045XLPBackingStream 4045XLPSTREAM]
(T (COND
((4045XLPLandscapeP 4045XLPSTREAM)
(\SEND4045XLPCOMMAND (CONCAT "p" (FIXR X)
","
(IDIFFERENCE 4045XLPDefaultPageWidth Y))
(\4045XLPBackingStream 4045XLPSTREAM)))
(T (\SEND4045XLPCOMMAND (CONCAT "p" (FIXR X)
","
(IDIFFERENCE 4045XLPDefaultPageHeight Y))
(\4045XLPBackingStream 4045XLPSTREAM]
NIL])
(\MOVETO.4045XLP
[LAMBDA (4045XLPSTREAM X Y) (* was: " 1-Dec-86 10:32")
(SETXY.4045XLP 4045XLPSTREAM X Y])
(\BOLDMODE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:42")
(* * turn on bold mode)
(\SEND4045XLPCOMMAND (COND
((4045XLPIn2700ModeP 4045XLPSTREAM)
"b")
(T "W"))
(\4045XLPBackingStream 4045XLPSTREAM)
T])
(\MEDIUMMODE.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:15")
(* * turn off bold mode)
(\SEND4045XLPCOMMAND (COND
((4045XLPIn2700ModeP 4045XLPSTREAM)
"p")
(T "&"))
(\4045XLPBackingStream 4045XLPSTREAM)
T])
(\FIXLINELENGTH.4045XLP
[LAMBDA (4045XLPSTREAM) (* was: " 8-Dec-86 15:17")
(* 4045XLPSTREAM is known to be a stream of type 4045XLP -
Called by RIGHTMARGIN LEFTMARGIN and \SFFIXFONT to update the LINELENGTH field in the stream.
also called when the stream is created.)
(LET (LLEN (4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)))
(freplace (STREAM LINELENGTH) of 4045XLPSTREAM
with (COND
((IGREATERP [SETQ LLEN (IQUOTIENT (IDIFFERENCE (ffetch (4045XLPDATA
4045XLPRIGHT)
of 4045XLPDATA)
(ffetch (4045XLPDATA
4045XLPLEFT)
of 4045XLPDATA))
(ffetch (FONTDESCRIPTOR
FONTAVGCHARWIDTH)
of (ffetch (4045XLPDATA
4045XLPFONT)
of 4045XLPDATA]
1)
LLEN)
(T 10])
(\CHARWIDTH.4045XLP
[LAMBDA (4045XLPSTREAM CHARCODE) (* was: " 8-Dec-86 15:18")
(* * Gets the width of CHARCODE in a 4045XLP stream, observing spacefactor)
(COND
((EQ CHARCODE (CHARCODE SPACE))
(ffetch (4045XLPDATA 4045XLPSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) of
4045XLPSTREAM)))
(T (\FGETCHARWIDTH (ffetch (4045XLPDATA 4045XLPFONT) of (ffetch (STREAM IMAGEDATA)
of 4045XLPSTREAM))
CHARCODE])
(\STRINGWIDTH.4045XLP
[LAMBDA (4045XLPSTREAM STRING RDTBL) (* was: " 8-Dec-86 15:20")
(* Returns the width of STRING in the interpress
STREAM, observing spacefactor)
(\STRINGWIDTH.GENERIC STRING (ffetch (4045XLPDATA 4045XLPFONT) of (ffetch (STREAM
IMAGEDATA)
of 4045XLPSTREAM))
RDTBL
(ffetch (4045XLPDATA 4045XLPSPACEWIDTH) of (ffetch (STREAM
IMAGEDATA)
of 4045XLPSTREAM])
)
(* * Misc. stream functions)
(DEFINEQ
(CreateImageData.4045XLP
[LAMBDA (LANDSCAPE) (* was: " 2-Dec-86 10:31")
(* * Creates the imagedata for 4045)
(COND
(LANDSCAPE (create 4045XLPDATA
4045XLPTOP ← 4045XLPDefaultLandscapeTop
4045XLPRIGHT ← 4045XLPDefaultLandscapeRight
4045XLPCLIPPINGREGION ← 4045XLPDefaultLandscapeRegion))
(T (create 4045XLPDATA
4045XLPTOP ← 4045XLPDefaultPortraitTop
4045XLPRIGHT ← 4045XLPDefaultPortraitRight
4045XLPCLIPPINGREGION ← 4045XLPDefaultPortraitRegion])
(FixMargins.4045XLP
[LAMBDA (4045XLPSTREAM LandscapeP 2700ModeP) (* was: " 8-Dec-86 15:21")
(* * Corrects for improper margins in 2700 mode by setting the margins to 0)
(COND
(2700ModeP (\SEND4045XLPCOMMAND (COND
(LandscapeP (CONCAT "m" 4045XLPDefaultPageWidth "," 0 ","
0 "," 0 "," 4045XLPDefaultPageHeight))
(T (CONCAT "m" 4045XLPDefaultPageHeight "," 0 "," 0 "," 0
","
4045XLPDefaultPageWidth)))
(\4045XLPBackingStream 4045XLPSTREAM])
(4045XLP.Error
[LAMBDA (ERRCODE 4045XLPSTREAM) (* was: " 6-Nov-86 08:07")
(* Currently, the Errorlist is stored on the F2 Property of the stream CLEAR as an errcode will clear the list NIL
will return the list)
(COND
((EQ ERRCODE (QUOTE CLEAR)) (* Clear all errors)
(change (4045XLPGetErrors 4045XLPSTREAM)
NIL))
((NULL ERRCODE)
(4045XLPGetErrors 4045XLPSTREAM))
(T (change (4045XLPGetErrors 4045XLPSTREAM)
(APPEND (4045XLPGetErrors 4045XLPSTREAM)
(LIST (CONS (4045XLPPageNumber NIL 4045XLPSTREAM)
ERRCODE])
(4045XLPPageNumber
[LAMBDA (Number 4045XLPSTREAM) (* was: " 6-Nov-86 08:01")
(* If a number is given, the page number is changed
otherwise, it is returned.)
(COND
(Number (change (4045XLPPage 4045XLPSTREAM)
Number))
(T (4045XLPPage 4045XLPSTREAM])
(4045XLPIn2700ModeP
[LAMBDA (4045XLPSTREAM) (* was: " 4-Nov-86 08:33")
(* determines if the stream is in 2700 mode or not)
(STREAMPROP 4045XLPSTREAM (QUOTE 2700MODE])
(\SEND4045XLPCOMMAND
[LAMBDA (STRING BACKINGSTREAM NOCR) (* was: " 4-Nov-86 08:47")
(* Since the sequence esc...
is so common, this function will send the esc and also
the ending lf if necessary)
(BOUT BACKINGSTREAM (CHARCODE ESC))
(for C instring STRING do (BOUT BACKINGSTREAM C))
(OR NOCR (BOUT BACKINGSTREAM (CHARCODE LF])
(MakePosition.4045XLP
[LAMBDA (LEFT TOP 2700MODE LANDSCAPE) (* was: " 4-Dec-86 16:57")
(LET [(XPOS (COND
(2700MODE (COND
(LANDSCAPE (IDIFFERENCE 4045XLPDefaultPageWidth TOP))
(T LEFT)))
(T LEFT)))
(YPOS (COND
(2700MODE (COND
(LANDSCAPE LEFT)
(T TOP)))
(T (COND
(LANDSCAPE (IDIFFERENCE 4045XLPDefaultPageWidth TOP))
(T (IDIFFERENCE 4045XLPDefaultPageHeight TOP]
(CONCAT XPOS "," YPOS])
(4045XLP.SCALEBRUSH
[LAMBDA (BRUSH) (* was: "10-Nov-86 16:24")
(* scales the brush for use on the 4045 bitmap ie.
by half)
(COND
[(LISTP BRUSH)
(LIST (CAR BRUSH)
(COND
((IGREATERP (CADR BRUSH)
3)
(* This is a strange algorithm mainly for sketch correction. Sketch produces brushes for a full 4045 page, but the
actual drawing page is only half size.)
(IMAX (IQUOTIENT (SUB1 (CADR BRUSH))
2)
2))
((EQ BRUSH 2)
2)
(T 1]
(T (LIST (QUOTE ROUND)
(COND
((IGREATERP BRUSH 3)
(IMAX (IQUOTIENT (SUB1 BRUSH)
2)
2))
((EQ BRUSH 2)
2)
(T 1])
(Landscape.4045XLP
[LAMBDA (4045XLPSTREAM 2700MODE?) (* was: " 8-Dec-86 15:43")
(LET ((BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM)))
(\SEND4045XLPCOMMAND "+9XCP14iso-L" BACKINGSTREAM)
(COND
(2700MODE? (\SEND4045XLPCOMMAND "9" BACKINGSTREAM T))
(T (\SEND4045XLPCOMMAND "F9" BACKINGSTREAM T)))
(FORCEOUTPUT BACKINGSTREAM T)
(change (4045XLPLandscapeP 4045XLPSTREAM)
T])
(SendFileHeading.4045XLP
[LAMBDA (BACKINGSTREAM) (* was: "20-Nov-86 16:26")
(for CH instring 4045XLPFileHeading do (BOUT BACKINGSTREAM CH])
(4045XLPHeading
[LAMBDA (4045XLPSTREAM HEADING PAGENUM) (* was: " 5-Dec-86 17:13")
(LET ((OLDHEADING (4045XLP.HEADING 4045XLPSTREAM)))
[COND
(HEADING (* set the heading up)
(change (4045XLP.HEADING 4045XLPSTREAM)
HEADING))
(T (COND
(OLDHEADING (MOVETO 4045XLPDefaultRegionLeft (COND
((4045XLPLandscapeP 4045XLPSTREAM)
4045XLPLandscapeHeading)
(T 4045XLPPortraitHeading))
4045XLPSTREAM)
(PRINTOUT 4045XLPSTREAM OLDHEADING " Page: " PAGENUM T T]
OLDHEADING])
)
(* * Bitmap Functions)
(DEFINEQ
(4045XLP.EncodedSixelofBitmap
[LAMBDA (BASEPTR Sixel#) (* was: " 8-Dec-86 15:44")
(LET* ((WordsToSkip (ITIMES 3 (IQUOTIENT Sixel# 8)))
(SixelsRemaining (IREMAINDER Sixel# 8))
(StartOfSixelRun (\ADDBASE BASEPTR WordsToSkip)))
(IPLUS 63 (SELECTQ SixelsRemaining
(0 (ffetch (SIXEL ZERO) of StartOfSixelRun))
(1 (ffetch (SIXEL ONE) of StartOfSixelRun))
(2 (ffetch (SIXEL TWO) of StartOfSixelRun))
(3 (ffetch (SIXEL THREE) of StartOfSixelRun))
(4 (ffetch (SIXEL FOUR) of StartOfSixelRun))
(5 (ffetch (SIXEL FIVE) of StartOfSixelRun))
(6 (ffetch (SIXEL SIX) of StartOfSixelRun))
(7 (ffetch (SIXEL SEVEN) of StartOfSixelRun))
(SHOULDNT SixelsRemaining])
(\BLTSHADE.4045XLP
[LAMBDA (TEXTURE 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION
CLIPPINGREGION) (* was: "11-Dec-86 07:19")
(* * Blt a shade into the given area. The 20 and 12 are fudge factors for BLTShading that force the correct
behavior.)
(SELECT TEXTURE ((BLACKSHADE) (* More efficient to draw thick line)
(\BLACKBOX.4045XLP 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT))
((WHITESHADE NIL) (* Can't erase bits so this is a no-op)
NIL)
(\BLTSHADE.GENERICPRINTER TEXTURE 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM
WIDTH HEIGHT OPERATION CLIPPINGREGION 4])
(\4045XLP.ROUND.BITMAP
[LAMBDA (SOURCEBM SOURCELEFT SOURCEBOTTOM WIDTH HEIGHT) (* was: " 8-Dec-86 15:45")
(* * to help with sixel conversion, enlarge to a multiple of 24 bits wide)
(LET* [[SOURCEREGION (INTERSECTREGIONS (CREATEREGION SOURCELEFT SOURCEBOTTOM WIDTH HEIGHT)
(CREATEREGION 0 0 (BITMAPWIDTH SOURCEBM)
(BITMAPHEIGHT SOURCEBM]
(NEWBITMAP (BITMAPCREATE (ITIMES (IQUOTIENT (IPLUS (fetch (REGION WIDTH)
of SOURCEREGION)
23)
24)
24)
(ffetch (REGION HEIGHT) of SOURCEREGION]
(BITBLT SOURCEBM SOURCELEFT SOURCEBOTTOM NEWBITMAP 0 0 (ffetch (REGION WIDTH)
of SOURCEREGION)
(ffetch (REGION HEIGHT) of SOURCEREGION)
(QUOTE INPUT)
(QUOTE REPLACE))
NEWBITMAP])
(\SCALEDBITBLT.4045XLP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM SCALE) (* was: " 8-Dec-86 15:45")
(* * \4045XLP.ROUND.BITMAP makes the bitmap a multiple of 24 bits wide for ease of handling and printing.
4045XLP wants bitmaps to be a multiple of 8 bits wide, and sixel encoding is easiest on things that are a multiple
of 24 bits wide. Only supports scale factors of 1, 2, and 4 CURRENTLY)
(COND
([NOT (FMEMB SCALE (QUOTE (NIL 1 2 4]
(\ILLEGAL.ARG SCALE)))
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(LET* ([EXPANDED.SOURCEBITMAP (\4045XLP.ROUND.BITMAP SOURCEBITMAP SOURCELEFT SOURCEBOTTOM
(OR WIDTH (BITMAPWIDTH SOURCEBITMAP))
(OR HEIGHT (BITMAPHEIGHT SOURCEBITMAP]
(BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(HEIGHT (BITMAPHEIGHT EXPANDED.SOURCEBITMAP))
(WIDTH.ROUNDED (BITMAPWIDTH EXPANDED.SOURCEBITMAP))
(SIXEL.WIDTH (IQUOTIENT WIDTH.ROUNDED 6))
(WordWidth (ffetch (BITMAP BITMAPRASTERWIDTH) of EXPANDED.SOURCEBITMAP))
(SCALE (OR SCALE 4)))
(4045XLP.PROMPT "Formatting bitmap...")
(\WINDOWCMD.4045XLP SCALE DESTINATIONLEFT (IPLUS (ITIMES SCALE HEIGHT)
DESTINATIONBOTTOM)
WIDTH.ROUNDED HEIGHT 4045XLPSTREAM)
(\GENERICBITBLT.4045XLP EXPANDED.SOURCEBITMAP HEIGHT SIXEL.WIDTH WordWidth BACKINGSTREAM)
(4045XLP.PROMPT "done."))
T])
(\GENERICBITBLT.4045XLP
[LAMBDA (EXPANDED.SOURCEBITMAP HEIGHT SIXEL.WIDTH WORDWIDTH BACKINGSTREAM)
(* was: "11-Dec-86 13:25")
(* Run-length encoding algorithm for 4045 Is called by
bitblt and scaledbitblt to dump the data faster and
less of it.)
(bind (CurrRow ←(ffetch (BITMAP BITMAPBASE) of EXPANDED.SOURCEBITMAP))
(BYTECOUNT ← 0)
PREVBYTE PRESENTBYTE for ROW from 1 to HEIGHT
do [for Sixel from 0 to (SUB1 SIXEL.WIDTH)
do (SETQ PRESENTBYTE (4045XLP.EncodedSixelofBitmap CurrRow Sixel))
(COND
((AND (EQ PREVBYTE PRESENTBYTE)
(NEQ BYTECOUNT 32767))
(add BYTECOUNT 1))
(T (COND
((EQ BYTECOUNT 0)
(SETQ BYTECOUNT 1))
((EQ BYTECOUNT 1)
(BOUT BACKINGSTREAM PREVBYTE))
(T (for I instring (MKSTRING BYTECOUNT) do (BOUT BACKINGSTREAM I)
)
(BOUT BACKINGSTREAM PREVBYTE)
(SETQ BYTECOUNT 1)))
(SETQ PREVBYTE PRESENTBYTE]
(SETQ CurrRow (\ADDBASE CurrRow WORDWIDTH))
(BLOCK)
finally (COND
((EQ BYTECOUNT 1)
(BOUT BACKINGSTREAM PREVBYTE))
(PREVBYTE (for I instring (MKSTRING BYTECOUNT) do (BOUT BACKINGSTREAM I))
(BOUT BACKINGSTREAM PREVBYTE])
(\BITBLT.4045XLP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM) (* was: " 8-Dec-86 15:46")
(* * \4045XLP.ROUND.BITMAP makes the bitmap a multiple of 24 bits wide for ease of handling and printing.
4045XLP wants bitmaps to be a multiple of 8 bits wide, and sixel encoding is easiest on things that are a multiple
of 24 bits wide)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(LET* ((EXPANDED.SOURCEBITMAP (\4045XLP.ROUND.BITMAP SOURCEBITMAP SOURCELEFT SOURCEBOTTOM WIDTH
HEIGHT))
(BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(HEIGHT (BITMAPHEIGHT EXPANDED.SOURCEBITMAP))
(WIDTH.ROUNDED (BITMAPWIDTH EXPANDED.SOURCEBITMAP))
(SIXEL.WIDTH (IQUOTIENT WIDTH.ROUNDED 6))
(WordWidth (ffetch (BITMAP BITMAPRASTERWIDTH) of EXPANDED.SOURCEBITMAP)))
(4045XLP.PROMPT "Formatting bitmap...")
(\WINDOWCMD.4045XLP 4 DESTINATIONLEFT (IPLUS (ITIMES 4 HEIGHT)
DESTINATIONBOTTOM)
WIDTH.ROUNDED HEIGHT 4045XLPSTREAM)
(\GENERICBITBLT.4045XLP EXPANDED.SOURCEBITMAP HEIGHT SIXEL.WIDTH WordWidth BACKINGSTREAM)
(4045XLP.PROMPT "done."])
(\BLACKBOX.4045XLP
[LAMBDA (4045XLPSTREAM LEFT BOTTOM WIDTH HEIGHT) (* was: " 9-Dec-86 13:09")
(* * Draw a black box by drawing a thick line because it's faster and the 4045 can do more lines than graphic
windows)
(LET ((BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM)))
(COND
[(4045XLPIn2700ModeP 4045XLPSTREAM)
(COND
((4045XLPLandscapeP 4045XLPSTREAM)
(\SEND4045XLPCOMMAND (CONCAT "y" (IDIFFERENCE 4045XLPDefaultPageWidth
(IPLUS HEIGHT BOTTOM))
"," LEFT "," WIDTH "," HEIGHT)
BACKINGSTREAM))
(T (\SEND4045XLPCOMMAND (CONCAT "x" LEFT "," BOTTOM "," WIDTH "," HEIGHT)
BACKINGSTREAM]
(T (COND
((4045XLPLandscapeP 4045XLPSTREAM)
(\SEND4045XLPCOMMAND (CONCAT "x" LEFT "," (IDIFFERENCE
4045XLPDefaultPageWidth
(IPLUS BOTTOM HEIGHT)
)
"," WIDTH "," HEIGHT)
BACKINGSTREAM))
(T (\SEND4045XLPCOMMAND (CONCAT "x" LEFT "," (IDIFFERENCE
4045XLPDefaultPageHeight
(IPLUS BOTTOM
HEIGHT))
"," WIDTH "," HEIGHT)
BACKINGSTREAM])
(\WINDOWCMD.4045XLP
[LAMBDA (MAGNIFICATION LEFT TOP WIDTH HEIGHT 4045XLPSTREAM)
(* was: " 8-Dec-86 15:47")
(* * Sends out the actual command to set up a grapic window on the 4045xlp. Obeys 2700mode and landscape modes)
(LET ((Landscape (4045XLPLandscapeP 4045XLPSTREAM))
(2700MODE (4045XLPIn2700ModeP 4045XLPSTREAM)))
(\SEND4045XLPCOMMAND (if (4045XLPIn2700ModeP 4045XLPSTREAM)
then (CONCAT "gw" MAGNIFICATION ";"
(MakePosition.4045XLP LEFT TOP 2700MODE
Landscape)
"," WIDTH "," HEIGHT)
else (CONCAT "vw" MAGNIFICATION ";" (MakePosition.4045XLP
LEFT TOP 2700MODE Landscape)
"," WIDTH "," HEIGHT))
(\4045XLPBackingStream 4045XLPSTREAM])
)
(* Page bitmap fns)
(DEFINEQ
(4045XLP.RESET
[LAMBDA (STREAM PORTTO?) (* was: "10-Dec-86 17:01")
(* Resets the bitmap for other stream to use it. Note: this will cause problems if the person calls it while one
stream thinks it has the stream and then it is given away. Several streams may be writing to the same bitmap! The
OPTIONAL stream arg means to reset the stream if you know what stream you are using. It will also release the port
lock if the port flag is t.)
(DECLARE (GLOBALVARS \4045XLP.BITMAPREC))
(COND
(STREAM (4045XLP.RELEASE.BITMAP (ffetch (STREAM IMAGEDATA) of STREAM)))
(T (BLTSHADE WHITESHADE (ffetch (4045XLPBITMAP BITMAP) of \4045XLP.BITMAPREC))
(RELEASE.MONITORLOCK (ffetch (4045XLPBITMAP MONITOR) of \4045XLP.BITMAPREC)
T)))
(AND PORTTO? (4045XLP.RELEASE.PORT T])
(4045XLP.GETBMSTR
[LAMBDA (4045XLPSTREAM) (* was: " 5-Dec-86 18:50")
(* * Returns a stream to the bitmap and resets the data structure if the bitmap is available.
Otherwise it waits for the bitmap to become free)
(DECLARE (GLOBALVARS \4045XLP.BITMAPREC))
(LET ((4045XLPDATA (ffetch (STREAM IMAGEDATA) of 4045XLPSTREAM))
BITMAP)
(COND
((4045XLP.HAS.BITMAP 4045XLPDATA))
(T (4045XLP.GET.BITMAP 4045XLPDATA)
(SETQ BITMAP (ffetch (4045XLPBITMAP BITMAP) of \4045XLP.BITMAPREC))
(COND
((4045XLPLandscapeP 4045XLPSTREAM)
(ChangePageBitmap.4045XLP BITMAP 4045XLPLandscapePageBMRaster
4045XLPLandscapePageBMWidth
4045XLPLandscapePageBMHeight))
(T (ChangePageBitmap.4045XLP BITMAP 4045XLPPortraitPageBMRaster
4045XLPPortraitPageBMWidth 4045XLPPortraitPageBMHeight)
))
(freplace (4045XLPBITMAP BITMAPDIRTY) of \4045XLP.BITMAPREC with T)))
(ffetch (4045XLPBITMAP BMSTREAM) of \4045XLP.BITMAPREC])
(4045XLP.GET.BITMAP
[LAMBDA (4045XLPDATA) (* was: " 4-Nov-86 08:13")
(* if the stream doesn't have the bitmap, this
function will wait until the bitmap is available and
then give the stream the bitmap)
(DECLARE (GLOBALVARS \4045XLP.BITMAPREC))
(OBTAIN.MONITORLOCK (ffetch (4045XLPBITMAP MONITOR) of \4045XLP.BITMAPREC))
(freplace (4045XLPDATA 4045XLPOWNSBITMAPFLG) of 4045XLPDATA with T)
(BLTSHADE WHITESHADE (ffetch (4045XLPBITMAP BITMAP) of \4045XLP.BITMAPREC])
(4045XLP.RELEASE.BITMAP
[LAMBDA (4045XLPDATA) (* was: " 6-Nov-86 09:38")
(* give up the bitmap, and mark the stream so.)
(DECLARE (GLOBALVARS \4045XLP.BITMAPREC))
(freplace (4045XLPDATA 4045XLPOWNSBITMAPFLG) of 4045XLPDATA with NIL)
(freplace (4045XLPBITMAP BITMAPDIRTY) of \4045XLP.BITMAPREC with NIL)
(RELEASE.MONITORLOCK (ffetch (4045XLPBITMAP MONITOR) of \4045XLP.BITMAPREC])
(\ScaledBltBigBitmap.4045XLP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM 4045XLPSTREAM DESTINATIONLEFT DESTINATIONBOTTOM SCALE)
(* was: " 8-Dec-86 15:50")
(* * Currently only used to blt the page bitmap to the printer, but will really handle any bitmap that is a
multiple of 24 bits wide. Cannot be a region because the sixeling must start on a word boundary and it is difficult
to determine if that is the case. Sends the whole bitmap only.)
(COND
([NOT (FMEMB SCALE (QUOTE (NIL 1 2 4]
(\ILLEGAL.ARG SCALE))
((NOT (ZEROP (IREMAINDER (BITMAPWIDTH SOURCEBITMAP)
24)))
(\ILLEGAL.ARG SOURCEBITMAP)))
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
(LET* ((BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(HEIGHT (BITMAPHEIGHT SOURCEBITMAP))
(WIDTH (BITMAPWIDTH SOURCEBITMAP))
(SIXEL.WIDTH (IQUOTIENT WIDTH 6))
(WordWidth (ffetch (BITMAP BITMAPRASTERWIDTH) of SOURCEBITMAP))
(SCALE (OR SCALE 4)))
(4045XLP.PROMPT "Formatting bitmap...")
(\WINDOWCMD.4045XLP SCALE DESTINATIONLEFT (IPLUS (ITIMES SCALE HEIGHT)
DESTINATIONBOTTOM)
WIDTH HEIGHT 4045XLPSTREAM)
(\GENERICBITBLT.4045XLP SOURCEBITMAP HEIGHT SIXEL.WIDTH WordWidth BACKINGSTREAM)
(4045XLP.PROMPT "done.")
T])
(ChangePageBitmap.4045XLP
[LAMBDA (BITMAP RASTERWIDTH WIDTH HEIGHT) (* was: " 5-Dec-86 18:42")
(freplace (BITMAP BITMAPRASTERWIDTH) of BITMAP with RASTERWIDTH)
(freplace (BITMAP BITMAPWIDTH) of BITMAP with WIDTH)
(freplace (BITMAP BITMAPHEIGHT) of BITMAP with HEIGHT)
(freplace (4045XLPBITMAP BMSTREAM) of \4045XLP.BITMAPREC with (DSPCREATE BITMAP))
(DSPOPERATION (QUOTE PAINT)
(ffetch (4045XLPBITMAP BMSTREAM) of \4045XLP.BITMAPREC])
)
(* * Drawing algorithms)
(DEFINEQ
(\DRAWCIRCLE.4045XLP
[LAMBDA (4045XLPSTREAM X Y RADIUS BRUSH DASHING) (* was: " 8-Dec-86 15:50")
(* Draw a circle on the 4045xlpstream)
(LET ((NEWBRUSH (4045XLP.SCALEBRUSH BRUSH)))
(DRAWCIRCLE (IQUOTIENT (ADD1 X)
2)
(IQUOTIENT (ADD1 Y)
2)
(IQUOTIENT (ADD1 RADIUS)
2)
NEWBRUSH DASHING (4045XLP.GETBMSTR 4045XLPSTREAM])
(\FILLCIRCLE.4045XLP
[LAMBDA (4045XLPSTREAM X Y RADIUS TEXTURE) (* was: " 8-Dec-86 15:50")
(* * draw a filled circle on the given stream)
(FILLCIRCLE (IQUOTIENT (ADD1 X)
2)
(IQUOTIENT (ADD1 Y)
2)
(IQUOTIENT (ADD1 RADIUS)
2)
TEXTURE
(4045XLP.GETBMSTR 4045XLPSTREAM])
(\DRAWPOLYGON.4045XLP
[LAMBDA (4045XLPSTREAM POINTS CLOSED BRUSH DASHING) (* was: " 5-Dec-86 09:40")
(* draw a polygon on the stream)
(DRAWPOLYGON POINTS CLOSED (4045XLP.SCALEBRUSH BRUSH)
DASHING
(4045XLP.GETBMSTR 4045XLPSTREAM])
(\FILLPOLYGON.4045XLP
[LAMBDA (4045XLPSTREAM POINTS TEXTURE) (* was: " 5-Dec-86 09:40")
(* draw a filled polygon on the stream)
(LET [(GOODPTLST (for PT in POINTS collect (CONS (IQUOTIENT (ADD1 (CAR PT))
2)
(IQUOTIENT (ADD1 (CDR PT))
2]
(FILLPOLYGON GOODPTLST TEXTURE (4045XLP.GETBMSTR 4045XLPSTREAM])
(\DRAWELLIPSE.4045XLP
[LAMBDA (4045XLPSTREAM X Y MINOR MAJOR ORIENTATION BRUSH DASHING)
(* was: " 5-Dec-86 09:40")
(* draw an ellipse)
(DRAWELLIPSE (IQUOTIENT (ADD1 X)
2)
(IQUOTIENT (ADD1 Y)
2)
(IQUOTIENT (ADD1 MINOR)
2)
(IQUOTIENT (ADD1 MAJOR)
2)
ORIENTATION
(4045XLP.SCALEBRUSH BRUSH)
DASHING
(4045XLP.GETBMSTR 4045XLPSTREAM])
(\DRAWCURVE.4045XLP
[LAMBDA (4045XLPSTREAM KNOTS CLOSED BRUSH DASHING) (* was: " 5-Dec-86 09:40")
(* draw a curve)
(LET* [(NEWBRUSH (4045XLP.SCALEBRUSH BRUSH))
(GOODKTLIST (for KT in KNOTS collect (CONS (IQUOTIENT (ADD1 (CAR KT))
2)
(IQUOTIENT (ADD1 (CDR KT))
2]
(DRAWCURVE GOODKTLIST CLOSED NEWBRUSH DASHING (4045XLP.GETBMSTR 4045XLPSTREAM])
(\DRAWLINE.4045XLP
[LAMBDA (4045XLPSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING)
(* was: " 5-Dec-86 09:42")
(* * 4045 can print horizontal and vert. solid lines fast so use the special function to do that otherwise draw on
the page bitmap)
(LET ((HALFWIDTH (IQUOTIENT WIDTH 2)))
(COND
((ZEROP WIDTH))
([OR (LISTP DASHING)
(NOT (OR (EQP X1 X2)
(EQP Y1 Y2]
(DRAWLINE (IQUOTIENT (ADD1 X1)
2)
(IQUOTIENT (ADD1 Y1)
2)
(IQUOTIENT (ADD1 X2)
2)
(IQUOTIENT (ADD1 Y2)
2)
(COND
((IGREATERP HALFWIDTH 1)
HALFWIDTH)
(T 1))
(QUOTE PAINT)
(4045XLP.GETBMSTR 4045XLPSTREAM)
COLOR DASHING))
(T (\DRAWLINE1.4045XLP 4045XLPSTREAM X1 Y1 X2 Y2 WIDTH)))
(\MOVETO.4045XLP 4045XLPSTREAM X2 Y2])
(\DRAWLINE1.4045XLP
[LAMBDA (4045XLPSTREAM X1 Y1 X2 Y2 width) (* was: " 9-Dec-86 11:46")
(* uses direct line drawing on the 4045 BUT only works
for horizontal and vert. lines.)
(LET ((BACKINGSTREAM (\4045XLPBackingStream 4045XLPSTREAM))
(LandscapeP (4045XLPLandscapeP 4045XLPSTREAM))
(2700Mode (4045XLPIn2700ModeP 4045XLPSTREAM))
XPos YPos len AXIS)
(COND
((EQP X1 X2) (* vertical line)
(* correction for funny line placing on 4045)
(SETQ XPos (IDIFFERENCE X1 (IQUOTIENT (SUB1 width)
2)))
(SETQ YPos (MIN Y1 Y2))
[SETQ len (ADD1 (IABS (IDIFFERENCE Y2 Y1]
(SETQ AXIS (COND
((AND 2700Mode LandscapeP)
"x")
(T "y")))
(if (OR (AND 2700Mode LandscapeP)
(NULL 2700Mode))
then (* correction for stupid printer.)
(add YPos len))
(\SEND4045XLPCOMMAND (CONCAT AXIS (MakePosition.4045XLP XPos YPos 2700Mode
LandscapeP)
"," len "," width)
BACKINGSTREAM))
((EQP Y1 Y2) (* horizontal line)
(SETQ XPos (MIN X1 X2)) (* correction for funny line placing on 4045)
(SETQ YPos (IDIFFERENCE Y1 (IQUOTIENT (SUB1 width)
2)))
[SETQ len (IPLUS 3 (IABS (IDIFFERENCE X2 X1]
(SETQ AXIS (COND
((AND 2700Mode LandscapeP)
"y")
(T "x")))
(if (OR (AND 2700Mode LandscapeP)
(NULL 2700Mode))
then (add YPos width))
(\SEND4045XLPCOMMAND (CONCAT AXIS (MakePosition.4045XLP XPos YPos 2700Mode
LandscapeP)
"," len "," width)
BACKINGSTREAM])
)
(* * Default Printing Code)
(DEFINEQ
(4045XLPFILEP
[LAMBDA (FILE NOOPEN) (* was: " 6-Nov-86 14:36")
(* Returns fullname of FILE if it looks like a 4045XLP
file)
(OR (EQ (UNPACKFILENAME FILE (QUOTE EXTENSION))
(QUOTE 4045XLP))
(RESETLST (PROG (STRM)
[COND
((SETQ STRM (\GETSTREAM FILE (QUOTE INPUT)
T))
(OR (RANDACCESSP STRM)
(RETURN))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
STRM
(GETFILEPTR STRM)))
(SETFILEPTR STRM 0))
(NOOPEN (RETURN))
(T (RESETSAVE (SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(RETURN (for I from 1 to (CONSTANT (NCHARS
4045XLPFileHeading))
when (OR (EOFP STRM)
(NEQ (NTHCHARCODE 4045XLPFileHeading I)
(BIN STRM)))
do (RETURN NIL) finally (RETURN (FULLNAME STRM])
(4045XLP.BITMAPSCALE
[LAMBDA (WIDTH HEIGHT) (* was: " 4-Nov-86 16:40")
(* will eventually prescale the bitmap)
1])
(4045XLPPRINT
[LAMBDA (PORT FILE PRINTOPTIONS) (* was: "10-Dec-86 17:04")
(* * Set up a printing process to the printer.)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS 4045XLP.MONITOR))
(PROG ((HOST (OR (4045XLP.CHECK.OUTPUTFILE PORT)
(fetch (4045XLP.PARAMETERS PORT) of 4045XLP.DEFAULTS)))
OUT IN)
(OR FILE (RETURN)) (* have to grab the monitorlock anytime you actually
are going to print on the printer!)
(WITH.MONITOR 4045XLP.MONITOR (4045XLP.PROMPT (CONCAT FILE " on " HOST
" -- in progress"))
(* * print the break page if necessary)
[COND
((OR (ffetch (4045XLP.PARAMETERS PRINTHEADER) of 4045XLP.DEFAULTS)
(LISTGET PRINTOPTIONS (QUOTE BREAK.PAGE)))
(4045XLP.PRINTHEADERPAGE (OR (LISTGET PRINTOPTIONS (QUOTE
DOCUMENT.NAME))
FILE]
(* * Set up the two streams to deal with the input and output)
[RESETSAVE [SETQ IN (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE ((SEQUENTIAL T)
(DON'TCACHE T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[RESETSAVE [SETQ OUT (OPENSTREAM HOST (QUOTE OUTPUT)
(QUOTE NEW)
(QUOTE ((TYPE BINARY)
(SEQUENTIAL T)
(DON'TCACHE T]
(QUOTE (PROGN (BOUT OLDVALUE (CHARCODE FF))
(FORCEOUTPUT OLDVALUE T)
(CLOSEF? OLDVALUE]
(bind (half ←(IQUOTIENT (GETEOFPTR IN)
2))
for CPY from 1 to (OR (LISTGET PRINTOPTIONS (QUOTE #COPIES))
1)
do (COPYBYTES IN OUT half)
(BLOCK 1000)
(COPYBYTES IN OUT)
(BOUT OUT (CHARCODE FF))
(FORCEOUTPUT OUT T)
(BLOCK))
(4045XLP.PROMPT (CONCAT FILE " on " HOST " -- done.")))
[COND
((LISTGET PRINTOPTIONS (QUOTE DELETE))
(DELFILE (CLOSEF? (FULLNAME FILE]
(RETURN (FULLNAME FILE])
(4045XLPBITMAPFILE
[LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
(* was: "10-Dec-86 17:11")
(* This is the function called for default hardcopying
of windows)
(OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
(RESETLST (DECLARE (GLOBALVARS 4045XLP.DEFAULTS 4045XLP.MONITOR))
(LET ([W (COND
(REGION (ffetch (REGION WIDTH) of REGION))
(T (ffetch BITMAPWIDTH of BITMAP]
[H (COND
(REGION (ffetch (REGION HEIGHT) of REGION))
(T (ffetch BITMAPHEIGHT of BITMAP]
(LEFT (COND
(REGION (ffetch (REGION LEFT) of REGION))
(T 0)))
(BOTTOM (COND
(REGION (ffetch (REGION BOTTOM) of REGION))
(T 0)))
(PORT (OR (4045XLP.CHECK.OUTPUTFILE OUTPUTFILE)
OUTPUTFILE))
(WINDOWTITLE (OR (ffetch (4045XLP.PARAMETERS WINDOWTITLE) of
4045XLP.DEFAULTS)
TITLE))
SCALE SCALING CLIP 4045XLPSTREAM) (* make sure there is a reasonable port, or use the
default port)
[COND
((4045XLP.CHECK.OUTPUTFILE OUTPUTFILE)
(* If we're going to the port, get a monitorlock
before printing anything)
(RESETSAVE (4045XLP.GET.PORT BITMAP)
(QUOTE (PROGN (4045XLP.RELEASE.PORT]
(COND
[(NULL ROTATION) (* Pick the default rotation)
(RESETSAVE (SETQ 4045XLPSTREAM (OPENIMAGESTREAM PORT (QUOTE 4045XLP))
)
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[(FMEMB ROTATION (QUOTE (0 360)))
(RESETSAVE [SETQ 4045XLPSTREAM (OPENIMAGESTREAM PORT (QUOTE 4045XLP)
(QUOTE (PORTRAIT
T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[(FMEMB ROTATION (QUOTE (90 270)))
(RESETSAVE [SETQ 4045XLPSTREAM (OPENIMAGESTREAM PORT (QUOTE 4045XLP)
(QUOTE (LANDSCAPE
T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(T (\ILLEGAL.ARG ROTATION)))
(SETQ CLIP (DSPCLIPPINGREGION NIL 4045XLPSTREAM))
(SETQ SCALE (for SCALE in (QUOTE (4 2 1))
do (COND
((AND (ILEQ (TIMES W SCALE)
(ffetch (REGION WIDTH) of CLIP))
(ILEQ (TIMES H SCALE)
(ffetch (REGION HEIGHT) of CLIP)))
(RETURN SCALE)))
finally (\ILLEGAL.ARG CLIP)))
(* actually blt the bitmap to the stream after all
setup has been done, and the monitorlock has been
grabbed if needed)
(COND
(WINDOWTITLE (PRINTOUT 4045XLPSTREAM .CENTER 0 WINDOWTITLE)))
(SCALEDBITBLT BITMAP LEFT BOTTOM 4045XLPSTREAM
(MAX 0 (IQUOTIENT (DIFFERENCE (ffetch (REGION WIDTH)
of CLIP)
(TIMES W SCALE))
2))
(MAX 0 (IQUOTIENT (DIFFERENCE (ffetch (REGION HEIGHT)
of CLIP)
(TIMES H SCALE))
2))
W H NIL NIL NIL NIL SCALE)
(* get a new page)
(NEWPAGE.4045XLP 4045XLPSTREAM)
(CLOSEF 4045XLPSTREAM])
(4045XLP.PRINTTEXT
[LAMBDA (FILE IMAGEFILE IMAGETYPE FONTS HEADING TABS OPTIONS)
(* was: "11-Dec-86 08:03")
(* Converts PSPOOL format text files into 4045XLP
image files)
(RESETLST (LET (IMAGESTREAM INFILE)
(4045XLP.PROMPT "Formatting TEXT file for print...")
[RESETSAVE [SETQ INFILE (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE ((BINARY T)
(SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[COND
((4045XLP.CHECK.OUTPUTFILE IMAGEFILE)
(* we are going directly to the port so get the
monitorlock and print the header page if necessary)
(RESETSAVE (4045XLP.GET.PORT FILE)
(QUOTE (PROGN (4045XLP.RELEASE.PORT]
(* Strip off the extension if we are generating the
name from the INFILE, so that OPENIMAGESTREAM can pack
on the appropriate extension)
[RESETSAVE [SETQ IMAGESTREAM
(OPENIMAGESTREAM
(OR IMAGEFILE (PACKFILENAME (QUOTE EXTENSION)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
INFILE))
IMAGETYPE
(APPEND [AND (EQ HEADING T)
(LIST (QUOTE HEADING)
(CONCAT (FULLNAME INFILE)
" "
(GETFILEINFO INFILE
(QUOTE
CREATIONDATE]
(APPEND (LIST (QUOTE DOCUMENT.NAME)
(FULLNAME INFILE)
(QUOTE LANDSCAPE)
T)
OPTIONS]
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
(* Make \BIN return NIL on EOS)
(COPY.TEXT.TO.IMAGE INFILE IMAGESTREAM FONTS)
(4045XLP.PROMPT "done.")
(LIST (CLOSEF INFILE)
(CLOSEF IMAGESTREAM])
(4045XLP.HOSTNAMEP
[LAMBDA (PRINTERNAME) (* was: " 6-Aug-86 10:38")
(AND (STRPOS "4045XLP" PRINTERNAME)
(QUOTE 4045XLP])
(4045XLP.CHECK.OUTPUTFILE
[LAMBDA (FILE) (* was: "27-Oct-86 17:45")
(LET [(HOST (U-CASE (UNPACKFILENAME FILE (QUOTE HOST]
(COND
((OR (EQ HOST (QUOTE RS232))
(EQ HOST (QUOTE TTY))
(EQ HOST (QUOTE CENTRONICS)))
(PACK* (QUOTE {)
HOST
(QUOTE })))
(T NIL])
(4045XLP.PRINTHEADERPAGE
[LAMBDA (FILE) (* was: "12-Dec-86 12:58")
(* * This function will print a header page for everything. It will automatically open a stream and close it when
it is done. ASSUMES THE MONITORLOCK WAS ALREADY PICKED UP BY THE CALLING FUNCTION!)
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS 4045XLPSTREAM.VERSION))
(RESETLST (LET (OUTSTREAM)
[RESETSAVE [SETQ OUTSTREAM (OPENIMAGESTREAM (ffetch (4045XLP.PARAMETERS
PORT)
of 4045XLP.DEFAULTS)
(QUOTE 4045XLP)
(QUOTE (PORTRAIT T]
(QUOTE (PROGN (CLOSEF OLDVALUE]
(SETXY.4045XLP OUTSTREAM 0 2000)
(PRINTOUT OUTSTREAM .CENTER 0 [COND
((AND (NEQ T (ffetch (4045XLP.PARAMETERS PRINTHEADER)
of 4045XLP.DEFAULTS))
(ffetch (4045XLP.PARAMETERS PRINTHEADER) of
4045XLP.DEFAULTS))
(ffetch (4045XLP.PARAMETERS PRINTHEADER) of 4045XLP.DEFAULTS))
(T (CONCAT "For: " (USERNAME]
T T)
(COND
((OR (BITMAPP FILE)
(WINDOWP FILE))
(\BOLDMODE.4045XLP OUTSTREAM)
(PRINTOUT OUTSTREAM .CENTER 0 FILE T T)
(\MEDIUMMODE.4045XLP OUTSTREAM))
(T (\BOLDMODE.4045XLP OUTSTREAM)
(PRINTOUT OUTSTREAM .CENTER 0 (OR (FULLNAME FILE)
FILE)
T T)
(\MEDIUMMODE.4045XLP OUTSTREAM)
(PRINTOUT OUTSTREAM .CENTER 0 [CONCAT "Created: "
(COND
((STRINGP FILE)
(* When we get a bitmap title instead of a file name.)
(DATE))
(T (GETFILEINFO FILE
(QUOTE
CREATIONDATE]
T T)))
(PRINTOUT OUTSTREAM .CENTER 0 (CONCAT "Printed: " (DATE))
T T)
(PRINTOUT OUTSTREAM .CENTER 0 (CONCAT "Xerox 4045 Print Service Version "
4045XLPSTREAM.VERSION)
T) (* draw for more interesting header page)
(DRAWLINE 100 300 100 3000 26 (QUOTE PAINT)
OUTSTREAM)
(DRAWLINE 2450 300 2450 3000 26 (QUOTE PAINT)
OUTSTREAM)
(DRAWLINE 2410 300 2410 3000 12 (QUOTE PAINT)
OUTSTREAM)
(DRAWLINE 2385 300 2385 3000 5 (QUOTE PAINT)
OUTSTREAM)
(DRAWLINE 140 300 140 3000 12 (QUOTE PAINT)
OUTSTREAM)
(DRAWLINE 165 300 165 3000 5 (QUOTE PAINT)
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE FF))
(FORCEOUTPUT (\4045XLPBackingStream OUTSTREAM))
NIL])
(4045XLP.PRINT.ERRORPAGE
[LAMBDA (4045XLPSTREAM) (* was: " 7-Nov-86 09:28")
(* * We only know about bad character errors for now but later this may be expanded!)
(LET ((ERRS (4045XLP.Error NIL 4045XLPSTREAM)))
(COND
(ERRS (DRAWLINE 200 500 2300 500 5 (QUOTE PAINT)
4045XLPSTREAM)
(DRAWLINE 200 3000 2300 3000 5 (QUOTE PAINT)
4045XLPSTREAM)
(DSPLEFTMARGIN 200 4045XLPSTREAM)
(DSPRIGHTMARGIN 2300 4045XLPSTREAM)
(PRINTOUT 4045XLPSTREAM T T T .CENTER 0 "4045XLPStream Printing Errors" T T T)
(if ERRS
then (PRINTOUT 4045XLPSTREAM .CENTER 0
"Unknown characters: [charset,charcode]")
(bind Page Char ErrString for Error in ERRS
do (COND
((NEQ Page (CAR Error))
(PRINTOUT 4045XLPSTREAM T T "Page: " (SETQ Page
(CAR Error))
T T)))
(SETQ Char (CDR Error))
(SETQ ErrString (CONCAT "[" (\CHARSET Char)
","
(\CHAR8CODE Char)
"] "))
(COND
((ILEQ (IPLUS (DSPXPOSITION NIL 4045XLPSTREAM)
(STRINGWIDTH ErrString 4045XLPSTREAM))
(DSPRIGHTMARGIN NIL 4045XLPSTREAM)))
(T (TERPRI 4045XLPSTREAM)))
(PRINTOUT 4045XLPSTREAM ErrString)))
T])
(4045XLP.PROMPT
[LAMBDA (PROMPTSTRING) (* was: " 8-Dec-86 15:56")
(LET ((MESSAGESTREAM (ffetch (4045XLP.PARAMETERS MESSAGESTREAM) of 4045XLP.DEFAULTS)))
(AND MESSAGESTREAM (PRINTOUT MESSAGESTREAM "[4045XLP: " PROMPTSTRING " ]" T])
)
(* * Port initializing and parameter setting code)
(DEFINEQ
(4045XLP.HELP.GET.PORT
[LAMBDA NIL (* was: "15-Dec-86 15:58")
(LET [(PORT (ASKUSER 10 (QUOTE D)
"Which port would you like to use for the 4045? "
(QUOTE ((R "s232" EXPLAINSTRING
"Rs232 - Use the RS232 port for the 4045"
RETURN
(QUOTE RS232))
(T "ty" EXPLAINSTRING "Tty - Use the Tty port for the 4045"
RETURN (QUOTE TTY))
(C "entronics" EXPLAINSTRING
"Centronics - Use the Centronics port for the 4045"
RETURN
(QUOTE CENTRONICS))
(D "efault" EXPLAINSTRING
"Default - Use the default port for the 4045"
RETURN NIL) (* " use the default port for the 4045" DONTECHO T
EXPLAINSTRING "" CONFIRMFLG NIL)
))
NIL NIL (QUOTE (CONFIRMFLG T AUTOCOMPLETEFLG T PROMPTCONFIRMFLG T]
(4045XLP.INIT.PORT PORT)
[4045XLP.SET.PARAMETERS (LIST (CONS (QUOTE PORT)
(COND
((OR (NULL PORT)
(EQ PORT (QUOTE RS232)))
(QUOTE {RS232}))
((EQ PORT (QUOTE TTY))
(QUOTE {TTY}))
((EQ PORT (QUOTE CENTRONICS))
(QUOTE {CENTRONICS}))
(T (RINGBELLS)
(\ILLEGAL.ARG PORT]
(TERPRI])
(4045XLP.GET.PORT
[LAMBDA (file)
(DECLARE (GLOBALVARS 4045XLP.MONITOR)) (* was: "10-Dec-86 17:21")
(LET ((MONITOR (OBTAIN.MONITORLOCK 4045XLP.MONITOR)))
(COND
((ffetch (4045XLP.PARAMETERS PRINTHEADER) of 4045XLP.DEFAULTS)
(4045XLP.PRINTHEADERPAGE file)))
MONITOR])
(4045XLP.RELEASE.PORT
[LAMBDA (EVENIFNOTMINE)
(DECLARE (GLOBALVARS 4045XLP.MONITOR)) (* was: "10-Dec-86 17:21")
(RELEASE.MONITORLOCK 4045XLP.MONITOR])
(4045XLP.INIT.PORT
[LAMBDA (PORT) (* was: " 8-Dec-86 15:56")
(DECLARE (GLOBALVARS 4045XLP.DEFAULTS))
[SELECTQ (U-CASE PORT)
((RS232 RS232C DLRS232 DLRS232C {RS232})
(4045XLP.INIT.RS232))
((TTY DLTTY {TTY})
(4045XLP.INIT.TTY))
((CENTRONICS CENT {CENTRONICS} {CENT})
(4045XLP.INIT.CENTRONICS))
(SELECTQ (ffetch (4045XLP.PARAMETERS PORT) of 4045XLP.DEFAULTS)
(({RS232} RS232 RS232C {RS232C})
(4045XLP.INIT.RS232))
(({TTY} TTY PRINTER)
(4045XLP.INIT.TTY))
(({CENTRONICS} CENTRONICS {CENT} CENT)
(4045XLP.INIT.CENTRONICS))
(PROMPTPRINT (CONCAT "Error bad port specification"
(OR PORT (ffetch (4045XLP.PARAMETERS PORT)
of 4045XLP.DEFAULTS]
T])
(4045XLP.INIT.RS232
[LAMBDA NIL (* was: " 4-Dec-86 15:42")
(* * init the rs232 port, but first load the package if it isn't already loaded)
(FILESLOAD (FROM LISPUSERS)
DLRS232C)
[COND
[\RS232C.READY (RS232C.SET.PARAMETERS (QUOTE ((BaudRate . 9600)
(Parity . NONE)
(FlowControl 1 17 19)
(BitsPerSerialChar . 8)
(StopBits . 1]
(T (RS232C.INIT 9600 8 (QUOTE NONE)
1
(QUOTE (1 17 19] (* workaround per LMM 12/3/86)
(ADVISE (QUOTE \RS232C.FORCEOUTPUT)
(QUOTE (SETQ WAITFORFINISH T)))
NIL])
(4045XLP.INIT.TTY
[LAMBDA NIL (* was: "28-Oct-86 16:08")
(* * init the tty port, loading the package if necessary.)
(FILESLOAD (FROM LISPUSERS)
DLTTY)
(COND
[\TTY.READY (TTY.SET.PARAMETERS (QUOTE ((BaudRate . 9600)
(Parity . NONE)
(FlowControl 1 17 19)
(BitsPerSerialChar . 8)
(StopBits . 1]
(T (TTY.INIT 9600 8 (QUOTE NONE)
1
(QUOTE (1 17 19])
(4045XLP.INIT.CENTRONICS
[LAMBDA NIL (* was: "28-Oct-86 16:13")
(* * Init the centronics port, loading the package if not already done.)
(FILESLOAD (FROM LISPUSERS)
CENTRONICS)
(CENTRONICS.RESET])
(4045XLP.SET.PARAMETERS
[LAMBDA (PARAMETERS) (* was: " 8-Dec-86 15:57")
[for PARAM in PARAMETERS do (LET ((VALUE (CDR PARAM)))
(SELECTQ (CAR PARAM)
(PORT (AND (LITATOM VALUE)
(freplace (4045XLP.PARAMETERS
PORT)
of 4045XLP.DEFAULTS
with VALUE)))
(LANGUAGE (AND (FMEMB VALUE
(LIST 630 2700))
(freplace (4045XLP.PARAMETERS
LANGUAGE)
of 4045XLP.DEFAULTS
with VALUE)))
(MESSAGESTREAM
(LET ((STREAM (if (STREAMP VALUE)
then VALUE
elseif (WINDOWP VALUE)
then (GETSTREAM VALUE)
elseif (NULL VALUE)
then NIL)))
(freplace (4045XLP.PARAMETERS
MESSAGESTREAM)
of 4045XLP.DEFAULTS with STREAM)))
(PRINTERRORS (freplace (4045XLP.PARAMETERS
PRINTERRORS)
of 4045XLP.DEFAULTS
with (AND VALUE T)))
(PRINTHEADER (freplace (4045XLP.PARAMETERS
PRINTHEADER)
of 4045XLP.DEFAULTS
with VALUE))
(WINDOWTITLE (freplace (4045XLP.PARAMETERS
WINDOWTITLE)
of 4045XLP.DEFAULTS
with VALUE))
(SLUG (if (OR (NUMBERP VALUE)
(NULL VALUE))
then (freplace (4045XLP.PARAMETERS
SLUG)
of 4045XLP.DEFAULTS
with VALUE)))
(LANDSCAPE (freplace (4045XLP.PARAMETERS
LANDSCAPE)
of 4045XLP.DEFAULTS
with (AND VALUE T)))
(printout PROMPTWINDOW
"Unknown 4045xlp parameter: "
PARAM)
(\ILLEGAL.ARG PARAM]
4045XLP.DEFAULTS])
(4045XLP.GET.PARAMETERS
[LAMBDA (PARAMETERS) (* hdj "30-Oct-86 15:13")
(COND
(PARAMETERS (for KEY in PARAMETERS collect (ASSOC KEY 4045XLP.DEFAULTS)))
(T 4045XLP.DEFAULTS])
)
(* * SYSTEM PATCHES * *)
(* patch to FONT to fix the unparsing of otherfds in a font class. Without the patch, the
fontclass would be built without having a size for the otherfds font which causes breaks
hardcopying and reading the files.)
(DEFINEQ
(FONTCLASSUNPARSE
[LAMBDA (FONTCLASS DEVICE FONT NOERRORFLG) (* was: " 9-Sep-86 12:09")
(* Given a font class, unparse it to a form that might
be reparsable)
(APPEND (LIST (fetch (FONTCLASS FONTCLASSNAME) of FONTCLASS)
(fetch (FONTCLASS PRETTYFONT#) of FONTCLASS)
(FONTUNPARSE (ffetch (FONTCLASS DISPLAYFD) of FONTCLASS))
(FONTUNPARSE (ffetch (FONTCLASS PRESSFD) of FONTCLASS))
(FONTUNPARSE (ffetch (FONTCLASS INTERPRESSFD) of FONTCLASS)))
(for X in (fetch (FONTCLASS OTHERFDS) of FONTCLASS)
collect (LIST (CAR X)
(FONTUNPARSE (CDR X])
)
(* Patch to tedit.hardcopy to make it work with imagetypes other than press and interpress)
(DEFINEQ
(TEDIT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
(* was: "28-Oct-86 18:02")
(* Send the text to the printer.)
(COND
[(OR SERVER DEFAULTPRINTINGHOST) (* We can only hardcopy if there is a server
specified, or the system will give us a reasonable
default one.)
(for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER)
(QUOTE CANPRINT))
do (SELECTQ IMAGETYPE
[PRESS (* Send to a PRESS printer)
(RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND
BREAKPAGETITLE SERVER
PRINTOPTIONS (QUOTE PRESS]
[INTERPRESS (* Send it to an INTERPRESS printer)
(RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND
BREAKPAGETITLE SERVER
PRINTOPTIONS (QUOTE
INTERPRESS]
NIL) (* If there is a conversion method, then you can print
tedit files of this type, so do it)
(AND (LISTGET (CADR (ASSOC (QUOTE CONVERSION)
(ASSOC IMAGETYPE PRINTFILETYPES)))
(QUOTE TEDIT))
(RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER
PRINTOPTIONS IMAGETYPE)))
finally (ERROR (CONCAT "Can't print TEDIT documents on a " (PRINTERTYPE SERVER)
" printer."]
(T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM)
"Can't HARDCOPY: No print server specified." T])
)
(* * Records)
[DECLARE: EVAL@COMPILE
(ASSOCRECORD 4045XLP.PARAMETERS (PORT LANGUAGE WINDOWTITLE MESSAGESTREAM PRINTERRORS PRINTHEADER
SLUG LANDSCAPE))
]
(DECLARE: EVAL@LOAD DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD SIXEL ((ZERO BITS 6)
(ONE BITS 6)
(TWO.1 BITS 4)
(TWO.2 BITS 2)
(THREE BITS 6)
(FOUR BITS 6)
(FIVE.1 BITS 2)
(FIVE.2 BITS 4)
(SIX BITS 6)
(SEVEN BITS 6))
[ACCESSFNS SIXEL ([TWO (LOGOR (LLSH (fetch (SIXEL TWO.1) of DATUM)
2)
(fetch (SIXEL TWO.2) of DATUM))
(PROGN (replace (SIXEL TWO.1) of DATUM
with (LOGAND (MASK.1'S 0 4)
(LRSH DATUM 2)))
(replace (SIXEL TWO.2) of DATUM
with (LOGAND (MASK.1'S 0 2)
DATUM]
(FIVE (LOGOR (LLSH (fetch (SIXEL FIVE.1) of DATUM)
4)
(fetch (SIXEL FIVE.2) of DATUM])
(DATATYPE 4045XLPDATA ((4045XLPBOTTOM WORD) (* Bottom margin)
(4045XLPTOP WORD) (* Top margin)
(4045XLPRIGHT WORD) (* Right Margin)
(4045XLPLEFT WORD) (* left margin)
(4045XLPLINEFEED WORD) (* delta y amount a LF takes up)
(4045XLPOWNSBITMAPFLG FLAG) (* tells whether this stream owns the global bitmap or
not)
4045XLPXPOS (* current x pos)
4045XLPYPOS (* current y pos)
4045XLPCLIPPINGREGION (* clipping region)
4045XLPCHARSET (* Current Charset)
4045XLPCSTRANSTABLE (* current charset translation table)
4045XLPNSTRANSTABLE (* \asciitons translation table)
4045XLPWIDTHSCACHE (* the widths of the characters)
4045XLPSPACEWIDTH (* how much space a space takes up)
4045XLPSPACEFACTOR (* how many spaces a space takes)
4045XLPFONT (* current font)
)
4045XLPBOTTOM ← 4045XLPDefaultRegionBottom 4045XLPLEFT ← 4045XLPDefaultRegionLeft
4045XLPLINEFEED ← 4045XLPDefaultLineFeedHeight 4045XLPXPOS ← 4045XLPDefaultXPosition
4045XLPYPOS ← 4045XLPDefaultYPosition 4045XLPSPACEFACTOR ← 4045XLPDefaultSpaceFactor)
(RECORD 4045XLPBITMAP (BITMAPDIRTY MONITOR BITMAP BMSTREAM))
]
(/DECLAREDATATYPE (QUOTE 4045XLPDATA)
(QUOTE (WORD WORD WORD WORD WORD FLAG POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((4045XLPDATA 0 (BITS . 15))
(4045XLPDATA 1 (BITS . 15))
(4045XLPDATA 2 (BITS . 15))
(4045XLPDATA 3 (BITS . 15))
(4045XLPDATA 4 (BITS . 15))
(4045XLPDATA 5 (FLAGBITS . 0))
(4045XLPDATA 6 POINTER)
(4045XLPDATA 8 POINTER)
(4045XLPDATA 10 POINTER)
(4045XLPDATA 12 POINTER)
(4045XLPDATA 14 POINTER)
(4045XLPDATA 16 POINTER)
(4045XLPDATA 18 POINTER)
(4045XLPDATA 20 POINTER)
(4045XLPDATA 22 POINTER)
(4045XLPDATA 24 POINTER)))
(QUOTE 26))
(DECLARE: EVAL@COMPILE
(DEFMACRO \4045XLPBackingStream (4045XLPSTREAM)
(BQUOTE (fetch (STREAM F1)
of , 4045XLPSTREAM)))
[DEFMACRO 4045XLP.HAS.BITMAP (4045XLPDATA)
(BQUOTE (ffetch (4045XLPDATA 4045XLPOWNSBITMAPFLG)
of
(\, 4045XLPDATA]
[DEFMACRO 4045XLPPage (4045XLPSTREAM)
(BQUOTE (fetch (STREAM F3)
of
(\, 4045XLPSTREAM]
[DEFMACRO 4045XLPGetErrors (4045XLPSTREAM)
(BQUOTE (fetch (STREAM F2)
of
(\, 4045XLPSTREAM]
[DEFMACRO 4045XLPLandscapeP (4045XLPSTREAM)
(BQUOTE (ffetch (STREAM F4)
of
(\, 4045XLPSTREAM]
[DEFMACRO 4045XLP.HEADING (4045XLPSTREAM)
(BQUOTE (fetch (STREAM F5)
of
(\, 4045XLPSTREAM]
)
)
(/DECLAREDATATYPE (QUOTE 4045XLPDATA)
(QUOTE (WORD WORD WORD WORD WORD FLAG POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((4045XLPDATA 0 (BITS . 15))
(4045XLPDATA 1 (BITS . 15))
(4045XLPDATA 2 (BITS . 15))
(4045XLPDATA 3 (BITS . 15))
(4045XLPDATA 4 (BITS . 15))
(4045XLPDATA 5 (FLAGBITS . 0))
(4045XLPDATA 6 POINTER)
(4045XLPDATA 8 POINTER)
(4045XLPDATA 10 POINTER)
(4045XLPDATA 12 POINTER)
(4045XLPDATA 14 POINTER)
(4045XLPDATA 16 POINTER)
(4045XLPDATA 18 POINTER)
(4045XLPDATA 20 POINTER)
(4045XLPDATA 22 POINTER)
(4045XLPDATA 24 POINTER)))
(QUOTE 26))
(* * Variables and initialization)
(* The NSTO4045Cxxx arrays contain the mappings from the charset specified by xxx to the (one)
charset of 4045.0 C0 allows charcodes <32 for special commands ie. esc's and LF's etc.)
(RPAQ \ASCIITOASCII (READARRAY 256 (QUOTE SMALLPOSP) 0))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
254 255 NIL
)
(RPAQ \NSTO4045NULL (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 NIL
)
(RPAQ \NSTO4045C41 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 48 255 255 45 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 194 205 255 255 255 255 255 255 255 255 255 255 255 255 255 111 111 111
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 NIL
)
(RPAQ \NSTO4045C357 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 32 45 45 45 45 45 39 186 170 171 187 32 32 32 32 255 255 60 62 174 172
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 111 111
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 124 45 43 124 45
43 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
NIL
)
(RPAQ \NSTO4045C356 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 124
255 126 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 NIL
)
(RPAQ \NSTO4045C361 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 49473 49729 49985 50241 50497 50753 51265 51777 52801 49731 49987
51011 52035 53059 53060 49477 49733 49989 50501 51013 51269 52805 53061 255 49991 50759 51015 52039
49992 49481 49737 49993 50249 50505 51017 51273 52809 49994 52043 49740 52044 53068 49742 50254 52046
53070 49487 49743 49999 50255 50511 51279 52559 49746 52050 53074 49747 50003 52051 53075 52052 53076
49493 49749 50005 50261 50517 50773 51285 51797 52565 52821 50007 49497 49753 50009 51289 49754 51034
53082 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 49505
49761 50017 50273 50529 50785 51297 51809 52833 49763 50019 51043 52067 53091 53092 49509 49765 50021
50533 51045 51301 52837 53093 49767 50023 50791 51047 255 50024 49513 49769 50025 50281 50537 255
51305 52841 50026 52075 49772 52076 53100 49774 50286 52078 53102 49519 49775 50031 50287 50543 51311
52591 49778 52082 53106 49779 50035 52083 53107 52084 53108 49525 49781 50037 50293 50549 50805 51317
51829 52597 52853 50039 49529 49785 50041 51321 49786 51066 53114 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 NIL
)
(RPAQ \NSTO4045C46 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 65 66 255 255 255 69 255 70 90 72 255 73
75 255 77 78 255 79 255 255 80 255 255 84 89 255 88 255 255 255 255 255 97 251 255 121 255 255 255 255
255 255 255 105 107 255 255 118 255 111 255 255 112 255 255 255 117 255 120 255 119 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 NIL
)
(RPAQ \NSTO4045C0 (READARRAY 256 (QUOTE SMALLPOSP) 0))
(255 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 36 32
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
126 127 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
255 255 255 255 255 255 255 255 255 255 161 162 163 164 165 255 167 255 169 170 171 172 173 174 175
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 255 193 194 195 196 197 198 199 200
255 202 203 204 205 206 207 208 209 210 211 212 213 255 255 255 255 255 255 220 221 222 223 224 225
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
251 252 253 254 255 NIL
)
(RPAQ \4045WIDTHSARRAY (READARRAY 256 (QUOTE SMALLPOSP) 0))
(30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30
30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 NIL
)
(RPAQQ LINESPERPAGE 57)
(RPAQ? 4045XLP.MONITOR (CREATE.MONITORLOCK (QUOTE 4045XLP)))
(RPAQ? \4045XLP.BITMAPREC )
(RPAQ? 4045XLP.DEFAULTS )
(ADDTOVAR PRINTERTYPES ((4045XLP)
(CANPRINT (4045XLP))
(STATUS TRUE)
(SEND 4045XLPPRINT)
(HOSTNAMEP 4045XLP.HOSTNAMEP)
(BITMAPSCALE 4045XLP.BITMAPSCALE)
(BITMAPFILE (4045XLPBITMAPFILE FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE))))
(ADDTOVAR PRINTFILETYPES (4045XLP (TEST 4045XLPFILEP)
(EXTENSION (4045XLP))
(CONVERSION (TEXT 4045XLP.PRINTTEXT TEDIT
[LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL
NIL NIL
(QUOTE 4045XLP))
(CLOSEF? FILE)
PFILE]
TEDIT \TEDIT.HARDCOPY))))
(* * Initializing stuff)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQ 4045XLPFileHeading (CONCAT (CHARACTER (CHARCODE ESC))
"+P"
(CHARACTER (CHARCODE LF))
(CHARACTER (CHARCODE ESC))
"+P"
(CHARACTER (CHARCODE LF))
(CHARACTER (CHARCODE ESC))
"+X"
(CHARACTER (CHARCODE LF))))
(RPAQ 4045XLPDefaultScale (FQUOTIENT 300 72))
(RPAQQ 4045XLPDefaultSpaceFactor 1)
(RPAQQ 4045XLPDefaultRegionBottom 100)
(RPAQQ 4045XLPDefaultXPosition 0)
(RPAQQ 4045XLPDefaultYPosition 0)
(RPAQQ 4045XLPDefaultRegionLeft 150)
(RPAQQ 4045XLPDefaultPageWidth 2550)
(RPAQQ 4045XLPDefaultPageHeight 3300)
(RPAQQ 4045XLPDefaultLineFeedHeight 51)
(RPAQQ 4045XLPLandscapePageBMRaster 102)
(RPAQQ 4045XLPLandscapePageBMWidth 1632)
(RPAQQ 4045XLPLandscapePageBMHeight 1275)
(RPAQQ 4045XLPDefaultLandscapeCharsPerLine 150)
(RPAQQ 4045XLPDefaultLandscapeTop 2400)
(RPAQQ 4045XLPDefaultLandscapeRight 3150)
(RPAQQ 4045XLPLandscapeHeading 2450)
(RPAQ 4045XLPDefaultLandscapeRegion (CREATEREGION 0 0 3300 2550))
(RPAQQ 4045XLPDefaultLandscapeFontHeight 39)
(RPAQQ 4045XLPDefaultLandscapeFontAscent 31)
(RPAQQ 4045XLPDefaultLandscapeFontDescent 8)
(RPAQQ 4045XLPDefaultLandscapeFontBox 22)
(RPAQQ 4045XLPDefaultLandscapeFontDX 4)
(RPAQ 4045XLPDefaultLandscapeFontWidths (ARRAY 256 (QUOTE WORD)
22 0))
(RPAQQ 4045XLPPortraitHeading 3150)
(RPAQQ 4045XLPPortraitPageBMRaster 80)
(RPAQQ 4045XLPPortraitPageBMWidth 1272)
(RPAQQ 4045XLPPortraitPageBMHeight 1650)
(RPAQQ 4045XLPDefaultPortraitCharsPerLine 115)
(RPAQQ 4045XLPDefaultPortraitTop 3000)
(RPAQQ 4045XLPDefaultPortraitRight 2400)
(RPAQ 4045XLPDefaultPortraitRegion (CREATEREGION 0 0 2550 3300))
(RPAQQ 4045XLPDefaultPortraitFontHeight 50)
(RPAQQ 4045XLPDefaultPortraitFontAscent 40)
(RPAQQ 4045XLPDefaultPortraitFontDescent 10)
(RPAQQ 4045XLPDefaultPortraitFontBox 32)
(RPAQQ 4045XLPDefaultPortraitFontDX 4)
(RPAQ 4045XLPDefaultPortraitFontWidths (ARRAY 256 (QUOTE WORD)
30 0))
(RPAQQ 4045XLPPageBitmapPages 516)
(RPAQ 4045XLP.DOTSPERPOINT (FQUOTIENT 300 72))
(RPAQQ 4045XLP.DOTSPERMICA .122449)
(CONSTANTS [4045XLPFileHeading (CONCAT (CHARACTER (CHARCODE ESC))
"+P"
(CHARACTER (CHARCODE LF))
(CHARACTER (CHARCODE ESC))
"+P"
(CHARACTER (CHARCODE LF))
(CHARACTER (CHARCODE ESC))
"+X"
(CHARACTER (CHARCODE LF]
(4045XLPDefaultScale (FQUOTIENT 300 72))
(4045XLPDefaultSpaceFactor 1)
(4045XLPDefaultRegionBottom 100)
(4045XLPDefaultXPosition 0)
(4045XLPDefaultYPosition 0)
(4045XLPDefaultRegionLeft 150)
(4045XLPDefaultPageWidth 2550)
(4045XLPDefaultPageHeight 3300)
(4045XLPDefaultLineFeedHeight 51)
(4045XLPLandscapePageBMRaster 102)
(4045XLPLandscapePageBMWidth 1632)
(4045XLPLandscapePageBMHeight 1275)
(4045XLPDefaultLandscapeCharsPerLine 150)
(4045XLPDefaultLandscapeTop 2400)
(4045XLPDefaultLandscapeRight 3150)
(4045XLPLandscapeHeading 2450)
(4045XLPDefaultLandscapeRegion (CREATEREGION 0 0 3300 2550))
(4045XLPDefaultLandscapeFontHeight 39)
(4045XLPDefaultLandscapeFontAscent 31)
(4045XLPDefaultLandscapeFontDescent 8)
(4045XLPDefaultLandscapeFontBox 22)
(4045XLPDefaultLandscapeFontDX 4)
(4045XLPDefaultLandscapeFontWidths (ARRAY 256 (QUOTE WORD)
22 0))
(4045XLPPortraitHeading 3150)
(4045XLPPortraitPageBMRaster 80)
(4045XLPPortraitPageBMWidth 1272)
(4045XLPPortraitPageBMHeight 1650)
(4045XLPDefaultPortraitCharsPerLine 115)
(4045XLPDefaultPortraitTop 3000)
(4045XLPDefaultPortraitRight 2400)
(4045XLPDefaultPortraitRegion (CREATEREGION 0 0 2550 3300))
(4045XLPDefaultPortraitFontHeight 50)
(4045XLPDefaultPortraitFontAscent 40)
(4045XLPDefaultPortraitFontDescent 10)
(4045XLPDefaultPortraitFontBox 32)
(4045XLPDefaultPortraitFontDX 4)
(4045XLPDefaultPortraitFontWidths (ARRAY 256 (QUOTE WORD)
30 0))
(4045XLPPageBitmapPages 516)
(4045XLP.DOTSPERPOINT (FQUOTIENT 300 72))
4045XLP.DOTSPERMICA)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\4045XLPINIT)
(push DEFAULTPRINTINGHOST (QUOTE 4045XLP))
(SETQ DEFAULTPRINTERTYPE (QUOTE 4045XLP))
)
(PUTPROPS 4045XLPSTREAM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6942 20463 (\4045XLPINIT 6952 . 12480) (OPEN4045XLPSTREAM 12482 . 15768) (
\CLOSE4045XLPSTREAM 15770 . 16298) (4045.OUTCHARFN 16300 . 17299) (4045.OUTCHARFN1 17301 . 20461)) (
20489 25978 (\CREATE4045FONT 20499 . 22820) (\CREATECHARSET.4045 22822 . 23591) (\SEARCH4045FONTS
23593 . 25116) (\CHANGECHARSET.4045XLP 25118 . 25976)) (26001 33279 (\DSPXPOSITION.4045XLP 26011 .
26471) (\DSPYPOSITION.4045XLP 26473 . 26925) (\DSPBOTTOMMARGIN.4045XLP 26927 . 27356) (
\DSPTOPMARGIN.4045XLP 27358 . 27767) (\DSPLEFTMARGIN.4045XLP 27769 . 28233) (\DSPRIGHTMARGIN.4045XLP
28235 . 28708) (\DSPCLIPPINGREGION.4045XLP 28710 . 29172) (\DSPSPACEFACTOR.4045XLP 29174 . 29999) (
\DSPLINEFEED.4045XLP 30001 . 30620) (\DSPFONT.4045 30622 . 33277)) (33322 40551 (BEGINPAGE.4045XLP
33332 . 34276) (ENDPAGE.4045XLP 34278 . 35123) (NEWPAGE.4045XLP 35125 . 35320) (NEWLINE.4045XLP 35322
. 36231) (SETXY.4045XLP 36233 . 37607) (\MOVETO.4045XLP 37609 . 37764) (\BOLDMODE.4045XLP 37766 .
38094) (\MEDIUMMODE.4045XLP 38096 . 38427) (\FIXLINELENGTH.4045XLP 38429 . 39408) (\CHARWIDTH.4045XLP
39410 . 39952) (\STRINGWIDTH.4045XLP 39954 . 40549)) (40587 46361 (CreateImageData.4045XLP 40597 .
41169) (FixMargins.4045XLP 41171 . 41734) (4045XLP.Error 41736 . 42423) (4045XLPPageNumber 42425 .
42819) (4045XLPIn2700ModeP 42821 . 43109) (\SEND4045XLPCOMMAND 43111 . 43614) (MakePosition.4045XLP
43616 . 44153) (4045XLP.SCALEBRUSH 44155 . 45029) (Landscape.4045XLP 45031 . 45518) (
SendFileHeading.4045XLP 45520 . 45724) (4045XLPHeading 45726 . 46359)) (46391 55694 (
4045XLP.EncodedSixelofBitmap 46401 . 47250) (\BLTSHADE.4045XLP 47252 . 48040) (\4045XLP.ROUND.BITMAP
48042 . 48940) (\SCALEDBITBLT.4045XLP 48942 . 50609) (\GENERICBITBLT.4045XLP 50611 . 52161) (
\BITBLT.4045XLP 52163 . 53536) (\BLACKBOX.4045XLP 53538 . 54836) (\WINDOWCMD.4045XLP 54838 . 55692)) (
55723 61053 (4045XLP.RESET 55733 . 56660) (4045XLP.GETBMSTR 56662 . 57791) (4045XLP.GET.BITMAP 57793
. 58462) (4045XLP.RELEASE.BITMAP 58464 . 59015) (\ScaledBltBigBitmap.4045XLP 59017 . 60494) (
ChangePageBitmap.4045XLP 60496 . 61051)) (61085 66955 (\DRAWCIRCLE.4045XLP 61095 . 61597) (
\FILLCIRCLE.4045XLP 61599 . 61989) (\DRAWPOLYGON.4045XLP 61991 . 62328) (\FILLPOLYGON.4045XLP 62330 .
62821) (\DRAWELLIPSE.4045XLP 62823 . 63386) (\DRAWCURVE.4045XLP 63388 . 63920) (\DRAWLINE.4045XLP
63922 . 64929) (\DRAWLINE1.4045XLP 64931 . 66953)) (66990 81690 (4045XLPFILEP 67000 . 68178) (
4045XLP.BITMAPSCALE 68180 . 68409) (4045XLPPRINT 68411 . 70643) (4045XLPBITMAPFILE 70645 . 74325) (
4045XLP.PRINTTEXT 74327 . 76596) (4045XLP.HOSTNAMEP 76598 . 76785) (4045XLP.CHECK.OUTPUTFILE 76787 .
77199) (4045XLP.PRINTHEADERPAGE 77201 . 79968) (4045XLP.PRINT.ERRORPAGE 79970 . 81385) (4045XLP.PROMPT
81387 . 81688)) (81748 88362 (4045XLP.HELP.GET.PORT 81758 . 83147) (4045XLP.GET.PORT 83149 . 83497) (
4045XLP.RELEASE.PORT 83499 . 83693) (4045XLP.INIT.PORT 83695 . 84570) (4045XLP.INIT.RS232 84572 .
85300) (4045XLP.INIT.TTY 85302 . 85805) (4045XLP.INIT.CENTRONICS 85807 . 86096) (
4045XLP.SET.PARAMETERS 86098 . 88102) (4045XLP.GET.PARAMETERS 88104 . 88360)) (88619 89448 (
FONTCLASSUNPARSE 88629 . 89446)) (89549 91314 (TEDIT.HARDCOPY 89559 . 91312)))))
STOP