(FILECREATED " 6-May-85 21:22:10" {PHYLUM}<STANSBURY>FASTFX80>INTERMEZZO>FASTFX80STREAM.;31 18315
changes to: (FNS \FASTFX80.CHANGEFONT)
previous date: " 6-May-85 16:40:09" {PHYLUM}<STANSBURY>FASTFX80>INTERMEZZO>FASTFX80STREAM.;30
)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FASTFX80STREAMCOMS)
(RPAQQ FASTFX80STREAMCOMS ((DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS FASTFX80STREAM))
(* * FX80STREAM stuff. Redefine CRLF behavior.)
(FILES FX80STREAM)
(FNS \DUMPPAGEBUFFER.FX80)
(* * Imagestream stuff)
(FNS \FASTFX80.INIT OPENFASTFX80STREAM \FASTFX80.CLOSE)
(FNS \FASTFX80.STRINGWIDTH \FASTFX80.CHARWIDTH \FASTFX80.SUBCHARWIDTH
\FASTFX80.FONTCREATE \FASTFX80.CHANGEFONT)
(FNS \FASTFX80.CLIPPINGREGION \FASTFX80.MOVETO \FASTFX80.XPOSITION
\FASTFX80.YPOSITION \FASTFX80.BACKUP.PAPER \FASTFX80.ADVANCE.PAPER)
(GLOBALVARS \FASTFX80.IMAGEOPS)
(P (\FASTFX80.INIT))
(* * Character printing stuff)
(FNS \FASTFX80.OUTCHAR \FASTFX80.BOUT \FASTFX80.LINEFEED \FASTFX80.NEWPAGE
\FASTFX80.TERPRI \FASTFX80.CR \FASTFX80.BACKSPACE)
(* * Other junk)
(CONSTANTS (\FASTFX80.DOTSPERINCH 72)
(\FASTFX80.DOTSPERLINE (TIMES \FASTFX80.DOTSPERINCH 8))
(\FASTFX80.VERTICALDOTSPERPAGE (TIMES \FASTFX80.DOTSPERINCH 11))
(\FASTFX80.PAGESIZE (CREATEREGION 0 0 \FASTFX80.DOTSPERLINE
\FASTFX80.VERTICALDOTSPERPAGE))
(\FASTFX80.LINEHEIGHT 12))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD FASTFX80STREAM STREAM (SUBRECORD STREAM)
(ACCESSFNS (XPOS (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE)))
(ACCESSFNS (YPOS (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE)))
(ACCESSFNS (RS232STREAM (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE)))
(ACCESSFNS (PRINTERFONT (fetch (STREAM F4) of DATUM)
(replace (STREAM F4) of DATUM with NEWVALUE)))
(ACCESSFNS (CLIPPINGREGION (fetch (STREAM IMAGEDATA) of DATUM)
(replace (STREAM IMAGEDATA) of DATUM
with NEWVALUE))))
]
)
(* * FX80STREAM stuff. Redefine CRLF behavior.)
(FILESLOAD FX80STREAM)
(DEFINEQ
(\DUMPPAGEBUFFER.FX80
[LAMBDA (BITMAP FX80STREAM) (* edited: "24-Apr-85 21:53")
(PROG ((WIDTH (BITMAPWIDTH BITMAP))
(WIDTHSUB1 (SUB1 (BITMAPWIDTH BITMAP)))
(HEIGHT (BITMAPHEIGHT BITMAP))
(HEIGHTSUB1 (SUB1 (BITMAPHEIGHT BITMAP)))
(SUBSTREAM (fetch (STREAM F1) of FX80STREAM))
CodedBitColumn)
(\FX80.PRINTERMODE (QUOTE UniDirectionalOn)
SUBSTREAM)
(\FX80.PRINTERMODE (QUOTE EightSpacingOn)
SUBSTREAM)
(* * pack the bitmap into FX80 format)
(for TopOfColumn from HEIGHTSUB1 to 0 by -8 bind BottomOfColumn
do (SETQ BottomOfColumn (IDIFFERENCE TopOfColumn 7))
(* (GRAPHICS.MODE WIDTH))
(\FX80.GRAPHICSMODE WIDTH SUBSTREAM)
(for Column from 0 to WIDTHSUB1
do (SETQ CodedBitColumn 0)
[for BitNumber from TopOfColumn to BottomOfColumn by -1
do (SETQ CodedBitColumn (LOGOR CodedBitColumn
(LLSH (BITMAPBIT BITMAP Column BitNumber)
(IDIFFERENCE 7 (IDIFFERENCE TopOfColumn
BitNumber]
(BOUT SUBSTREAM CodedBitColumn))
(* * Output CR and LF to get to beginning of next line.)
(BOUT SUBSTREAM (CHARCODE CR))
(BOUT SUBSTREAM (CHARCODE LF)))
(\FX80.PRINTERMODE (QUOTE UniDirectionalOff)
SUBSTREAM])
)
(* * Imagestream stuff)
(DEFINEQ
(\FASTFX80.INIT
[LAMBDA NIL (* jsb "29-Apr-85 20:48")
(* * comment)
(SETQ \FASTFX80.IMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE FASTFX80)
IMFONT ←(FUNCTION \FASTFX80.CHANGEFONT)
IMLEFTMARGIN ←(FUNCTION NILL)
IMRIGHTMARGIN ←(FUNCTION NILL)
IMLINEFEED ←(FUNCTION NILL)
IMTERPRI ←(FUNCTION \FASTFX80.TERPRI)
IMXPOSITION ←(FUNCTION \FASTFX80.XPOSITION)
IMYPOSITION ←(FUNCTION \FASTFX80.YPOSITION)
IMCLOSEFN ←(FUNCTION NILL)
IMMOVETO ←(FUNCTION \FASTFX80.MOVETO)
IMDRAWCURVE ←(FUNCTION NILL)
IMFILLCIRCLE ←(FUNCTION NILL)
IMDRAWLINE ←(FUNCTION NILL)
IMDRAWELLIPSE ←(FUNCTION NILL)
IMDRAWCIRCLE ←(FUNCTION NILL)
IMBITBLT ←(FUNCTION NILL)
IMBLTSHADE ←(FUNCTION NILL)
IMNEWPAGE ←(FUNCTION \FASTFX80.NEWPAGE)
IMSCALE ←(FUNCTION [LAMBDA NIL 1])
IMSPACEFACTOR ←(FUNCTION NILL)
IMFONTCREATE ←(QUOTE FASTFX80)
IMCOLOR ←(FUNCTION NILL)
IMBACKCOLOR ←(FUNCTION NILL)
IMOPERATION ←(FUNCTION NILL)
IMSTRINGWIDTH ←(FUNCTION \FASTFX80.STRINGWIDTH)
IMCHARWIDTH ←(FUNCTION \FASTFX80.CHARWIDTH)
IMCLIPPINGREGION ←(FUNCTION \FASTFX80.CLIPPINGREGION)
IMRESET ←(FUNCTION NILL)
IMDRAWPOLYGON ←(FUNCTION NILL)
IMFILLPOLYGON ←(FUNCTION NILL)
IMSCALEDBITBLT ←(FUNCTION NILL)))
(DECLARE (GLOBALVARS IMAGESTREAMTYPES))
[if (NOT (ASSOC (QUOTE FASTFX80)
IMAGESTREAMTYPES))
then (push IMAGESTREAMTYPES (COPY (QUOTE (FASTFX80 (OPENSTREAM OPENFASTFX80STREAM)
(FONTCREATE \FASTFX80.FONTCREATE)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES]
(DECLARE (GLOBALVARS PRINTERTYPES))
[if (NOT (SASSOC (QUOTE (FASTFX80 FASTEPSON))
PRINTERTYPES))
then (push PRINTERTYPES (COPY (QUOTE ((FASTFX80 FASTEPSON)
(CANPRINT (TEXT))
(STATUS TRUE)
(PROPERTIES NILL]
(DECLARE (GLOBALVARS PRINTFILETYPES))
[if (NOT (ASSOC (QUOTE FASTFX80)
PRINTFILETYPES))
then (push PRINTFILETYPES (COPY (QUOTE (FASTFX80 (TEST NILL)
(EXTENSION (FASTFX80 FASTEPSON]
(* * For reasons which I do not understand, this has to be there or else it chokes on the defaultfont fontclass.)
(DEFAULTFONT (QUOTE FASTFX80)
(QUOTE (GACHA 10 MRR))
(QUOTE NEW))
T])
(OPENFASTFX80STREAM
[LAMBDA (FILENAME OPTIONS) (* jsb "29-Apr-85 21:20")
(* * comment)
(LET [(STREAM (create FASTFX80STREAM
FULLFILENAME ←(MKATOM (U-CASE FILENAME))
DEVICE ←(create FDEV
CLOSEFILE ←(FUNCTION \FASTFX80.CLOSE)
BOUT ←(FUNCTION \FASTFX80.BOUT))
ACCESS ←(QUOTE OUTPUT)
OUTCHARFN ←(FUNCTION \FASTFX80.OUTCHAR)
IMAGEOPS ← \FASTFX80.IMAGEOPS
XPOS ← 0
YPOS ←(SUB1 \FASTFX80.VERTICALDOTSPERPAGE)
CLIPPINGREGION ←(COPY \FASTFX80.PAGESIZE)
RS232STREAM ←(OPENSTREAM FILENAME (QUOTE OUTPUT)
(QUOTE NEW)
8
(BQUOTE ((BaudRate , (OR FX80BAUDRATE 9600))
(BitsPerSerialChar 8)
(NoOfStopBits 1)
(ModemControl DTR]
(\FASTFX80.CHANGEFONT STREAM (DEFAULTFONT (QUOTE FASTFX80)))
STREAM])
(\FASTFX80.CLOSE
[LAMBDA (STREAM) (* edited: "23-Apr-85 17:43")
(* * comment)
(\FASTFX80.OUTCHAR STREAM (CHARCODE CR))
(\FASTFX80.OUTCHAR STREAM (CHARCODE ↑L))
(CLOSEF (fetch RS232STREAM of STREAM))
(fetch FULLFILENAME of STREAM])
)
(DEFINEQ
(\FASTFX80.STRINGWIDTH
[LAMBDA (STREAM STRING) (* edited: "23-Apr-85 16:42")
(* * comment)
(for CHARCODE instring STRING sum (if (EQ CHARCODE (CHARCODE BS))
then (MINUS (\FASTFX80.CHARWIDTH STREAM (CHARCODE BS)))
else (\FASTFX80.CHARWIDTH STREAM CHARCODE])
(\FASTFX80.CHARWIDTH
[LAMBDA (STREAM CHARCODE) (* jsb "29-Apr-85 21:36")
(* * comment)
(\FASTFX80.SUBCHARWIDTH CHARCODE (FONTPROP (fetch PRINTERFONT of STREAM)
(QUOTE SIZE])
(\FASTFX80.SUBCHARWIDTH
[LAMBDA (CHARCODE SIZE) (* jsb "29-Apr-85 21:36")
(* * comment)
(if (OR (GEQ CHARCODE 27)
(EQ CHARCODE (CHARCODE BS)))
then (if (GREATERP SIZE 12)
then 14
else 7)
else 0])
(\FASTFX80.FONTCREATE
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* jsb "29-Apr-85 21:36")
(* * Return fontdescriptor for TEdit to play with.)
(create FONTDESCRIPTOR
FONTDEVICE ←(QUOTE FASTFX80)
FONTFAMILY ← FAMILY
FONTSIZE ← SIZE
FONTFACE ← FACE
ROTATION ← ROTATION
FONTSCALE ← 1
\SFWidths ←(LET ((WIDTHS (ARRAY 256 (QUOTE SMALLP)
0 0)))
(for C from 0 to 255 do (SETA WIDTHS C (\FASTFX80.SUBCHARWIDTH C SIZE)))
WIDTHS)
\SFHeight ← 9
\SFAscent ← 7
\SFDescent ← 2])
(\FASTFX80.CHANGEFONT
[LAMBDA (STREAM FONT) (* hts: " 6-May-85 21:07")
(* * comment)
(if (NULL FONT)
then (fetch PRINTERFONT of STREAM)
else (SETQ FONT (FONTCREATE FONT NIL NIL NIL (QUOTE FASTFX80)))
[LET [[ITALICP (FMEMB (QUOTE ITALIC)
(FONTPROP FONT (QUOTE FACE]
(BOLDP (FMEMB (QUOTE BOLD)
(FONTPROP FONT (QUOTE FACE]
(* * Tell printer whether to print italics or not)
(\FASTFX80.BOUT STREAM (CHARCODE ESC))
(\FASTFX80.BOUT STREAM (if ITALICP
then (CHARCODE 4)
else (CHARCODE 5)))
(* * Inform printer of boldness and new font size: Pica for regular sized fonts, Expanded Pica for large fonts)
(\FASTFX80.BOUT STREAM (CHARCODE ESC))
(\FASTFX80.BOUT STREAM (CHARCODE !))
(\FASTFX80.BOUT STREAM (if (GREATERP (FONTPROP FONT (QUOTE SIZE))
12)
then (if BOLDP
then (CHARCODE *)
else (CHARCODE SP))
else (if BOLDP
then (CHARCODE H)
else (CHARCODE @]
(LET ((OLDFONT (fetch PRINTERFONT of STREAM)))
(* * record new font in stream)
(replace PRINTERFONT of STREAM with FONT)
(* * Return old font)
OLDFONT])
)
(DEFINEQ
(\FASTFX80.CLIPPINGREGION
[LAMBDA (STREAM REGION) (* edited: "23-Apr-85 15:32")
(* * Returns old clipping region and sets new one.)
(LET ((OLDCLIP (fetch CLIPPINGREGION of STREAM))
NEWCLIP)
(if (AND (REGIONP REGION)
(SETQ NEWCLIP (INTERSECTREGIONS \FASTFX80.PAGESIZE REGION)))
then (replace CLIPPINGREGION of STREAM with NEWCLIP))
OLDCLIP])
(\FASTFX80.MOVETO
[LAMBDA (STREAM X Y) (* edited: "23-Apr-85 00:28")
(* * comment)
(CONS (\FASTFX80.XPOSITION STREAM X)
(\FASTFX80.YPOSITION STREAM Y])
(\FASTFX80.XPOSITION
[LAMBDA (STREAM XPOS) (* hts: " 6-May-85 16:39")
(* * comment)
(LET ((OLDXPOS (fetch XPOS of STREAM)))
[if (FIXP XPOS)
then
(* * Jump to beginning of line if that would reduce the number of spaces/backspaces that need to be sent to the
printer)
(if (LESSP (ABS XPOS)
(ABS (DIFFERENCE XPOS OLDXPOS)))
then (\FASTFX80.CR STREAM))
(* * Space or backspace till new x-pos approximates desired one)
(LET [(SPACESIZE (\FASTFX80.CHARWIDTH STREAM (CHARCODE SP]
(if (GREATERP XPOS (fetch XPOS of STREAM))
then (while (GREATERP (DIFFERENCE XPOS (fetch XPOS of STREAM))
(ADD1 (FOLDLO SPACESIZE 2)))
do (\FASTFX80.OUTCHAR STREAM (CHARCODE SP)))
else (while (GREATERP (DIFFERENCE (fetch XPOS of STREAM)
XPOS)
(FOLDHI SPACESIZE 2))
do (\FASTFX80.OUTCHAR STREAM (CHARCODE BS]
OLDXPOS])
(\FASTFX80.YPOSITION
[LAMBDA (STREAM YPOS) (* edited: "23-Apr-85 15:37")
(* * comment)
(LET ((OLDYPOS (fetch YPOS of STREAM)))
(if (FIXP YPOS)
then [if (INSIDEP (fetch CLIPPINGREGION of STREAM)
(fetch XPOS of STREAM)
(fetch YPOS of STREAM))
then (if (LESSP YPOS OLDYPOS)
then (\FASTFX80.ADVANCE.PAPER STREAM (DIFFERENCE OLDYPOS YPOS))
elseif (GREATERP YPOS OLDYPOS)
then (\FASTFX80.BACKUP.PAPER STREAM (DIFFERENCE YPOS OLDYPOS]
(replace YPOS of STREAM with YPOS))
OLDYPOS])
(\FASTFX80.BACKUP.PAPER
[LAMBDA (STREAM DOTS) (* edited: "23-Apr-85 03:51")
(* * comment)
(SETQ DOTS (TIMES 3 DOTS))
(while (GREATERP DOTS 0)
do (\FASTFX80.BOUT STREAM (CHARCODE ESC))
(\FASTFX80.BOUT STREAM (CHARCODE j))
(\FASTFX80.BOUT STREAM (LET ((MAXBACKUP (MIN DOTS 255)))
(add DOTS (MINUS MAXBACKUP))
MAXBACKUP])
(\FASTFX80.ADVANCE.PAPER
[LAMBDA (STREAM DOTS) (* edited: "23-Apr-85 03:51")
(* * comment)
(SETQ DOTS (TIMES 3 DOTS))
(while (GREATERP DOTS 0)
do (\FASTFX80.BOUT STREAM (CHARCODE ESC))
(\FASTFX80.BOUT STREAM (CHARCODE J))
(\FASTFX80.BOUT STREAM (LET ((MAXADVANCE (MIN DOTS 255)))
(add DOTS (MINUS MAXADVANCE))
MAXADVANCE])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FASTFX80.IMAGEOPS)
)
(\FASTFX80.INIT)
(* * Character printing stuff)
(DEFINEQ
(\FASTFX80.OUTCHAR
[LAMBDA (FASTFX80STREAM CHARCODE) (* jsb "29-Apr-85 22:33")
(* * comment)
(SELCHARQ CHARCODE
(↑L (\FASTFX80.NEWPAGE FASTFX80STREAM))
(CR (\FASTFX80.TERPRI FASTFX80STREAM))
(LF (\FASTFX80.LINEFEED FASTFX80STREAM))
(BS (\FASTFX80.BACKSPACE FASTFX80STREAM))
(LET ((CHARWIDTH (\FASTFX80.CHARWIDTH FASTFX80STREAM CHARCODE)))
(if (INSIDEP (fetch CLIPPINGREGION of FASTFX80STREAM)
(PLUS (fetch XPOS of FASTFX80STREAM)
CHARWIDTH)
(fetch YPOS of FASTFX80STREAM))
then (\FASTFX80.BOUT FASTFX80STREAM CHARCODE))
(add (fetch XPOS of FASTFX80STREAM)
CHARWIDTH)))
CHARCODE])
(\FASTFX80.BOUT
[LAMBDA (FASTFX80STREAM CHARCODE) (* edited: "23-Apr-85 13:28")
(* * comment)
(BOUT (fetch RS232STREAM of FASTFX80STREAM)
CHARCODE])
(\FASTFX80.LINEFEED
[LAMBDA (STREAM) (* edited: "22-Apr-85 23:46")
(* * comment)
(\FASTFX80.BOUT STREAM (CHARCODE LF))
(add (fetch YPOS of STREAM)
(MINUS \FASTFX80.LINEHEIGHT))
(CHARCODE LF])
(\FASTFX80.NEWPAGE
[LAMBDA (STREAM) (* edited: "23-Apr-85 19:03")
(* * comment)
(\FASTFX80.BOUT STREAM (CHARCODE ↑L))
(replace XPOS of STREAM with 0)
(replace YPOS of STREAM with (SUB1 \FASTFX80.VERTICALDOTSPERPAGE))
(CHARCODE ↑L])
(\FASTFX80.TERPRI
[LAMBDA (STREAM) (* edited: "23-Apr-85 17:59")
(* * comment)
(\FASTFX80.CR STREAM)
(\FASTFX80.LINEFEED STREAM)
(CHARCODE CR])
(\FASTFX80.CR
[LAMBDA (STREAM) (* edited: "23-Apr-85 17:59")
(* * comment)
(\FASTFX80.BOUT STREAM (CHARCODE CR))
(replace XPOS of STREAM with 0)
(CHARCODE CR])
(\FASTFX80.BACKSPACE
[LAMBDA (STREAM) (* edited: "23-Apr-85 18:15")
(* * comment)
(if (INSIDEP (fetch CLIPPINGREGION of STREAM)
(fetch XPOS of STREAM)
(fetch YPOS of STREAM))
then (\FASTFX80.BOUT STREAM (CHARCODE BS)))
[add (fetch XPOS of STREAM)
(MINUS (\FASTFX80.CHARWIDTH STREAM (CHARCODE BS]
(CHARCODE BS])
)
(* * Other junk)
(DECLARE: EVAL@COMPILE
(RPAQQ \FASTFX80.DOTSPERINCH 72)
(RPAQ \FASTFX80.DOTSPERLINE (TIMES \FASTFX80.DOTSPERINCH 8))
(RPAQ \FASTFX80.VERTICALDOTSPERPAGE (TIMES \FASTFX80.DOTSPERINCH 11))
(RPAQ \FASTFX80.PAGESIZE (CREATEREGION 0 0 \FASTFX80.DOTSPERLINE \FASTFX80.VERTICALDOTSPERPAGE))
(RPAQQ \FASTFX80.LINEHEIGHT 12)
(CONSTANTS (\FASTFX80.DOTSPERINCH 72)
(\FASTFX80.DOTSPERLINE (TIMES \FASTFX80.DOTSPERINCH 8))
(\FASTFX80.VERTICALDOTSPERPAGE (TIMES \FASTFX80.DOTSPERINCH 11))
(\FASTFX80.PAGESIZE (CREATEREGION 0 0 \FASTFX80.DOTSPERLINE \FASTFX80.VERTICALDOTSPERPAGE))
(\FASTFX80.LINEHEIGHT 12))
)
(PUTPROPS FASTFX80STREAM COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2458 4031 (\DUMPPAGEBUFFER.FX80 2468 . 4029)) (4062 8119 (\FASTFX80.INIT 4072 . 6817) (
OPENFASTFX80STREAM 6819 . 7764) (\FASTFX80.CLOSE 7766 . 8117)) (8120 11239 (\FASTFX80.STRINGWIDTH 8130
. 8512) (\FASTFX80.CHARWIDTH 8514 . 8783) (\FASTFX80.SUBCHARWIDTH 8785 . 9117) (\FASTFX80.FONTCREATE
9119 . 9743) (\FASTFX80.CHANGEFONT 9745 . 11237)) (11240 14773 (\FASTFX80.CLIPPINGREGION 11250 . 11730
) (\FASTFX80.MOVETO 11732 . 11967) (\FASTFX80.XPOSITION 11969 . 13113) (\FASTFX80.YPOSITION 13115 .
13825) (\FASTFX80.BACKUP.PAPER 13827 . 14296) (\FASTFX80.ADVANCE.PAPER 14298 . 14771)) (14897 17568 (
\FASTFX80.OUTCHAR 14907 . 15705) (\FASTFX80.BOUT 15707 . 15926) (\FASTFX80.LINEFEED 15928 . 16230) (
\FASTFX80.NEWPAGE 16232 . 16588) (\FASTFX80.TERPRI 16590 . 16826) (\FASTFX80.CR 16828 . 17092) (
\FASTFX80.BACKSPACE 17094 . 17566)))))
STOP