(FILECREATED " 5-Nov-85 20:05:06" {ERIS}<LISPCORE>LIBRARY>FASTFX80STREAM.;5 19196
changes to: (FNS \FASTFX80.FONTCREATE \FASTFX80.SUBCHARWIDTH)
previous date: " 3-Oct-85 16:43:47" {ERIS}<LISPCORE>LIBRARY>FASTFX80STREAM.;3)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FASTFX80STREAMCOMS)
(RPAQQ FASTFX80STREAMCOMS [(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS FASTFX80STREAM))
(* * Imagestream stuff)
(FNS \CREATECHARSET.FASTFX80 \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)
(* * 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: DONTEVAL@LOAD DOCOPY (P (\FASTFX80.INIT])
(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))))
]
)
(* * Imagestream stuff)
(DEFINEQ
(\CREATECHARSET.FASTFX80
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* hdj "27-Sep-85 17:35")
(* * just a dummy definition. Press should not ever be trying to change character sets, since the fonts only contain
charset 0 (roughly))
(if (NEQ 0 CHARSET)
then (ERROR "FX-80 does not support NS characters."))
(create CHARSETINFO
WIDTHS ←(ffetch (ARRAYP BASE) of (ffetch \SFWidths of FONTDESC))
OFFSETS ←(AND (ffetch \SFOffsets of FONTDESC)
(ffetch (ARRAYP BASE) of (ffetch \SFOffsets of FONTDESC)))
IMAGEWIDTHS ←(ffetch (ARRAYP BASE) of (ffetch \SFWidths of FONTDESC))
CHARSETBITMAP ← NIL
YWIDTHS ←[AND (ffetch \SFWidthsY of FONTDESC)
(OR (FIXP (ffetch \SFWidthsY of FONTDESC))
(ffetch (ARRAYP BASE) of (ffetch \SFWidthsY of FONTDESC]
CHARSETASCENT ←(ffetch \SFAscent of FONTDESC)
CHARSETDESCENT ←(ffetch \SFDescent of FONTDESC])
(\FASTFX80.INIT
[LAMBDA NIL (* hdj "27-Sep-85 17:43")
(DECLARE (GLOBALVARS IMAGESTREAMTYPES PRINTERTYPES PRINTFILETYPES \FASTFX80.IMAGEOPS))
(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)))
[push IMAGESTREAMTYPES (COPY (QUOTE (FASTFX80 (OPENSTREAM OPENFASTFX80STREAM)
(FONTCREATE \FASTFX80.FONTCREATE)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
(CREATECHARSET \CREATECHARSET.FASTFX80]
[push PRINTERTYPES (COPY (QUOTE ((FASTFX80 FASTEPSON)
(CANPRINT (TEXT))
(STATUS TRUE)
(PROPERTIES NILL]
[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 RDTBL) (* hdj "30-Sep-85 16:07")
(* * comment)
(COND
[RDTBL (bind (FIRSTFLG ← T)
(SA ←(fetch READSA of RDTBL))
(PCTWIDTH ←(\FASTFX80.CHARWIDTH STREAM (CHARCODE %%)))
SYN for CHARCODE instring STRING
sum (PROG1 (IPLUS (COND
((AND (fetch (READCODE ESCQUOTE) of (SETQ SYN (\SYNCODE SA
CHARCODE)))
(OR FIRSTFLG (fetch (READCODE INNERESCQUOTE) of SYN)))
PCTWIDTH)
(T 0))
(\FASTFX80.CHARWIDTH STREAM C))
(SETQ FIRSTFLG NIL]
(T (bind CSET for C inatom STRING sum (\FASTFX80.CHARWIDTH STREAM C])
(\FASTFX80.CHARWIDTH
[LAMBDA (STREAM CHARCODE) (* hdj " 3-Oct-85 16:34")
(* * comment)
(LET [(WIDTH (\FASTFX80.SUBCHARWIDTH (SELCHARQ CHARCODE
(357,146
(* bullet)
(CHARCODE *))
(357,45
(* em-dash)
95)
(357,44
(* en-dash)
45)
(\CHAR8CODE CHARCODE))
(FONTPROP (fetch PRINTERFONT of STREAM)
(QUOTE SIZE]
(if (EQ CHARCODE (CHARCODE BS))
then (IMINUS WIDTH)
else WIDTH])
(\FASTFX80.SUBCHARWIDTH
[LAMBDA (CHARCODE SIZE) (* hdj " 5-Nov-85 15:49")
(LET ((WIDTH (if (OR (IGEQ CHARCODE 31)
(EQ CHARCODE (CHARCODE BS)))
then (if (GREATERP SIZE 12)
then 14
else 7)
else 0)))
(if (EQ CHARCODE (CHARCODE BS))
then (IMINUS WIDTH)
else WIDTH])
(\FASTFX80.FONTCREATE
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET) (* hdj " 5-Nov-85 20:04")
(* * Return fontdescriptor)
(LET ((FONTDESC (create FONTDESCRIPTOR
FONTDEVICE ←(QUOTE FASTFX80)
FONTFAMILY ← FAMILY
FONTSIZE ← SIZE
FONTFACE ← FACE
ROTATION ← ROTATION
FONTSCALE ← 1
\SFWidths ←(LET ((WIDTHS (ARRAY 256 (QUOTE SMALLP)
0 0)))
(* see, there's this hack involving BS being negative
units wide...)
(for C from 0 to 255
do (SETA WIDTHS C (\FASTFX80.SUBCHARWIDTH
C SIZE))
when (NEQ C (CHARCODE BS)))
WIDTHS)
\SFHeight ← 9
\SFAscent ← 7
\SFDescent ← 2)))
(if (\GETCHARSETINFO CHARSET FONTDESC T)
then FONTDESC
else NIL])
(\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])
)
(* * Character printing stuff)
(DEFINEQ
(\FASTFX80.OUTCHAR
[LAMBDA (FASTFX80STREAM CHARCODE) (* hdj "30-Sep-85 16:07")
(* * comment)
(SELCHARQ CHARCODE
(↑L (\FASTFX80.NEWPAGE FASTFX80STREAM))
(CR (\FASTFX80.TERPRI FASTFX80STREAM))
(LF (\FASTFX80.LINEFEED FASTFX80STREAM))
(BS (\FASTFX80.BACKSPACE FASTFX80STREAM))
(357,146 (* bullet)
(\FASTFX80.OUTCHAR FASTFX80STREAM (CHARCODE *)))
(357,45 (* em-dash)
(\FASTFX80.OUTCHAR FASTFX80STREAM 95))
(357,44 (* en-dash)
(\FASTFX80.OUTCHAR FASTFX80STREAM 45))
(LET* ((8CHAR (\CHAR8CODE CHARCODE))
(CHARWIDTH (\FASTFX80.CHARWIDTH FASTFX80STREAM 8CHAR)))
(if (INSIDEP (fetch CLIPPINGREGION of FASTFX80STREAM)
(PLUS (fetch XPOS of FASTFX80STREAM)
CHARWIDTH)
(fetch YPOS of FASTFX80STREAM))
then (\FASTFX80.BOUT FASTFX80STREAM 8CHAR))
(add (fetch XPOS of FASTFX80STREAM)
CHARWIDTH)))
8CHAR])
(\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))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\FASTFX80.INIT)
)
(PUTPROPS FASTFX80STREAM COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2349 7259 (\CREATECHARSET.FASTFX80 2359 . 3516) (\FASTFX80.INIT 3518 . 5957) (
OPENFASTFX80STREAM 5959 . 6904) (\FASTFX80.CLOSE 6906 . 7257)) (7260 11753 (\FASTFX80.STRINGWIDTH 7270
. 8054) (\FASTFX80.CHARWIDTH 8056 . 8852) (\FASTFX80.SUBCHARWIDTH 8854 . 9286) (\FASTFX80.FONTCREATE
9288 . 10257) (\FASTFX80.CHANGEFONT 10259 . 11751)) (11754 15287 (\FASTFX80.CLIPPINGREGION 11764 .
12244) (\FASTFX80.MOVETO 12246 . 12481) (\FASTFX80.XPOSITION 12483 . 13627) (\FASTFX80.YPOSITION 13629
. 14339) (\FASTFX80.BACKUP.PAPER 14341 . 14810) (\FASTFX80.ADVANCE.PAPER 14812 . 15285)) (15325 18398
(\FASTFX80.OUTCHAR 15335 . 16535) (\FASTFX80.BOUT 16537 . 16756) (\FASTFX80.LINEFEED 16758 . 17060) (
\FASTFX80.NEWPAGE 17062 . 17418) (\FASTFX80.TERPRI 17420 . 17656) (\FASTFX80.CR 17658 . 17922) (
\FASTFX80.BACKSPACE 17924 . 18396)))))
STOP