(FILECREATED "20-Nov-84 14:34:37" {ERIS}<LISPNEW>SOURCES>INTERPRESS.;5 99737
changes to: (FNS \DRAWCURVE.IP)
previous date: "14-Nov-84 17:26:15" {ERIS}<LISPNEW>SOURCES>INTERPRESS.;4)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT INTERPRESSCOMS)
(RPAQQ INTERPRESSCOMS [(* Literal interface)
[DECLARE: DONTCOPY (* Change (or remove)
when full IP-82 exists on printers)
(CONSTANTS (ENCODING (QUOTE IP-82]
(COMS (* Rational operations and useful constants)
(FNS \RTIMES2 \RPLUS2 RMINUS CREATERATIONAL RATIONALTOINTEGER)
(DECLARE: DONTCOPY (CONSTANTS * RATIONALS))
(RECORDS RATIONAL))
(FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP
APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP
EXTRACTBYTE.IP)
(* Operator interface)
(FNS BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CONCAT.IP CONCATT.IP ENDMASTER.IP
ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLTRAJECTORY.IP FSET.IP GETFRAMEVAR.IP
INITIALIZEMASTER.IP ISET.IP LINETO.IP MASKSTROKE.IP MOVETO.IP ROTATE.IP SCALE.IP
SCALE2.IP SETFONT.IP SETSPACE.IP SETXREL.IP SETX.IP SETXY.IP SETXYREL.IP SETY.IP
SETYREL.IP SHOW.IP TRAJECTORY.IP TRANS.IP TRANSLATE.IP)
(* DIG interface)
(FNS DEFINEFONT.IP FONTNAME.IP HEADINGOP.IP INTERPRESS.BITMAPSCALE INTERPRESS.OUTCHARFN
INTERPRESSFILEP MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM
SETUPFONTS.IP SHOWBITMAP.IP SHOWBITMAP1.IP \CHARWIDTH.IP \CLOSEIPSTREAM \DRAWCIRCLE.IP
\DRAWCURVE.IP \IPCURVE2 \DRAWELLIPSE.IP \DRAWLINE.IP \DSPBOTTOMMARGIN.IP \DSPFONT.IP
\DSPLEFTMARGIN.IP \DSPLINEFEED.IP \DSPRIGHTMARGIN.IP \DSPSPACEFACTOR.IP \DSPTOPMARGIN.IP
\DSPXPOSITION.IP \DSPYPOSITION.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP
\STRINGWIDTH.IP)
(FNS \INTERPRESSINIT)
(FNS SCALEREGION)
[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS (DEFAULTPAGEREGION (SCALEREGION 2540
(CREATEREGION
1.1 .75
(FDIFFERENCE
7.5 1.1)
(FDIFFERENCE
10.5 .75]
(* Interpress encoding values)
(DECLARE: DONTCOPY (CONSTANTS MAXSEGSPERTRAJECTORY)
(CONSTANTS * NONPRIMS)
(CONSTANTS * SEQUENCETYPES)
(CONSTANTS * IPTYPES)
(CONSTANTS * OPERATORS)
(CONSTANTS * TOKENFORMATS)
(CONSTANTS * IMAGERVARIABLES)
(CONSTANTS * STROKEENDS)
(CONSTANTS * IP82CONSTANTS))
(DECLARE: DONTCOPY (MACROS APPENDBYTE.IP APPENDOP.IP .IPFONTNAME.)
(RECORDS IPSTREAM INTERPRESSDATA))
(INITRECORDS IPSTREAM INTERPRESSDATA)
(FNS INTERPRESSBITMAP)
(ALISTS (IMAGESTREAMTYPES INTERPRESS))
[ADDVARS [PRINTERTYPES ((INTERPRESS 8044)
(CANPRINT (INTERPRESS))
(STATUS NSPRINTER.STATUS)
(PROPERTIES NSPRINTER.PROPERTIES)
(SEND NSPRINT)
(BITMAPSCALE INTERPRESS.BITMAPSCALE)
(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE]
(PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP)
(EXTENSION (IP IPR INTERPRESS))
(CONVERSION (TEXT MAKEINTERPRESS TEDIT
(LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM
FILE))
(TEDIT.FORMAT.HARDCOPY
FILE PFILE T NIL NIL NIL
(QUOTE INTERPRESS))
(CLOSEF? FILE)
PFILE]
(INITVARS (DEFAULT.INTERPRESS.BITMAP.ROTATION 90))
(COMS (* NS Character Encoding)
(DECLARE: DONTCOPY (MACROS NSCHAR NSCHARCODE NSCHARSET)
(CONSTANTS (NSCHARSETSHIFT 255)))
(FNS NSMAP \COERCEASCIITONSFONT \CREATEINTERPRESSFONT \SEARCHINTERPRESSFONTS)
(INITVARS (ASCIITONSTRANSLATIONS))
(* Catch the GACHA10 and any BI coercions to MODERN)
(ADDVARS (ASCIITONSTRANSLATIONS (GACHA)
(CLASSIC)
(TIMESROMAN)
(HELVETICA)
(HIPPO HIPPOTONSARRAY CLASSIC)
(CYRILLIC CYRILLICTONSARRAY CLASSIC)))
(UGLYVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT])
(* Literal interface)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ ENCODING IP-82)
(CONSTANTS (ENCODING (QUOTE IP-82)))
)
)
(* Rational operations and useful constants)
(DEFINEQ
(\RTIMES2
[LAMBDA (R1 R2) (* rmk: "21-JUL-82 17:51")
(* Rational multiply)
(COND
[(FIXP R1)
(COND
((FIXP R2)
(ITIMES R1 R2))
(T [COND
((FLOATP R2)
(SETQ R2 (MAKERATIONAL R2]
(COND
((IEQP R1 (fetch DENOMINATOR of R2))
(fetch NUMERATOR of R2))
(T (create RATIONAL
NUMERATOR ←(ITIMES R1 (fetch NUMERATOR of R2))
DENOMINATOR ←(fetch DENOMINATOR of R2]
(T [COND
((FLOATP R1)
(SETQ R1 (MAKERATIONAL R1]
(COND
[(FIXP R2)
(COND
((IEQP R2 (fetch DENOMINATOR of R1))
(fetch NUMERATOR of R1))
(T (create RATIONAL
NUMERATOR ←(TIMES R2 (fetch NUMERATOR of R1))
DENOMINATOR ←(fetch DENOMINATOR of R1]
((IEQP (fetch NUMERATOR of R1)
(fetch DENOMINATOR of R2))
(create RATIONAL
NUMERATOR ←(fetch NUMERATOR of R2)
DENOMINATOR ←(fetch DENOMINATOR of R1)))
((IEQP (fetch DENOMINATOR of R1)
(fetch NUMERATOR of R2))
(create RATIONAL
NUMERATOR ←(fetch NUMERATOR of R1)
DENOMINATOR ←(fetch DENOMINATOR of R2)))
(T (create RATIONAL
NUMERATOR ←(ITIMES (fetch NUMERATOR of R1)
(fetch NUMERATOR of R2))
DENOMINATOR ←(ITIMES (fetch DENOMINATOR of R1)
(fetch DENOMINATOR of R2])
(\RPLUS2
[LAMBDA (R1 R2) (* rmk: "21-JUL-82 17:57")
(* Rational multiply)
(COND
[(FIXP R1)
(COND
((FIXP R2)
(IPLUS R1 R2))
(T [COND
((FLOATP R2)
(SETQ R2 (MAKERATIONAL R2]
(create RATIONAL
NUMERATOR ←(IPLUS (fetch NUMERATOR of R2)
(ITIMES R1 (fetch DENOMINATOR of R2)))
DENOMINATOR ←(fetch DENOMINATOR of R2]
(T [COND
((FLOATP R1)
(SETQ R1 (MAKERATIONAL R1]
(COND
((FIXP R2)
(create RATIONAL
NUMERATOR ←(IPLUS (fetch NUMERATOR of R1)
(ITIMES R2 (fetch DENOMINATOR of R1)))
DENOMINATOR ←(fetch DENOMINATOR of R1)))
((IEQP (fetch DENOMINATOR of R1)
(fetch DENOMINATOR of R2))
(create RATIONAL
NUMERATOR ←(IPLUS (fetch NUMERATOR of R1)
(fetch NUMERATOR of R2))
DENOMINATOR ←(fetch DENOMINATOR of R2)))
(T (create RATIONAL
NUMERATOR ←(IPLUS (ITIMES (fetch DENOMINATOR of R1)
(fetch NUMERATOR of R2))
(ITIMES (fetch NUMERATOR of R1)
(fetch DENOMINATOR of R2)))
DENOMINATOR ←(ITIMES (fetch DENOMINATOR of R1)
(fetch DENOMINATOR of R2])
(RMINUS
[LAMBDA (X) (* lmm " 2-AUG-82 22:06")
(COND
((NUMBERP X)
(MINUS X))
(T (create RATIONAL
NUMERATOR ←(MINUS (fetch NUMERATOR of X))
DENOMINATOR ←(fetch DENOMINATOR of X])
(CREATERATIONAL
[LAMBDA (NUMERATOR DENOMINATOR) (* rmk: "11-JUN-83 21:18")
(* Creates a normalized rational)
(COND
((ZEROP DENOMINATOR)
(CONS NUMERATOR DENOMINATOR))
(T [COND
((ILESSP DENOMINATOR 0)
(SETQ NUMERATOR (IMINUS NUMERATOR))
(SETQ DENOMINATOR (IMINUS DENOMINATOR]
(while (AND (EVENP NUMERATOR)
(EVENP DENOMINATOR))
do (SETQ NUMERATOR (RSH NUMERATOR 1)) (* Denominator is always positive)
(SETQ DENOMINATOR (LRSH DENOMINATOR 1)))
(CONS NUMERATOR DENOMINATOR])
(RATIONALTOINTEGER
[LAMBDA (RAT) (* lmm " 2-AUG-82 14:13")
(FIXR (FQUOTIENT (fetch NUMERATOR of RAT)
(fetch DENOMINATOR of RAT])
)
(DECLARE: DONTCOPY
(RPAQQ RATIONALS (METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA (MICASPERINCH 2540)
(MICASPERPOINT (QUOTE (635 . 18)))
(POINTSPERINCH 72)
(POINTSPERMICA (QUOTE (18 . 635)))
(POINTSPERMETER (QUOTE (360000 . 127)))
(METERSPERPOINT (QUOTE (127 . 360000)))
(MICASPERMETER 100000)
(METERSPERMICA (QUOTE (1 . 100000)))
(RATZERO (QUOTE (0 . 1)))
(RATONE (QUOTE (1 . 1)))
(RAVENSPOTSPERINCH 300)
(MICASPERRAVENSPOT (QUOTE (127 . 15)))
(RAVENSPOTSPERMICA (QUOTE (15 . 127)))
ONEHALF))
(DECLARE: EVAL@COMPILE
(RPAQQ METERSPERRAVENSPOT (1 . 11811))
(RPAQQ MICASPERSCREENPOINT (2540 . 80))
(RPAQQ SCREENPOINTSPERMICA (80 . 2540))
(RPAQQ MICASPERINCH 2540)
(RPAQQ MICASPERPOINT (635 . 18))
(RPAQQ POINTSPERINCH 72)
(RPAQQ POINTSPERMICA (18 . 635))
(RPAQQ POINTSPERMETER (360000 . 127))
(RPAQQ METERSPERPOINT (127 . 360000))
(RPAQQ MICASPERMETER 100000)
(RPAQQ METERSPERMICA (1 . 100000))
(RPAQQ RATZERO (0 . 1))
(RPAQQ RATONE (1 . 1))
(RPAQQ RAVENSPOTSPERINCH 300)
(RPAQQ MICASPERRAVENSPOT (127 . 15))
(RPAQQ RAVENSPOTSPERMICA (15 . 127))
(RPAQQ ONEHALF (1 . 2))
(CONSTANTS METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA (MICASPERINCH 2540)
(MICASPERPOINT (QUOTE (635 . 18)))
(POINTSPERINCH 72)
(POINTSPERMICA (QUOTE (18 . 635)))
(POINTSPERMETER (QUOTE (360000 . 127)))
(METERSPERPOINT (QUOTE (127 . 360000)))
(MICASPERMETER 100000)
(METERSPERMICA (QUOTE (1 . 100000)))
(RATZERO (QUOTE (0 . 1)))
(RATONE (QUOTE (1 . 1)))
(RAVENSPOTSPERINCH 300)
(MICASPERRAVENSPOT (QUOTE (127 . 15)))
(RAVENSPOTSPERMICA (QUOTE (15 . 127)))
ONEHALF)
)
)
[DECLARE: EVAL@COMPILE
(RECORD RATIONAL (NUMERATOR . DENOMINATOR)
(TYPE? LISTP)
(CREATE (CREATERATIONAL NUMERATOR DENOMINATOR)))
]
(DEFINEQ
(APPENDBYTE.IP
[LAMBDA (STREAM BYTE) (* rmk: "21-JUN-82 23:30")
(\BOUT STREAM BYTE])
(APPENDIDENTIFIER.IP
[LAMBDA (STREAM STRING) (* jds "14-Mar-84 10:42")
(* Put an identifier into the IP file.
NB that the characters in the identifier are ASCII, NOT
NS CHARACTERS!!!!)
(APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQIDENTIFIER (NCHARS STRING))
(for C instring (MKSTRING STRING) do (\BOUT STREAM C])
(APPENDINT.IP
[LAMBDA (STREAM NUM LENGTH) (* rmk: "22-JUN-82 00:02")
(for I from (SUB1 LENGTH) to 0 by -1 do (APPENDBYTE.IP STREAM (EXTRACTBYTE.IP NUM I])
(APPENDINTEGER.IP
[LAMBDA (STREAM N) (* edited: "30-MAY-83 23:33")
(COND
((AND (ILEQ -4000 N)
(ILEQ N 28767))
(APPENDINT.IP STREAM (IPLUS N 4000)
2))
(T (PROG ((LEN (BYTESININT.IP N)))
(APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQINTEGER LEN)
(APPENDINT.IP STREAM N LEN])
(APPENDLARGEVECTOR.IP
[LAMBDA (STREAM ARRAY) (* rmk: "25-JUN-82 22:26")
(* Appends a large vector stored as an Interlisp array. NUMELEMENTS is not an argument, since we assume that the
caller can pass a SUBARRAY if he so intends.)
(PROG (INTSIZE (ASIZE (ARRAYSIZE ARRAY))
(AORIG (ARRAYORIG ARRAY)))
[SETQ INTSIZE (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG))
largest (BYTESININT.IP (ELT ARRAY I]
(APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQLARGEVECTOR (ADD1 (ITIMES ASIZE INTSIZE)))
(for I from AORIG to (SUB1 (IPLUS ASIZE AORIG)) do (APPENDINT.IP STREAM (ELT ARRAY I)
INTSIZE])
(APPENDNUMBER.IP
[LAMBDA (STREAM R) (* rmk: "25-JUN-82 22:00")
(COND
((FIXP R)
(APPENDINTEGER.IP STREAM R))
((type? RATIONAL R)
(APPENDRATIONAL.IP STREAM (fetch NUMERATOR of R)
(fetch DENOMINATOR of R)))
(T (PROG ((RAT (MAKERATIONAL R)))
(APPENDRATIONAL.IP STREAM (fetch NUMERATOR of RAT)
(fetch DENOMINATOR of RAT])
(APPENDOP.IP
[LAMBDA (STREAM OP) (* rmk: "22-JUN-82 01:28")
(COND
((OR (ILESSP OP 0)
(IGREATERP OP 8191))
(ERROR "Invalid Interpress operator code:" OP)))
(COND
((ILEQ OP 31)
(APPENDBYTE.IP STREAM (LOGOR SHORTOP OP)))
(T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256)))
(APPENDBYTE.IP STREAM (MOD OP 256])
(APPENDRATIONAL.IP
[LAMBDA (STREAM N D) (* rmk: "20-JUL-82 23:45")
(PROG [(I (IMAX (BYTESININT.IP N)
(BYTESININT.IP D]
(APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQRATIONAL (UNFOLD I 2))
(APPENDINT.IP STREAM N I)
(APPENDINT.IP STREAM D I])
(APPENDSEQUENCEDESCRIPTOR.IP
[LAMBDA (STREAM TYPE LENGTH) (* edited: "30-MAY-83 23:19")
(COND
((OR (ILESSP TYPE 0)
(IGREATERP TYPE 31))
(ERROR "Invalid Interpress type" TYPE)))
(COND
([OR (ILESSP LENGTH 0)
(IGREATERP LENGTH (CONSTANT (SUB1 (EXPT 2 24]
(ERROR "Interpress sequence length too long" LENGTH)))
(COND
((ILESSP LENGTH 256) (* Short sequence, with one byte of length)
(APPENDBYTE.IP STREAM (LOGOR SHORTSEQUENCE TYPE))
(APPENDBYTE.IP STREAM LENGTH))
(T (* Long sequence, with 3 bytes of length)
(APPENDBYTE.IP STREAM (LOGOR LONGSEQUENCE TYPE))
(APPENDINT.IP STREAM LENGTH 3])
(BYTESININT.IP
[LAMBDA (N) (* rmk: "20-OCT-82 17:28")
(FOLDHI (ADD1 (INTEGERLENGTH N))
BITSPERBYTE])
(EXTRACTBYTE.IP
[LAMBDA (N BYTE) (* rmk: "19-APR-83 17:17")
(IMOD (LRSH N (UNFOLD BYTE BITSPERBYTE))
256])
)
(* Operator interface)
(DEFINEQ
(BEGINMASTER.IP
[LAMBDA (IPSTREAM) (* rmk: "20-Mar-84 23:08")
(APPENDOP.IP IPSTREAM BEGINMASTER])
(BEGINPAGE.IP
[LAMBDA (IPSTREAM) (* rmk: "22-SEP-83 22:29")
(UNINTERRUPTABLY
(APPENDOP.IP IPSTREAM BEGINPAGE)
(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with (QUOTE PAGE)))])
(BEGINPREAMBLE.IP
[LAMBDA (IPSTREAM) (* rmk: "13-JUL-82 17:39")
(APPENDOP.IP IPSTREAM BEGINPREAMBLE)
(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with (QUOTE PREAMBLE])
(CONCAT.IP
[LAMBDA (IPSTREAM) (* rmk: " 7-JUN-83 17:41")
(APPENDOP.IP IPSTREAM CONCAT])
(CONCATT.IP
[LAMBDA (IPSTREAM) (* rmk: " 7-JUL-82 00:08")
(APPENDOP.IP IPSTREAM CONCATT])
(ENDMASTER.IP
[LAMBDA (IPSTREAM) (* rmk: "20-Mar-84 23:08")
(APPENDOP.IP IPSTREAM ENDMASTER])
(ENDPAGE.IP
[LAMBDA (IPSTREAM) (* rmk: "13-JUL-82 17:36")
(SHOW.IP IPSTREAM)
(UNINTERRUPTABLY
(APPENDOP.IP IPSTREAM ENDPAGE)
(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with NIL))])
(ENDPREAMBLE.IP
[LAMBDA (IPSTREAM) (* rmk: "22-SEP-83 22:03")
(PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
(replace IPPREAMBLEFONTS of IPDATA with (DREVERSE (fetch IPPAGEFONTS of IPDATA)))
(* Reverse on tenuous assumption that first fonts are
more frequent)
(replace IPPREAMBLENEXTFRAMEVAR of IPDATA with (fetch IPNEXTFRAMEVAR of IPDATA))
(UNINTERRUPTABLY
(APPENDOP.IP IPSTREAM ENDPREAMBLE)
(replace IPPAGESTATE of IPDATA with NIL))])
(FGET.IP
[LAMBDA (IPSTREAM FINDEX) (* rmk: " 7-JUL-82 00:09")
(APPENDNUMBER.IP IPSTREAM FINDEX)
(APPENDOP.IP IPSTREAM FGET])
(FILLTRAJECTORY.IP
[LAMBDA (IPSTREAM POINTS) (* rmk: "23-JUL-82 15:18")
(TRAJECTORY.IP IPSTREAM POINTS)
(APPENDOP.IP IPSTREAM MAKEOUTLINE)
(APPENDINTEGER.IP IPSTREAM 1)
(APPENDOP.IP IPSTREAM MASKFILL])
(FSET.IP
[LAMBDA (IPSTREAM FINDEX) (* rmk: " 7-JUL-82 00:08")
(APPENDNUMBER.IP IPSTREAM FINDEX)
(APPENDOP.IP IPSTREAM FSET])
(GETFRAMEVAR.IP
[LAMBDA (IPSTREAM) (* rmk: "18-AUG-83 17:50")
(PROG [(FV (fetch IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM]
(replace IPNEXTFRAMEVAR of (fetch IPDATA of IPSTREAM) with (ADD1 FV))
(RETURN FV])
(INITIALIZEMASTER.IP
[LAMBDA (IPSTREAM) (* rmk: "20-Mar-84 23:31")
(for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE ENCODINGSTRING I)
(RETURN])
(ISET.IP
[LAMBDA (IPSTREAM IVAR) (* rmk: "18-Oct-84 12:52")
(* Sets the imager variable IVAR to the top of stack)
(APPENDINTEGER.IP IPSTREAM IVAR)
(APPENDOP.IP IPSTREAM ISET])
(LINETO.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "19-Oct-84 08:50")
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP X)
(FIXR X))
(T X)))
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP Y)
(FIXR Y))
(T Y)))
(APPENDOP.IP IPSTREAM LINETO])
(MASKSTROKE.IP
[LAMBDA (IPSTREAM) (* rmk: "14-Jun-84 16:00")
(APPENDOP.IP IPSTREAM MASKSTROKE])
(MOVETO.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "19-Oct-84 08:49")
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP X)
(FIXR X))
(T X)))
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP Y)
(FIXR Y))
(T Y)))
(APPENDOP.IP IPSTREAM MOVETO])
(ROTATE.IP
[LAMBDA (IPSTREAM S) (* rmk: " 6-JUN-83 18:02")
(APPENDNUMBER.IP IPSTREAM S)
(APPENDOP.IP IPSTREAM ROTATE])
(SCALE.IP
[LAMBDA (IPSTREAM S) (* rmk: "15-Jun-84 12:21")
(APPENDNUMBER.IP IPSTREAM S)
(APPENDOP.IP IPSTREAM SCALE.OP])
(SCALE2.IP
[LAMBDA (IPSTREAM X Y) (* lmm "10-JUN-83 15:28")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM SCALE2])
(SETFONT.IP
[LAMBDA (IPSTREAM FONTNUM) (* rmk: "20-AUG-83 14:03")
(APPENDNUMBER.IP IPSTREAM FONTNUM)
(APPENDOP.IP IPSTREAM SETFONT)
(PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
(replace IPFONT of IPDATA with (for X in (fetch IPPAGEFONTS of IPDATA)
when (EQ FONTNUM (CDR X)) do (RETURN (CAR X))
finally (ERROR "Undefined font number"])
(SETSPACE.IP
[LAMBDA (IPSTREAM SPACEWIDTH) (* rmk: "11-Dec-83 21:12")
(APPENDNUMBER.IP IPSTREAM SPACEWIDTH)
(APPENDOP.IP IPSTREAM SPACE])
(SETXREL.IP
[LAMBDA (IPSTREAM DX) (* jds " 5-Oct-84 10:35")
(* Move by DX in the X direction)
(APPENDNUMBER.IP IPSTREAM DX)
(APPENDOP.IP IPSTREAM SETXREL)
(change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 DX DATUM))
(replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with (fetch IPXPOS
of (fetch IPDATA of IPSTREAM])
(SETX.IP
[LAMBDA (IPSTREAM X) (* rmk: "19-Oct-84 08:54")
(* Move to X, without changing Y.)
(COND
((NUMBERP X)
[APPENDINTEGER.IP IPSTREAM (IDIFFERENCE (COND
((FLOATP X)
(SETQ X (FIXR X)))
(T X))
(fetch IPXPOS of (fetch IPDATA of IPSTREAM]
(APPENDOP.IP IPSTREAM SETXREL))
(T (APPENDNUMBER.IP IPSTREAM X) (* If not a fixp, let the rational/floating
substraction be done by the printer)
(APPENDNUMBER.IP IPSTREAM (fetch IPYPOS of (fetch IPDATA of IPSTREAM)))
(APPENDOP.IP IPSTREAM SETXY)))
(replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
(replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with X])
(SETXY.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "19-Oct-84 08:50")
(* Move to (X,Y) on the page.)
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP X)
(SETQ X (FIXR X)))
(T X)))
(APPENDNUMBER.IP IPSTREAM (COND
((FLOATP Y)
(SETQ Y (FIXR Y)))
(T Y)))
(APPENDOP.IP IPSTREAM SETXY)
(replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
(replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with X)
(* Remember our last location, so we can CORRECT
character widths.)
(replace IPYPOS of (fetch IPDATA of IPSTREAM) with Y])
(SETXYREL.IP
[LAMBDA (IPSTREAM DX DY) (* rmk: " 8-Oct-84 14:22")
(* Move by (DX,DY) on the page.)
(APPENDNUMBER.IP IPSTREAM DX)
(APPENDNUMBER.IP IPSTREAM DY)
(APPENDOP.IP IPSTREAM SETXYREL)
(change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 DATUM DX))
(change (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 DATUM DY)) (* Remember the new X location so we can CORRECT
character widths)
(replace IPCORRECTSTARTX of (fetch IPDATA of IPSTREAM) with (fetch IPXPOS
of (fetch IPDATA of IPSTREAM])
(SETY.IP
[LAMBDA (IPSTREAM Y) (* rmk: "19-Oct-84 08:54")
(COND
((NUMBERP Y)
[APPENDINTEGER.IP IPSTREAM (IDIFFERENCE (COND
((FLOATP Y)
(SETQ Y (FIXR Y)))
(T Y))
(fetch IPYPOS of (fetch IPDATA of IPSTREAM]
(APPENDOP.IP IPSTREAM SETYREL))
(T (APPENDNUMBER.IP IPSTREAM (fetch IPXPOS of (fetch IPDATA of IPSTREAM)))
(* If not a fixp, let the rational/floating
substraction be done by the printer)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM SETXY)))
(replace IPYPOS of (fetch IPDATA of IPSTREAM) with Y])
(SETYREL.IP
[LAMBDA (IPSTREAM Y) (* rmk: " 7-JUL-82 00:12")
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM SETYREL)
(add (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
Y])
(SHOW.IP
[LAMBDA (IPSTREAM) (* rmk: "18-Oct-84 12:00")
(* Shows a string buffered away in SHOWSTREAM)
(PROG (LEN SHOWSTREAM (IPDATA (ffetch IPDATA of IPSTREAM)))
(SETQ SHOWSTREAM (ffetch IPSHOWSTREAM of IPDATA))
(SETQ LEN (\GETFILEPTR SHOWSTREAM))
(COND
((IGREATERP LEN 0) (* Only bother if there ARE characters to put out.)
[APPENDNUMBER.IP IPSTREAM (\RPLUS2 (ffetch IPXPOS of IPDATA)
(RMINUS (ffetch IPCORRECTSTARTX of IPDATA]
(* Set up the measures for the CORRECT op, so the
characters come out the right width)
(APPENDINTEGER.IP IPSTREAM 0)
(APPENDOP.IP IPSTREAM SETCORRECTMEASURE)
(APPENDOP.IP IPSTREAM CORRECT)
(APPENDOP.IP IPSTREAM {) (* Put the SHOW inside a block, so the CORRECT will
affect it.)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQSTRING LEN)
(COPYBYTES SHOWSTREAM IPSTREAM 0 LEN)
(APPENDOP.IP IPSTREAM SHOW)
(APPENDOP.IP IPSTREAM }) (* End of the block affected by the CORRECT)
(\SETFILEPTR SHOWSTREAM 0) (* Clear out the holding stream for characters)
(freplace IPCORRECTSTARTX of IPDATA with (ffetch IPXPOS of IPDATA))
(* And notice out new real location for future
CORRECTs.)
(freplace NSCHARSET of IPDATA with 0])
(TRAJECTORY.IP
[LAMBDA (IPSTREAM POINTS) (* rmk: "23-JUL-82 15:08")
(MOVETO.IP IPSTREAM (fetch XCOORD of (CAR POINTS))
(fetch YCOORD of (CADR POINTS)))
(for P in (CDR POINTS) do (LINETO.IP IPSTREAM (fetch XCOORD of P)
(fetch YCOORD of P])
(TRANS.IP
[LAMBDA (IPSTREAM) (* rmk: "11-JUN-83 22:20")
(* This translates the origin to the current position.)
(APPENDOP.IP IPSTREAM TRANS])
(TRANSLATE.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "21-JUL-82 13:23")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM TRANSLATE])
)
(* DIG interface)
(DEFINEQ
(DEFINEFONT.IP
[LAMBDA (IPSTREAM FONT) (* rmk: "19-Oct-84 11:13")
(PROG (FRAMEVAR (IPDATA (fetch IPDATA of IPSTREAM)))
(for N from 0 as ID in (FONTNAME.IP FONT) do (APPENDIDENTIFIER.IP IPSTREAM ID)
finally (APPENDINTEGER.IP IPSTREAM N)
(APPENDOP.IP IPSTREAM MAKEVEC))
(APPENDOP.IP IPSTREAM FINDFONT)
[SCALE.IP IPSTREAM (\RTIMES2 MICASPERPOINT (FONTPROP FONT (QUOTE DEVICESIZE]
(APPENDOP.IP IPSTREAM MODIFYFONT)
(SETQ FRAMEVAR (GETFRAMEVAR.IP IPSTREAM))
(FSET.IP IPSTREAM FRAMEVAR)
(RETURN (CAR (push (fetch IPPAGEFONTS of IPDATA)
(CONS FONT FRAMEVAR])
(FONTNAME.IP
[LAMBDA (FONTDESC) (* rmk: " 2-Nov-84 13:28")
(* Convert a Lisp font name to the proper NS font name)
(PROG (FACE NAME)
[COND
((EQ (QUOTE ITALIC)
(FONTPROP FONTDESC (QUOTE DEVICESLOPE)))
(SETQ FACE (QUOTE (-Italic]
[COND
((EQ (QUOTE BOLD)
(FONTPROP FONTDESC (QUOTE DEVICEWEIGHT)))
(push FACE (QUOTE -Bold]
(SETQ NAME (FONTPROP FONTDESC (QUOTE DEVICEFAMILY)))
[COND
(FACE (SETQ NAME (PACK (CONS NAME FACE]
(RETURN (APPEND (QUOTE (XEROX XC82-0-0))
(CONS NAME])
(HEADINGOP.IP
[LAMBDA (IPSTREAM HEADING) (* rmk: " 5-Oct-84 08:47")
(* Stores the HEADINGOP operator as frame-variable 0 in
the preamble.)
(PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
(APPENDOP.IP IPSTREAM MAKESIMPLECO)
(APPENDOP.IP IPSTREAM {)
(COND
(HEADING [SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
(IDIFFERENCE (fetch IPTOP of IPDATA)
(FONTPROP (fetch IPHEADINGFONT of IPDATA)
(QUOTE ASCENT]
(SETFONT.IP IPSTREAM HEADINGFONTNUMBER)
(PRIN3 HEADING IPSTREAM)
(SHOW.IP IPSTREAM)
(RELMOVETO MICASPERINCH 0 IPSTREAM) (* Skip an inch before page number)
(PRIN3 "Page " IPSTREAM) (* Show the page number argument
(from stack))
(TERPRI IPSTREAM) (* Skip 2 lines--have to pick up the linefeed from the
heading font)
(TERPRI IPSTREAM)))
(APPENDOP.IP IPSTREAM })
(FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP IPSTREAM])
(INTERPRESS.BITMAPSCALE
[LAMBDA (WIDTH HEIGHT) (* lmm " 3-OCT-83 21:31")
(PROG [(RATIO (MIN (FQUOTIENT (TIMES POINTSPERINCH 9.5)
WIDTH)
(FQUOTIENT (TIMES POINTSPERINCH 7.5)
HEIGHT]
(RETURN (COND
((GEQ RATIO 1)
1)
((GEQ RATIO .5)
.5)
((GEQ RATIO .25)
.25)
(T RATIO])
(INTERPRESS.OUTCHARFN
[LAMBDA (IPSTREAM CHARCODE) (* rmk: "18-Oct-84 13:03")
(PROG (NSCODE (IPDATA (ffetch IPDATA of IPSTREAM)))
(SETQ NSCODE (\GETBASE (ffetch NSTRANSTABLE of IPDATA)
CHARCODE)) (* Select on NSCODE, since ↑L etc might be graphic in
some ascii fonts)
(SELCHARQ NSCODE
(EOL (NEWLINE.IP IPSTREAM))
[LF (\DSPXPOSITION.IP IPSTREAM (PROG1 (\DSPXPOSITION.IP IPSTREAM)
(NEWLINE.IP IPSTREAM]
(SPACE (add (ffetch IPXPOS of IPDATA)
(ffetch IPSPACEWIDTH of IPDATA))
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
(CHARCODE SPACE)))
(↑L (NEWPAGE.IP IPSTREAM))
(PROGN (add (ffetch IPXPOS of IPDATA)
(\FGETWIDTH (ffetch IPWIDTHSCACHE of IPDATA)
CHARCODE)) (* Assume the widths for the untranslated code
correspond to the translated character)
[COND
((NEQ (NSCHARSET NSCODE)
(ffetch NSCHARSET of IPDATA))
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
NSCHARSETSHIFT) (* Switch character set)
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
(NSCHARSET NSCODE))
(freplace NSCHARSET of IPDATA with (NSCHARSET NSCODE]
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
(NSCHAR NSCODE])
(INTERPRESSFILEP
[LAMBDA (FILE) (* rmk: "22-Oct-84 17:09")
(* Returns fullname of FILE if it looks like an
Interpress file)
(PROG (STRM)
(RETURN (RESETLST [COND
((SETQ STRM (\GETSTREAM FILE (QUOTE INPUT)
T))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
STRM
(GETFILEPTR STRM)))
(SETFILEPTR STRM 0))
(T (RESETSAVE (SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(for I from 1 to (CONSTANT (NCHARS NOVERSIONENCODINGSTRING))
when (OR (EOFP STRM)
(NEQ (NTHCHARCODE NOVERSIONENCODINGSTRING I)
(BIN STRM)))
do (RETURN NIL) finally (RETURN (FULLNAME STRM])
(MAKEINTERPRESS
[LAMBDA (FILE IPFILE FONTS HEADING TABS) (* rmk: "15-Sep-84 02:33")
(TEXTTOIMAGEFILE FILE IPFILE (QUOTE INTERPRESS)
FONTS HEADING TABS])
(NEWLINE.IP
[LAMBDA (IPSTREAM) (* rmk: " 4-Oct-84 09:21")
(* Doesn't check for page overflow--wait until
something is actually shown.)
(SHOW.IP IPSTREAM)
(PROG (NEWYPOS (IPDATA (ffetch IPDATA of IPSTREAM)))
(SETQ NEWYPOS (IPLUS (ffetch IPYPOS of IPDATA)
(ffetch IPLINEFEED of IPDATA)))
(COND
((ILESSP NEWYPOS (fetch IPBOTTOM of IPDATA))
(NEWPAGE.IP IPSTREAM))
(T (SETXY.IP IPSTREAM (ffetch IPLEFT of IPDATA)
NEWYPOS])
(NEWPAGE.IP
[LAMBDA (IPSTREAM) (* rmk: "18-Oct-84 17:41")
(PROG (CFONT HFONT (IPDATA (fetch IPDATA of IPSTREAM)))
(SETQ CFONT (fetch IPFONT of IPDATA)) (* Save current font and make IPFONT be NIL, indicating
that there is no actual font at the beginning of a
page)
(replace IPFONT of IPDATA with NIL)
(SELECTQ (fetch IPPAGESTATE of IPDATA)
(PAGE (ENDPAGE.IP IPSTREAM))
(PREAMBLE (ENDPREAMBLE.IP IPSTREAM))
NIL)
(BEGINPAGE.IP IPSTREAM)
(replace IPPAGEFONTS of IPDATA with (fetch IPPREAMBLEFONTS of IPDATA))
(replace IPNEXTFRAMEVAR of IPDATA with (fetch IPPREAMBLENEXTFRAMEVAR of IPDATA))
(SCALE.IP IPSTREAM METERSPERMICA) (* Establish mica page coordinate system)
(CONCATT.IP IPSTREAM)
[COND
[(fetch IPHEADING of IPDATA)
(SETQ HFONT (fetch IPHEADINGFONT of IPDATA))
(\DSPFONT.IP IPSTREAM HFONT) (* Set up heading font)
(SELECTQ ENCODING
(FULLIP-82 (PRIN3 (add (fetch IPPAGENUM of IPDATA)
1)
IPSTREAM)
(FGET.IP IPSTREAM (fetch IPHEADINGOPVAR
of (fetch IPDATA of IPSTREAM)))
(* Get the heading operator)
(APPENDOP.IP IPSTREAM DOSAVE))
(IP-82 [SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
(IDIFFERENCE (fetch IPTOP of IPDATA)
(FONTPROP HFONT (QUOTE ASCENT]
(DSPFONT HFONT IPSTREAM)
(PRIN3 (fetch IPHEADING of IPDATA)
IPSTREAM)
(RELMOVETO MICASPERINCH 0 IPSTREAM)
(* Skip an inch before page number)
(PRIN3 "Page " IPSTREAM)
(PRIN3 (add (fetch IPPAGENUM of IPDATA)
1)
IPSTREAM)
(NEWLINE.IP IPSTREAM) (* Skip 2 lines)
(NEWLINE.IP IPSTREAM))
(SHOULDNT))
(* SETXY can't be done in HEADINGOP, cause the ascent of the current font is not known at image-time.
We set it in terms of our current font, even though that hasn't yet be re-setup in the imager.)
(SETYREL.IP IPSTREAM (IMINUS (FONTPROP CFONT (QUOTE ASCENT]
(T (SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
(IDIFFERENCE (fetch IPTOP of IPDATA)
(FONTPROP CFONT (QUOTE ASCENT]
(* Now we set the imagers font to our
(previous) current font, to override heading)
(APPENDINTEGER.IP IPSTREAM 0) (* Set up so that CORRECTs have to be exact.)
(APPENDINTEGER.IP IPSTREAM 0)
(APPENDOP.IP IPSTREAM SETCORRECTTOLERANCE)
(if (NOT (EQP 1 (ffetch IPSPACEFACTOR of IPDATA)))
then (* Imager variables revert to initial values)
(APPENDNUMBER.IP IPSTREAM (ffetch IPSPACEFACTOR of IPDATA))
(ISET.IP IPSTREAM AMPLIFYSPACE))
(\DSPFONT.IP IPSTREAM CFONT])
(NEWPAGE?.IP
[LAMBDA (IPSTREAM) (* rmk: "21-JUL-82 13:24")
(* Are we about to overflow the page?)
(COND
((ILESSP (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
(fetch IPBOTTOM of (fetch IPDATA of IPSTREAM)))
(NEWPAGE.IP IPSTREAM])
(OPENIPSTREAM
[LAMBDA (IPFILE REGION HEADING PREAMBLEFONTS BREAKPAGEFILENAME)
(* rmk: "23-Aug-84 11:54")
(* Opens an interpress stream, to which user can do OUTCHAR to. PREAMBLEFONTS is a list of fonts to be set up in
the preamble. Headings will be printed in the first font in PREAMBLEFONTS. If PREAMBLEFONTS is NIL, then the
stream is initialized with the INTERPRESS DEFAULTFONT)
(DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS \NOIMAGEOPS))
(PROG ([IPSTREAM (OPENSTREAM IPFILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(IPDATA (create INTERPRESSDATA
IPPAGEREGION ←(OR REGION DEFAULTPAGEREGION)
IPSHOWSTREAM ←(PROG1 (\OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW))
(* Make sure the fileptr of the following is zero
(GETRESOURCE \IPSHOWSTREAM) (and free this in
CLOSEIPSTREAM))
)
IPBREAKPAGEFN ← BREAKPAGEFILENAME)))
(COND
((OR (NEQ \NOIMAGEOPS (fetch (IPSTREAM IMAGEOPS) of IPSTREAM))
(NEQ 0 (GETEOFPTR IPSTREAM)))
(ERROR "can't convert existing file to Interpress" (FULLNAME IPSTREAM))
(* GETEOFPTR might bomb on some streams)
))
(replace (STREAM OUTCHARFN) of IPSTREAM with (FUNCTION INTERPRESS.OUTCHARFN))
(replace (IPSTREAM IMAGEOPS) of IPSTREAM with \IPIMAGEOPS)
(replace (IPSTREAM IPDATA) of IPSTREAM with IPDATA)
(INITIALIZEMASTER.IP IPSTREAM)
(BEGINMASTER.IP IPSTREAM)
(BEGINPREAMBLE.IP IPSTREAM)
(COND
(HEADING (replace IPHEADING of IPDATA with HEADING)
(SELECTQ ENCODING
(FULLIP-82 (HEADINGOP.IP IPSTREAM HEADING))
(GETFRAMEVAR.IP IPSTREAM)))
(T (GETFRAMEVAR.IP IPSTREAM)))
(* Allocate framevar 0, for heading op if there is one, otherwise for nothing. This means that the fonts will be
in framevars that correspond to their position in PREAMBLEFONTS. MAKEINTERPRESS relies on this.)
(SETUPFONTS.IP IPSTREAM PREAMBLEFONTS)
(NEWPAGE.IP IPSTREAM) (* NEWPAGE automatically closes the preamble)
(RETURN IPSTREAM])
(SETUPFONTS.IP
[LAMBDA (IPSTREAM FONTS) (* rmk: "15-Sep-84 02:16")
(* Sets up preamble fonts, and sets heading font. Leaves IPFONT as NIL. This means that \DSPFONT.IP of the heading
font will establish that as the current font when the preamble is closed and the first page opens.
NIL. Note that the preamble can't set the font imager variable.)
(for F (IPDATA ←(fetch IPDATA of IPSTREAM)) inside (OR FONTS DEFAULTFONT)
do (SETQ F (FONTCREATE F NIL NIL NIL (QUOTE INTERPRESS)))
(DEFINEFONT.IP IPSTREAM F)
(COND
(IPDATA (* Take first font as heading font, and make it look
like old current font on first NEWPAGE)
(replace IPFONT of IPDATA with F)
(replace IPHEADINGFONT of IPDATA with F)
(SETQ IPDATA NIL])
(SHOWBITMAP.IP
[LAMBDA (IPSTREAM BITMAP REGION SCALE ROTATION) (* rmk: "18-Oct-84 14:16")
(* Puts out bit map with lower-left corner at current
position. If given, REGION is a clipping region on the
bitmap.)
(SHOW.IP IPSTREAM)
(PROG (XPIXELS YPIXELS XBYTES)
[COND
(REGION [SETQ REGION (INTERSECTREGIONS REGION
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch BITMAPWIDTH of BITMAP)
HEIGHT ←(fetch BITMAPHEIGHT of BITMAP]
(SETQ XPIXELS (fetch WIDTH of REGION))
(SETQ YPIXELS (fetch HEIGHT of REGION)))
(T (SETQ XPIXELS (fetch BITMAPWIDTH of BITMAP))
(SETQ YPIXELS (fetch BITMAPHEIGHT of BITMAP]
(SETQ XBYTES (CEIL (FOLDHI XPIXELS BITSPERBYTE)
BYTESPERWORD)) (* Lines must be padded to multiples of 32bits
(cells))
(COND
((IGREATERP XBYTES MAXLONGSEQUENCEBYTES) (* We should really start breaking it up in the X
direction as well)
(ERROR "Bitmap line too long for Interpress printing")))
(SETQ SCALE (COND
(SCALE (\RTIMES2 SCALE MICASPERPOINT))
(T MICASPERPOINT)) (* Go to unit of 4 raven spots ~= 1 screen point)
)
(bind LEFT (NEXTROW ← 0)
(BOTTOM ← 0)
(HEIGHT ← YPIXELS)
(MAXYPIXELSPERCHUNK ←(IQUOTIENT MAXLONGSEQUENCEBYTES XBYTES))
while (IGREATERP YPIXELS 0) first [COND
(REGION (* We're displaying a subsection of the bitmap.
Set up the fields that let SHOWBITMAP1.IP pick bits
from the right place)
(SETQ LEFT (fetch LEFT of REGION))
(SETQ BOTTOM (fetch BOTTOM of REGION]
do (* The bitmap is put out in chunks, from top to bottom
-- corresponding to the order that the bits appear in
memory.)
(SHOWBITMAP1.IP IPSTREAM BITMAP LEFT NEXTROW XPIXELS (IMIN YPIXELS MAXYPIXELSPERCHUNK)
SCALE ROTATION HEIGHT XBYTES BOTTOM)
(SETQ YPIXELS (IDIFFERENCE YPIXELS MAXYPIXELSPERCHUNK))
(SETQ NEXTROW (IPLUS NEXTROW MAXYPIXELSPERCHUNK))
(* This is the next row of the bitmap (counting from the top of the region to be displayed) to go to the file.)
])
(SHOWBITMAP1.IP
[LAMBDA (IPSTREAM BITMAP LEFT FIRSTROW XPIXELS YPIXELS SCALEFACTOR ROTATION HEIGHT XBYTES
REGIONBOTTOM) (* jds "12-Sep-84 17:21")
(* Move a segment of bitmap to an INTERPRESS file.)
(* FIRSTROW is the row count -- STARTING FROM THE TOP
OF THE BITMAP AS ZERO -- for the first row to be
displayed.)
(PROG [(TOTALBYTES (ITIMES XBYTES YPIXELS))
(SCRATCHBM (BITMAPCREATE (CEIL XPIXELS BITSPERCELL)
1))
(BMBASE (\ADDBASE (fetch (BITMAP BITMAPBASE) of BITMAP)
(ITIMES (IDIFFERENCE (IPLUS HEIGHT (OR REGIONBOTTOM 0))
(IPLUS FIRSTROW YPIXELS))
(fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP]
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {) (* Start the SIMPLEBODY for displaying this part of the
bitmap.)
(TRANS.IP IPSTREAM) (* Translate to the current position)
(APPENDNUMBER.IP IPSTREAM YPIXELS) (* For the master, this is the number of pixels in the
slow direction)
(APPENDNUMBER.IP IPSTREAM XPIXELS) (* Number of pixels in the master's fast direction)
(APPENDINTEGER.IP IPSTREAM 1) (* Reserved for future expansion)
(APPENDINTEGER.IP IPSTREAM 1)
(APPENDINTEGER.IP IPSTREAM 1)
(SELECTQ (IMOD (OR ROTATION 0)
360)
(0 (* Bitmaps are really shown on their sides, hanging
from the upper left corner (I think--JDS))
(ROTATE.IP IPSTREAM -90)
(TRANSLATE.IP IPSTREAM 0 (IDIFFERENCE HEIGHT FIRSTROW))
(* Push this segment up to its "true" height -- i.e., The first segment gets pushed up all the way
(since it's the top of the bitmap), the next segment gets pushed up HEIGHT-#ofRowsIn1stSeg (to account for the first
segment), and so on.)
(CONCAT.IP IPSTREAM))
(90 (* need nop)
(TRANSLATE.IP IPSTREAM (IDIFFERENCE HEIGHT (IPLUS FIRSTROW YPIXELS))
0)
(* Push this segment up to its "true" bottom -- i.e., The first segment gets pushed up to
bitmapHeight-HeightOfSegment (since it's the top of the bitmap), the next segment gets pushed up
HEIGHT-RowsIn1stSeg-RowsThisSeg (to account for the first segment), and so on.)
)
(180 (* The translation for this hasn't been tested yet.
It may well be the inverse of the rotation-0
correction)
(ROTATE.IP IPSTREAM 90)
(TRANSLATE.IP IPSTREAM XPIXELS 0)
(CONCAT.IP IPSTREAM))
(270 (* The translation for this hasn't been tested yet.
It may well be the inverse of the rotation-90
correction)
(ROTATE.IP IPSTREAM 180)
(TRANSLATE.IP IPSTREAM 0 XPIXELS)
(CONCAT.IP IPSTREAM))
(ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
(SCALE.IP IPSTREAM SCALEFACTOR) (* Scale the bitmap to its final size)
(CONCAT.IP IPSTREAM)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 TOTALBYTES))
(APPENDINT.IP IPSTREAM 1 2)
(APPENDINT.IP IPSTREAM XPIXELS 2)
(COND
(LEFT (* We are working on a subregion in the X direction --
the hard case)
(for Y (XWORDS ←(FOLDHI XBYTES BYTESPERWORD)) from 1 to YPIXELS
do (BITBLT BITMAP LEFT (IDIFFERENCE (IPLUS (OR REGIONBOTTOM 0)
FIRSTROW YPIXELS)
Y)
SCRATCHBM 0 0 XPIXELS 1 (QUOTE INPUT)
(QUOTE REPLACE))
(\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of SCRATCHBM)
0 XBYTES)))
(T (* We can put out the whole bitmap
(i.e., from the starting Y pixel position on down.))
(\BOUTS IPSTREAM BMBASE 0 TOTALBYTES)))
(APPENDOP.IP IPSTREAM MAKEPIXELARRAY)
(APPENDOP.IP IPSTREAM MASKPIXEL)
(APPENDOP.IP IPSTREAM }])
(\CHARWIDTH.IP
[LAMBDA (STREAM CHARCODE) (* rmk: "18-Oct-84 12:25")
(* Gets the width of CHARCODE in an Interpress STREAM,
observing spacefactor)
(COND
((EQ CHARCODE (CHARCODE SPACE))
(ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM)))
(T (\FGETWIDTH (ffetch IPWIDTHSCACHE of (ffetch IMAGEDATA of STREAM))
(LOGAND CHARCODE \CHARMASK])
(\CLOSEIPSTREAM
[LAMBDA (IPSTREAM) (* rmk: "27-JUL-83 19:48")
(SELECTQ (fetch IPPAGESTATE of (fetch IPDATA of IPSTREAM))
(PAGE (ENDPAGE.IP IPSTREAM))
(PREAMBLE (ENDPREAMBLE.IP IPSTREAM))
NIL)
(ENDMASTER.IP IPSTREAM])
(\DRAWCIRCLE.IP
[LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* rmk: "27-Sep-84 17:23")
(PROG [(R2RAD (FIXR (FTIMES RADIUS (CONSTANT (FQUOTIENT (SQRT 2)
2]
(DRAWCURVE (LIST (CREATEPOSITION (IPLUS CENTERX RADIUS)
CENTERY)
(CREATEPOSITION (IPLUS CENTERX R2RAD)
(IPLUS CENTERY R2RAD))
(CREATEPOSITION CENTERX (IPLUS CENTERY RADIUS))
(CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
(IPLUS CENTERY R2RAD))
(CREATEPOSITION (IDIFFERENCE CENTERX RADIUS)
CENTERY)
(CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
(IDIFFERENCE CENTERY R2RAD))
(CREATEPOSITION CENTERX (IDIFFERENCE CENTERY RADIUS))
(CREATEPOSITION (IPLUS CENTERX R2RAD)
(IDIFFERENCE CENTERY R2RAD)))
T BRUSH DASHING STREAM))
(MOVETO CENTERX CENTERY STREAM])
(\DRAWCURVE.IP
[LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING) (* rmk: "20-Nov-84 10:55")
(* draws a spline curve with a given brush--except that
dashing is currently ignored, and the curve is done
with straight lines.)
[COND
((LISTP KNOTS)
(SHOW.IP IPSTREAM)
(PROG [K (DASHLST (AND DASHING (OR (AND (LISTP DASHING)
(EVERY DASHING (FUNCTION FIXP))
DASHING)
(\ILLEGAL.ARG DASHING]
(* The above makes sure that DASHING is a list of
numbers.)
[OR (CDR KNOTS)
(SETQ KNOTS (LIST (CAR KNOTS)
(CAR KNOTS] (* The funny case of a single knot)
(COND
((AND (NULL DASHING)
(EQ 2 (LENGTH KNOTS))) (* There were only two knots, and no dashing.)
(OR (type? POSITION (SETQ K (CAR KNOTS)))
(ERROR "bad knot" K))
(MOVETO.IP IPSTREAM (fetch XCOORD of K)
(fetch YCOORD of K))
(OR (type? POSITION (SETQ K (CADR KNOTS)))
(ERROR "bad knot" K))
(LINETO.IP IPSTREAM (fetch XCOORD of K)
(fetch YCOORD of K))
(\SETBRUSH.IP IPSTREAM BRUSH)
(MASKSTROKE.IP IPSTREAM))
(T (* Otherwise, use the full-strength curve drawer.)
(\IPCURVE2 IPSTREAM (PARAMETRICSPLINE KNOTS CLOSED)
DASHING BRUSH) (* This already leaves the current position at the
endpoint of the curve.)
))
(SETQ K (CAR (LAST KNOTS)))
(SETXY.IP IPSTREAM (fetch XCOORD of K)
(fetch YCOORD of K]
IPSTREAM])
(\IPCURVE2
[LAMBDA (IPSTREAM SPLINE DASHING BRUSH) (* rmk: "28-Sep-84 13:33")
(* Given a spline curve and a font, draw the lines to
IPSTREAM)
(PROG ((XPOLY (create POLYNOMIAL))
(X'POLY (create POLYNOMIAL))
(YPOLY (create POLYNOMIAL))
(Y'POLY (create POLYNOMIAL))
(X (fetch (SPLINE SPLINEX) of SPLINE))
(Y (fetch (SPLINE SPLINEY) of SPLINE))
(X'(fetch (SPLINE SPLINEDX) of SPLINE))
(Y'(fetch (SPLINE SPLINEDY) of SPLINE))
(X''(fetch (SPLINE SPLINEDDX) of SPLINE))
(Y''(fetch (SPLINE SPLINEDDY) of SPLINE))
(X'''(fetch (SPLINE SPLINEDDDX) of SPLINE))
(Y'''(fetch (SPLINE SPLINEDDDY) of SPLINE))
(#KNOTS (fetch #KNOTS of SPLINE))
(X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE)
1))
(Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE)
1))
IX IY DX DY XT YT X'T Y'T NEWXT NEWYT XDIFF YDIFF XWALLDT YWALLDT DUPLICATEKNOT EXTRANEOUS
TT NEWT DELTA DASHON DASHLST DASHCNT IPDATA SEG#)
(SETQ DASHON T) (* These are initialized outside the prog-bindings
cause the compiler can't hack so many initialized
variables)
(SETQ DASHLST DASHING)
(SETQ DASHCNT (CAR DASHING))
(SETQ SEG# 0)
(SETQ IPDATA (fetch IMAGEDATA of IPSTREAM))
(MOVETO.IP IPSTREAM X0 Y0)
(replace IPXPOS of IPDATA with X0)
(replace IPYPOS of IPDATA with Y0)
(SETQ TT 0.0)
(SETQ DELTA 128)
(SETQ IX (FIXR X0))
(SETQ IY (FIXR Y0))
(for KNOT# from 1 to (SUB1 #KNOTS)
do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#)
(ELT X'' KNOT#)
(ELT X' KNOT#)
(ELT X KNOT#))
(LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#)
(ELT Y'' KNOT#)
(ELT Y' KNOT#)
(ELT Y KNOT#))
(SETQ XT (EVALPOLY XPOLY TT 3)) (* XT ← X (t) --Evaluate the next point)
(SETQ YT (EVALPOLY YPOLY TT 3)) (* YT ← Y (t))
[until (GEQ TT 1.0)
do (SETQ X'T (EVALPOLY X'POLY TT 2)) (* X'T ← X' (t))
(SETQ Y'T (EVALPOLY Y'POLY TT 2)) (* Y'T ← Y' (t))
(COND
((EQP X'T 0.0)
(SETQ X'T .0005)))
(COND
((EQP Y'T 0.0)
(SETQ Y'T .0005)))
[COND
((FGTP X'T 0.0)
(SETQ DX DELTA))
(T (SETQ DX (IMINUS DELTA]
[COND
((FGTP Y'T 0.0)
(SETQ DY DELTA))
(T (SETQ DY (IMINUS DELTA]
(SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX)
XT)
X'T))
(SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY)
YT)
Y'T))
[COND
((FLESSP XWALLDT YWALLDT)
(SETQ NEWT (FPLUS TT XWALLDT))
(SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T)))
IY)))
(T (SETQ NEWT (FPLUS TT YWALLDT))
(SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T)))
IX]
(COND
([AND (FGTP NEWT 1.0)
(OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS]
(SETQ NEWT 1.0)))
(SETQ NEWXT (EVALPOLY XPOLY NEWT 3))
(* New XT ← X (new t))
(SETQ NEWYT (EVALPOLY YPOLY NEWT 3))
(* New YT ← Y (new t))
(SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX)
NEWXT)))
(SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
NEWYT)))
(COND
((AND (IGREATERP DELTA 1)
(OR (FGTP XDIFF 1.0)
(FGTP YDIFF 1.0)))
(SETQ DELTA (LRSH DELTA 1)))
(T (if (IGREATERP (add SEG# 1)
MAXSEGSPERTRAJECTORY)
then (\SETBRUSH.IP IPSTREAM BRUSH)
(MASKSTROKE.IP IPSTREAM)
(SETQ SEG# 0)
(MOVETO.IP IPSTREAM (fetch IPXPOS of IPDATA)
(fetch IPYPOS of IPDATA)))
(LINETO.IP IPSTREAM (add (fetch IPXPOS of IPDATA)
DX)
(add (fetch IPYPOS of IPDATA)
DY))
(SETQ IX (IPLUS IX DX))
(SETQ IY (IPLUS IY DY))
(SETQ TT NEWT)
(SETQ XT NEWXT)
(SETQ YT NEWYT)
(COND
((AND (ILESSP DELTA 128)
(OR (FLESSP XDIFF .5)
(FLESSP YDIFF .5)))
(SETQ DELTA (LLSH DELTA 1]
(SETQ TT (FDIFFERENCE TT 1.0)))
(\SETBRUSH.IP IPSTREAM BRUSH)
(MASKSTROKE.IP IPSTREAM])
(\DRAWELLIPSE.IP
[LAMBDA (PRSTREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
(* rmk: "23-Aug-84 12:00")
(PROG [(SINOR (COND
(ORIENTATION (SIN ORIENTATION))
(T 0.0)))
(COSOR (COND
(ORIENTATION (COS ORIENTATION))
(T 1.0]
(\DRAWCURVE.IP PRSTREAM [LIST (CREATEPOSITION (PLUS CENTERX (FTIMES COSOR SEMIMAJORRADIUS))
(PLUS CENTERY (FTIMES SINOR SEMIMAJORRADIUS)))
(CREATEPOSITION (DIFFERENCE CENTERX (FTIMES SINOR
SEMIMINORRADIUS))
(PLUS CENTERY (FTIMES COSOR SEMIMINORRADIUS)))
(CREATEPOSITION (DIFFERENCE CENTERX (FTIMES COSOR
SEMIMAJORRADIUS))
(DIFFERENCE CENTERY (FTIMES SINOR
SEMIMAJORRADIUS)))
(CREATEPOSITION (PLUS CENTERX (FTIMES SINOR SEMIMINORRADIUS))
(DIFFERENCE CENTERY (FTIMES COSOR
SEMIMINORRADIUS]
T BRUSH DASHING)
(MOVETO CENTERX CENTERY PRSTREAM])
(\DRAWLINE.IP
[LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) (* rmk: "15-Aug-84 18:36")
(* A temporary interface function until we resolve the
color/endshape/operation conflicts in the D.I.G.
argument structure. Arguments are assumed to be in
micas.)
(SHOW.IP IPSTREAM)
(MOVETO.IP IPSTREAM X1 Y1)
(LINETO.IP IPSTREAM X2 Y2)
(\SETBRUSH.IP IPSTREAM (LIST (QUOTE BUTT)
WIDTH))
(MASKSTROKE.IP IPSTREAM)
(SETXY.IP IPSTREAM X2 Y2])
(\DSPBOTTOMMARGIN.IP
[LAMBDA (IPSTREAM YPOSITION) (* rmk: "26-Jun-84 14:01")
(PROG1 (fetch IPBOTTOM of (fetch IMAGEDATA of IPSTREAM))
(COND
(YPOSITION (replace IPBOTTOM of (fetch IMAGEDATA of IPSTREAM) with YPOSITION])
(\DSPFONT.IP
[LAMBDA (IPSTREAM FONT) (* rmk: "18-Oct-84 12:08")
(* Change fonts (or return the current font) for an IP
stream)
(PROG (OLDFONT FRAMEVAR (IPDATA (ffetch IMAGEDATA of IPSTREAM)))
(SETQ OLDFONT (ffetch IPFONT of IPDATA))
(AND (NULL FONT)
(RETURN OLDFONT))
(SHOW.IP IPSTREAM) (* ALWAYS do the show, so that font changes force
recomputation of the exact position in the printer.)
(COND
([EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT (QUOTE INTERPRESS))
(FONTCOPY OLDFONT FONT]
(* There was no change, or he was only asking for the
old font. Just return it.)
(RETURN OLDFONT)))
[SETQ FRAMEVAR (CDR (OR (ASSOC FONT (ffetch IPPAGEFONTS of IPDATA))
(DEFINEFONT.IP IPSTREAM FONT]
(* Get the font number to go in the file)
(APPENDINTEGER.IP IPSTREAM FRAMEVAR)
(APPENDOP.IP IPSTREAM SETFONT)
(freplace IPFONT of IPDATA with FONT) (* Remember the new font)
(freplace IPWIDTHSCACHE of IPDATA with (ffetch (ARRAYP BASE) of (ffetch \SFWidths
of FONT)))
[freplace IPSPACEWIDTH of IPDATA with (FIXR (TIMES (ffetch IPSPACEFACTOR of IPDATA)
(\FGETWIDTH (ffetch IPWIDTHSCACHE
of IPDATA)
(CHARCODE SPACE]
(* Set the linefeed distance to be one point more than
the font height)
[freplace IPLINEFEED of IPDATA with (IDIFFERENCE (CONSTANT (IMINUS (IQUOTIENT MICASPERINCH
POINTSPERINCH)))
(FONTPROP FONT (QUOTE HEIGHT]
(freplace NSTRANSTABLE of IPDATA with (ffetch OTHERDEVICEFONTPROPS of FONT))
(\FIXLINELENGTH.IP IPSTREAM)
(RETURN OLDFONT])
(\DSPLEFTMARGIN.IP
[LAMBDA (IPSTREAM XPOSITION) (* rmk: " 4-Oct-84 10:34")
(PROG1 (ffetch IPLEFT of (ffetch IMAGEDATA of IPSTREAM))
(COND
(XPOSITION (freplace IPLEFT of (ffetch IMAGEDATA of IPSTREAM) with XPOSITION)
(\FIXLINELENGTH.IP IPSTREAM])
(\DSPLINEFEED.IP
[LAMBDA (IPSTREAM DELTAY) (* rmk: " 4-Oct-84 09:26")
(* sets the amount that a line feed increases the y
coordinate by.)
(PROG ((IPDATA (ffetch IMAGEDATA of IPSTREAM)))
(RETURN (PROG1 (ffetch IPLINEFEED of IPDATA)
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace IPLINEFEED of IPDATA with DELTAY))
(T (\ILLEGAL.ARG DELTAY])
(\DSPRIGHTMARGIN.IP
[LAMBDA (IPSTREAM XPOSITION) (* rmk: " 4-Oct-84 10:33")
(PROG1 (ffetch IPRIGHT of (ffetch IMAGEDATA of IPSTREAM))
(COND
(XPOSITION (freplace IPRIGHT of (ffetch IMAGEDATA of IPSTREAM) with XPOSITION)
(\FIXLINELENGTH.IP IPSTREAM])
(\DSPSPACEFACTOR.IP
[LAMBDA (STREAM FACTOR) (* rmk: "18-Oct-84 12:54")
(PROG ((IPDATA (ffetch IMAGEDATA of STREAM)))
(RETURN (PROG1 (ffetch IPSPACEFACTOR of IPDATA)
(COND
(FACTOR [freplace IPSPACEWIDTH of IPDATA
with (FIXR (TIMES FACTOR (\FGETWIDTH (ffetch IPWIDTHSCACHE
of IPDATA)
(CHARCODE SPACE]
(* Doing the multiply first will insure that FACTOR is
a number)
(freplace IPSPACEFACTOR of IPDATA with FACTOR)
(SHOW.IP STREAM)
(APPENDNUMBER.IP STREAM FACTOR)
(ISET.IP STREAM AMPLIFYSPACE])
(\DSPTOPMARGIN.IP
[LAMBDA (IPSTREAM YPOSITION) (* rmk: "26-Jun-84 14:01")
(PROG1 (fetch IPTOP of (fetch IMAGEDATA of IPSTREAM))
(COND
(YPOSITION (replace IPTOP of (fetch IMAGEDATA of IPSTREAM) with YPOSITION])
(\DSPXPOSITION.IP
[LAMBDA (IPSTREAM XPOSITION) (* rmk: "16-Oct-84 12:30")
(PROG1 (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(COND
(XPOSITION (SHOW.IP IPSTREAM) (* (SETX.IP IPSTREAM XPOSITION))
(* Until our view of the printer's position is accurate, we can't rely on what we think the Xposition is, hence must
be sure not to do a SETXREL.)
(SETXY.IP IPSTREAM XPOSITION (fetch IPYPOS of (fetch IPDATA of IPSTREAM])
(\DSPYPOSITION.IP
[LAMBDA (IPSTREAM YPOSITION) (* rmk: "18-Jun-84 14:14")
(PROG1 (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
(COND
(YPOSITION (SHOW.IP IPSTREAM)
(SETY.IP IPSTREAM YPOSITION])
(\FIXLINELENGTH.IP
[LAMBDA (IPSTREAM) (* rmk: " 4-Oct-84 10:35")
(* IPSTREAM is known to be a stream of type interpress. Called by RIGHTMARGIN LEFTMARGIN and \SFFIXFONT to update
the LINELENGTH field in the stream. also called when the stream is created.)
(PROG (LLEN (IPDATA (ffetch IMAGEDATA of IPSTREAM)))
(freplace (STREAM LINELENGTH) of IPSTREAM
with (COND
((IGREATERP (SETQ LLEN (IQUOTIENT (IDIFFERENCE (ffetch IPRIGHT of IPDATA)
(ffetch IPLEFT of IPDATA))
(CHARWIDTH (CHARCODE A)
IPSTREAM)))
1)
LLEN)
(T 10])
(\MOVETO.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "17-Sep-84 18:51")
(SHOW.IP IPSTREAM)
(SETXY.IP IPSTREAM X Y])
(\SETBRUSH.IP
[LAMBDA (IPSTREAM BRUSH) (* rmk: "19-Oct-84 16:34")
(* Sets the stroke shape parameters.)
(PROG (WIDTH SHAPE)
[COND
((LISTP BRUSH)
(SETQ SHAPE (CAR BRUSH))
(SETQ WIDTH (OR (CAR (LISTP (CDR BRUSH)))
1)))
(T (SETQ SHAPE (QUOTE ROUND))
(SETQ WIDTH (OR BRUSH 1]
(APPENDNUMBER.IP IPSTREAM WIDTH)
(ISET.IP IPSTREAM STROKEWIDTH)
(APPENDNUMBER.IP IPSTREAM (SELECTQ SHAPE
(ROUND ROUND)
(SQUARE SQUARE)
(BUTT BUTT)
ROUND))
(ISET.IP IPSTREAM STROKEEND])
(\STRINGWIDTH.IP
[LAMBDA (STREAM STRING RDTBL) (* rmk: "18-Oct-84 12:21")
(* Returns the width of STRING in the interpress
STREAM, observing spacefactor)
(\STRINGWIDTH.GENERIC STRING (ffetch IPWIDTHSCACHE of (ffetch IMAGEDATA of STREAM))
RDTBL
(ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM])
)
(DEFINEQ
(\INTERPRESSINIT
[LAMBDA NIL (* rmk: "14-Nov-84 09:18")
(DECLARE (GLOBALVARS \IPIMAGEOPS \ASCIITONS \ASCIITOSTAR HIPPOTONS))
(SETQ \IPIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE INTERPRESS)
IMCLOSEFN ←(FUNCTION \CLOSEIPSTREAM)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.IP)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.IP)
IMFONT ←(FUNCTION \DSPFONT.IP)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.IP)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.IP)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.IP)
IMDRAWLINE ←(FUNCTION \DRAWLINE.IP)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.IP)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.IP)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.IP)
IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
IMBLTSHADE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
IMBITBLT ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BITBLT]
IMMOVETO ←(FUNCTION \MOVETO.IP)
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT MICASPERINCH POINTSPERINCH]
IMTERPRI ←(FUNCTION NEWLINE.IP)
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.IP)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.IP)
IMFONTCREATE ←(QUOTE INTERPRESS)
IMNEWPAGE ←(FUNCTION NEWPAGE.IP)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.IP)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.IP)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.IP)))
(* * Translation table for standard ascii to NS)
[SETQ \ASCIITONS (NSMAP NIL (QUOTE ((↑ 0 173)
(← 0 172)
($ 0 164)
(- 33 62)
(↑N 0 197)
(↑S 239 37)
(↑V 239 36)
(↑X 0 45)
(↑O 239 45)
(↑\ 239 44)
(↑Y 239 46)
(↑D 0 200)
(↑G 0 169)
(↑H 0 161)
(↑B 0 191)
(96 0 185)
(#↑%[ 239 36)
(#↑\ 239 37)
(#7 239 102] (* Map from ASCII to printer character code
(XC1-1-1 NS Encoding standard))
[SETQ \ASCIITOSTAR (NSMAP NIL (QUOTE ((↑ 0 173)
(← 0 172)
($ 0 164)
(↑N 0 197)
(↑S 239 37)
(↑V 239 36)
(↑X 0 45)
(↑O 239 45)
(↑\ 239 44)
(↑Y 239 46)
(↑D 0 200)
(↑G 0 169)
(↑H 0 161)
(↑B 0 191)
(96 0 185)
(#↑%[ 239 36)
(#↑\ 239 37)
(#7 239 102]
(* Map from ASCII to wedged OSD screen & .WD file character coding (alleged to be XC2-x-x, soon to come). The
difference is that "-" maps to itself for width purposes.)
(* Last 4 are backquote, hyphen instead of minus sign,
en dash, em dash, bullet)
])
)
(DEFINEQ
(SCALEREGION
[LAMBDA (SCALE REGION) (* rmk: "21-JUL-82 13:06")
(* Scales a region)
(create REGION
LEFT ←(FIX (FTIMES SCALE (fetch (REGION LEFT) of REGION)))
BOTTOM ←(FIX (FTIMES SCALE (fetch (REGION BOTTOM) of REGION)))
WIDTH ←(FIX (FTIMES SCALE (fetch (REGION WIDTH) of REGION)))
HEIGHT ←(FIX (FTIMES SCALE (fetch (REGION HEIGHT) of REGION])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ? DEFAULTPAGEREGION (SCALEREGION 2540 (CREATEREGION 1.1 .75 (FDIFFERENCE 7.5 1.1)
(FDIFFERENCE 10.5 .75))))
)
(* Interpress encoding values)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ MAXSEGSPERTRAJECTORY 100)
(CONSTANTS MAXSEGSPERTRAJECTORY)
)
(RPAQQ NONPRIMS ((BEGINMASTER 102)
(ENDMASTER 103)
(PAGEINSTRUCTIONS 105)
({ 106)
(} 107)))
(DECLARE: EVAL@COMPILE
(RPAQQ BEGINMASTER 102)
(RPAQQ ENDMASTER 103)
(RPAQQ PAGEINSTRUCTIONS 105)
(RPAQQ { 106)
(RPAQQ } 107)
(CONSTANTS (BEGINMASTER 102)
(ENDMASTER 103)
(PAGEINSTRUCTIONS 105)
({ 106)
(} 107))
)
(RPAQQ SEQUENCETYPES ((SEQADAPTIVEPIXELVECTOR 12)
(SEQCOMMENT 6)
(SEQCOMPRESSPIXELVECTOR 10)
(SEQCONTINUED 7)
(SEQIDENTIFIER 5)
(SEQINSERTFILE 11)
(SEQINTEGER 2)
(SEQLARGEVECTOR 8)
(SEQPACKEDPIXELVECTOR 9)
(SEQRATIONAL 4)
(SEQSTRING 1)))
(DECLARE: EVAL@COMPILE
(RPAQQ SEQADAPTIVEPIXELVECTOR 12)
(RPAQQ SEQCOMMENT 6)
(RPAQQ SEQCOMPRESSPIXELVECTOR 10)
(RPAQQ SEQCONTINUED 7)
(RPAQQ SEQIDENTIFIER 5)
(RPAQQ SEQINSERTFILE 11)
(RPAQQ SEQINTEGER 2)
(RPAQQ SEQLARGEVECTOR 8)
(RPAQQ SEQPACKEDPIXELVECTOR 9)
(RPAQQ SEQRATIONAL 4)
(RPAQQ SEQSTRING 1)
(CONSTANTS (SEQADAPTIVEPIXELVECTOR 12)
(SEQCOMMENT 6)
(SEQCOMPRESSPIXELVECTOR 10)
(SEQCONTINUED 7)
(SEQIDENTIFIER 5)
(SEQINSERTFILE 11)
(SEQINTEGER 2)
(SEQLARGEVECTOR 8)
(SEQPACKEDPIXELVECTOR 9)
(SEQRATIONAL 4)
(SEQSTRING 1))
)
(RPAQQ IPTYPES ((COLOR.IPTYPE 7)
(IDENTIFIER.IPTYPE 2)
(NUMBER.IPTYPE 1)
(OPERATOR.IPTYPE 4)
(OUTLINE.IPTYPE 9)
(PIXELARRAY.IPTYPE 6)
(TRAJECTORY.IPTYPE 8)
(TRANSFORMATION.IPTYPE 5)
(VECTOR.IPTYPE 3)))
(DECLARE: EVAL@COMPILE
(RPAQQ COLOR.IPTYPE 7)
(RPAQQ IDENTIFIER.IPTYPE 2)
(RPAQQ NUMBER.IPTYPE 1)
(RPAQQ OPERATOR.IPTYPE 4)
(RPAQQ OUTLINE.IPTYPE 9)
(RPAQQ PIXELARRAY.IPTYPE 6)
(RPAQQ TRAJECTORY.IPTYPE 8)
(RPAQQ TRANSFORMATION.IPTYPE 5)
(RPAQQ VECTOR.IPTYPE 3)
(CONSTANTS (COLOR.IPTYPE 7)
(IDENTIFIER.IPTYPE 2)
(NUMBER.IPTYPE 1)
(OPERATOR.IPTYPE 4)
(OUTLINE.IPTYPE 9)
(PIXELARRAY.IPTYPE 6)
(TRAJECTORY.IPTYPE 8)
(TRANSFORMATION.IPTYPE 5)
(VECTOR.IPTYPE 3))
)
(RPAQQ OPERATORS ((ABS 200)
(ADD 201)
(AND 202)
(CEILING 203)
(CONCAT 165)
(CONCATT 168)
(COPY 183)
(CORRECT 110)
(CORRECTMASK 156)
(CORRECTSPACE 157)
(COUNT 188)
(DIV 204)
(DO 231)
(DOSAVE 232)
(DOSAVEALL 233)
(DOSAVESIMPLEBODY 120)
(DUP 181)
(EQ 205)
(ERROR.IPOP 600)
(EXCH 185)
(FGET 20)
(FINDCOLOR 423)
(FINDCOLORMODELOPERATOR 422)
(FINDCOLOROPERATOR 421)
(FINDDECOMPRESSOR 149)
(FINDFONT 147)
(FLOOR 206)
(FSET 21)
(GE 207)
(GETCP 159)
(GETPROP 287)
(GT 208)
(IF 239)
(IFCOPY 240)
(IFELSE 241)
(IGET 18)
(ISET 19)
(LINETO 23)
(LINETOX 14)
(LINETOY 15)
(MAKEGRAY 425)
(MAKEOUTLINE 417)
(MAKEPIXELARRAY 450)
(MAKESAMPLEDBLACK 426)
(MAKESAMPLEDCOLOR 427)
(MAKESIMPLECO 114)
(MAKEPIXELARRAY 450)
(MAKEVEC 283)
(MAKEVECLU 282)
(MARK 186)
(MASKFILL 409)
(MASKPIXEL 452)
(MASKRECTANGLE 410)
(MASKSTROKE 24)
(MASKTRAPEZOIDX 411)
(MASKTRAPEZOIDY 412)
(MASKUNDERLINE 414)
(MASKVECTOR 441)
(MERGEPROP 288)
(MOD 209)
(MODIFYFONT 148)
(MOVE 169)
(MOVETO 25)
(MUL 210)
(NEG 211)
(NOP 1)
(NOT 212)
(OR 213)
(POP 180)
(REM 216)
(ROLL 184)
(ROTATE 163)
(ROUND.IPOP 217)
(SCALE.OP 164)
(SCALE2 166)
(SETCORRECTMEASURE 154)
(SETCORRECTTOLERANCE 155)
(SETFONT 151)
(SETGRAY 424)
(SETXREL 12)
(SETXY 10)
(SETXYREL 11)
(SETYREL 13)
(SHAPE.IPOP 285)
(SHOW 22)
(SHOWANDXREL 146)
(SPACE 16)
(STARTUNDERLINE 413)
(SUB 214)
(TRANS 170)
(TRANSLATE 162)
(TRUNC 215)
(TYPE.OP 220)
(UNMARK 187)
(UNMARK0 192)))
(DECLARE: EVAL@COMPILE
(RPAQQ ABS 200)
(RPAQQ ADD 201)
(RPAQQ AND 202)
(RPAQQ CEILING 203)
(RPAQQ CONCAT 165)
(RPAQQ CONCATT 168)
(RPAQQ COPY 183)
(RPAQQ CORRECT 110)
(RPAQQ CORRECTMASK 156)
(RPAQQ CORRECTSPACE 157)
(RPAQQ COUNT 188)
(RPAQQ DIV 204)
(RPAQQ DO 231)
(RPAQQ DOSAVE 232)
(RPAQQ DOSAVEALL 233)
(RPAQQ DOSAVESIMPLEBODY 120)
(RPAQQ DUP 181)
(RPAQQ EQ 205)
(RPAQQ ERROR.IPOP 600)
(RPAQQ EXCH 185)
(RPAQQ FGET 20)
(RPAQQ FINDCOLOR 423)
(RPAQQ FINDCOLORMODELOPERATOR 422)
(RPAQQ FINDCOLOROPERATOR 421)
(RPAQQ FINDDECOMPRESSOR 149)
(RPAQQ FINDFONT 147)
(RPAQQ FLOOR 206)
(RPAQQ FSET 21)
(RPAQQ GE 207)
(RPAQQ GETCP 159)
(RPAQQ GETPROP 287)
(RPAQQ GT 208)
(RPAQQ IF 239)
(RPAQQ IFCOPY 240)
(RPAQQ IFELSE 241)
(RPAQQ IGET 18)
(RPAQQ ISET 19)
(RPAQQ LINETO 23)
(RPAQQ LINETOX 14)
(RPAQQ LINETOY 15)
(RPAQQ MAKEGRAY 425)
(RPAQQ MAKEOUTLINE 417)
(RPAQQ MAKEPIXELARRAY 450)
(RPAQQ MAKESAMPLEDBLACK 426)
(RPAQQ MAKESAMPLEDCOLOR 427)
(RPAQQ MAKESIMPLECO 114)
(RPAQQ MAKEPIXELARRAY 450)
(RPAQQ MAKEVEC 283)
(RPAQQ MAKEVECLU 282)
(RPAQQ MARK 186)
(RPAQQ MASKFILL 409)
(RPAQQ MASKPIXEL 452)
(RPAQQ MASKRECTANGLE 410)
(RPAQQ MASKSTROKE 24)
(RPAQQ MASKTRAPEZOIDX 411)
(RPAQQ MASKTRAPEZOIDY 412)
(RPAQQ MASKUNDERLINE 414)
(RPAQQ MASKVECTOR 441)
(RPAQQ MERGEPROP 288)
(RPAQQ MOD 209)
(RPAQQ MODIFYFONT 148)
(RPAQQ MOVE 169)
(RPAQQ MOVETO 25)
(RPAQQ MUL 210)
(RPAQQ NEG 211)
(RPAQQ NOP 1)
(RPAQQ NOT 212)
(RPAQQ OR 213)
(RPAQQ POP 180)
(RPAQQ REM 216)
(RPAQQ ROLL 184)
(RPAQQ ROTATE 163)
(RPAQQ ROUND.IPOP 217)
(RPAQQ SCALE.OP 164)
(RPAQQ SCALE2 166)
(RPAQQ SETCORRECTMEASURE 154)
(RPAQQ SETCORRECTTOLERANCE 155)
(RPAQQ SETFONT 151)
(RPAQQ SETGRAY 424)
(RPAQQ SETXREL 12)
(RPAQQ SETXY 10)
(RPAQQ SETXYREL 11)
(RPAQQ SETYREL 13)
(RPAQQ SHAPE.IPOP 285)
(RPAQQ SHOW 22)
(RPAQQ SHOWANDXREL 146)
(RPAQQ SPACE 16)
(RPAQQ STARTUNDERLINE 413)
(RPAQQ SUB 214)
(RPAQQ TRANS 170)
(RPAQQ TRANSLATE 162)
(RPAQQ TRUNC 215)
(RPAQQ TYPE.OP 220)
(RPAQQ UNMARK 187)
(RPAQQ UNMARK0 192)
(CONSTANTS (ABS 200)
(ADD 201)
(AND 202)
(CEILING 203)
(CONCAT 165)
(CONCATT 168)
(COPY 183)
(CORRECT 110)
(CORRECTMASK 156)
(CORRECTSPACE 157)
(COUNT 188)
(DIV 204)
(DO 231)
(DOSAVE 232)
(DOSAVEALL 233)
(DOSAVESIMPLEBODY 120)
(DUP 181)
(EQ 205)
(ERROR.IPOP 600)
(EXCH 185)
(FGET 20)
(FINDCOLOR 423)
(FINDCOLORMODELOPERATOR 422)
(FINDCOLOROPERATOR 421)
(FINDDECOMPRESSOR 149)
(FINDFONT 147)
(FLOOR 206)
(FSET 21)
(GE 207)
(GETCP 159)
(GETPROP 287)
(GT 208)
(IF 239)
(IFCOPY 240)
(IFELSE 241)
(IGET 18)
(ISET 19)
(LINETO 23)
(LINETOX 14)
(LINETOY 15)
(MAKEGRAY 425)
(MAKEOUTLINE 417)
(MAKEPIXELARRAY 450)
(MAKESAMPLEDBLACK 426)
(MAKESAMPLEDCOLOR 427)
(MAKESIMPLECO 114)
(MAKEPIXELARRAY 450)
(MAKEVEC 283)
(MAKEVECLU 282)
(MARK 186)
(MASKFILL 409)
(MASKPIXEL 452)
(MASKRECTANGLE 410)
(MASKSTROKE 24)
(MASKTRAPEZOIDX 411)
(MASKTRAPEZOIDY 412)
(MASKUNDERLINE 414)
(MASKVECTOR 441)
(MERGEPROP 288)
(MOD 209)
(MODIFYFONT 148)
(MOVE 169)
(MOVETO 25)
(MUL 210)
(NEG 211)
(NOP 1)
(NOT 212)
(OR 213)
(POP 180)
(REM 216)
(ROLL 184)
(ROTATE 163)
(ROUND.IPOP 217)
(SCALE.OP 164)
(SCALE2 166)
(SETCORRECTMEASURE 154)
(SETCORRECTTOLERANCE 155)
(SETFONT 151)
(SETGRAY 424)
(SETXREL 12)
(SETXY 10)
(SETXYREL 11)
(SETYREL 13)
(SHAPE.IPOP 285)
(SHOW 22)
(SHOWANDXREL 146)
(SPACE 16)
(STARTUNDERLINE 413)
(SUB 214)
(TRANS 170)
(TRANSLATE 162)
(TRUNC 215)
(TYPE.OP 220)
(UNMARK 187)
(UNMARK0 192))
)
(RPAQQ TOKENFORMATS ((SHORTOP 128)
(LONGOP 160)
(SHORTNUMBER 0)
(SHORTSEQUENCE 192)
(LONGSEQUENCE 224)))
(DECLARE: EVAL@COMPILE
(RPAQQ SHORTOP 128)
(RPAQQ LONGOP 160)
(RPAQQ SHORTNUMBER 0)
(RPAQQ SHORTSEQUENCE 192)
(RPAQQ LONGSEQUENCE 224)
(CONSTANTS (SHORTOP 128)
(LONGOP 160)
(SHORTNUMBER 0)
(SHORTSEQUENCE 192)
(LONGSEQUENCE 224))
)
(RPAQQ IMAGERVARIABLES ((DCSCPX 0)
(DCSCPY 1)
(CORRECTMX 2)
(CORRECTMY 3)
(CURRENTTRANS 4)
(PRIORITYIMPORTANT 5)
(MEDIUMXSIZE 6)
(MEDIUMYSIZE 7)
(FIELDXMIN 8)
(FIELDYMIN 9)
(FIELDXMAX 10)
(FIELDYMAX 11)
(SHOWVEC 12)
(COLOR.IMVAR 13)
(NOIMAGE 14)
(STROKEWIDTH 15)
(STROKEEND 16)
(UNDERLINESTART 17)
(AMPLIFYSPACE 18)
(CORRECTPASS 19)
(CORRECTSHRINK 20)
(CORRECTTX 21)
(CORRECTTY 22)))
(DECLARE: EVAL@COMPILE
(RPAQQ DCSCPX 0)
(RPAQQ DCSCPY 1)
(RPAQQ CORRECTMX 2)
(RPAQQ CORRECTMY 3)
(RPAQQ CURRENTTRANS 4)
(RPAQQ PRIORITYIMPORTANT 5)
(RPAQQ MEDIUMXSIZE 6)
(RPAQQ MEDIUMYSIZE 7)
(RPAQQ FIELDXMIN 8)
(RPAQQ FIELDYMIN 9)
(RPAQQ FIELDXMAX 10)
(RPAQQ FIELDYMAX 11)
(RPAQQ SHOWVEC 12)
(RPAQQ COLOR.IMVAR 13)
(RPAQQ NOIMAGE 14)
(RPAQQ STROKEWIDTH 15)
(RPAQQ STROKEEND 16)
(RPAQQ UNDERLINESTART 17)
(RPAQQ AMPLIFYSPACE 18)
(RPAQQ CORRECTPASS 19)
(RPAQQ CORRECTSHRINK 20)
(RPAQQ CORRECTTX 21)
(RPAQQ CORRECTTY 22)
(CONSTANTS (DCSCPX 0)
(DCSCPY 1)
(CORRECTMX 2)
(CORRECTMY 3)
(CURRENTTRANS 4)
(PRIORITYIMPORTANT 5)
(MEDIUMXSIZE 6)
(MEDIUMYSIZE 7)
(FIELDXMIN 8)
(FIELDYMIN 9)
(FIELDXMAX 10)
(FIELDYMAX 11)
(SHOWVEC 12)
(COLOR.IMVAR 13)
(NOIMAGE 14)
(STROKEWIDTH 15)
(STROKEEND 16)
(UNDERLINESTART 17)
(AMPLIFYSPACE 18)
(CORRECTPASS 19)
(CORRECTSHRINK 20)
(CORRECTTX 21)
(CORRECTTY 22))
)
(RPAQQ STROKEENDS ((SQUARE 0)
(BUTT 1)
(ROUND 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ SQUARE 0)
(RPAQQ BUTT 1)
(RPAQQ ROUND 2)
(CONSTANTS (SQUARE 0)
(BUTT 1)
(ROUND 2))
)
(RPAQQ IP82CONSTANTS [(BEGINPREAMBLE {)
(ENDPREAMBLE })
(BEGINPAGE {)
(ENDPAGE })
(ENCODINGSTRING "Interpress/Xerox/1.0 ")
(NOVERSIONENCODINGSTRING "Interpress/Xerox/")
(MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16])
(DECLARE: EVAL@COMPILE
(RPAQ BEGINPREAMBLE {)
(RPAQ ENDPREAMBLE })
(RPAQ BEGINPAGE {)
(RPAQ ENDPAGE })
(RPAQ ENCODINGSTRING "Interpress/Xerox/1.0 ")
(RPAQ NOVERSIONENCODINGSTRING "Interpress/Xerox/")
(RPAQ MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))
[CONSTANTS (BEGINPREAMBLE {)
(ENDPREAMBLE })
(BEGINPAGE {)
(ENDPAGE })
(ENCODINGSTRING "Interpress/Xerox/1.0 ")
(NOVERSIONENCODINGSTRING "Interpress/Xerox/")
(MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16]
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS APPENDBYTE.IP DMACRO (= . \BOUT))
(PUTPROPS APPENDOP.IP MACRO [OPENLAMBDA (STREAM OP)
(COND
((CONSTANT (OR (ILESSP OP 0)
(IGREATERP OP 8191)))
(ERROR "Invalid Interpress operator code:" OP)))
(COND
((CONSTANT (ILEQ OP 31))
(APPENDBYTE.IP STREAM (LOGOR SHORTOP OP)))
(T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256)))
(APPENDBYTE.IP STREAM (MOD OP 256])
(PUTPROPS .IPFONTNAME. DMACRO ((FAMILY)
(SELECTQ FAMILY (TIMESROMAN (QUOTE CLASSIC))
(HELVETICA (QUOTE MODERN))
(LOGO (QUOTE LOGOTYPES))
(GACHA (QUOTE TERMINAL))
FAMILY)))
)
[DECLARE: EVAL@COMPILE
(RECORD IPSTREAM STREAM (SUBRECORD STREAM)
[ACCESSFNS ((IPDATA (fetch (STREAM IMAGEDATA) of DATUM)
(replace (STREAM IMAGEDATA) of DATUM with NEWVALUE))
(SHOWSTREAM (fetch (IPSTREAM IPDATA) of DATUM)
(replace (IPSTREAM IPDATA) of DATUM with NEWVALUE]
(TYPE? (type? INTERPRESSDATA of (fetch (STREAM IMAGEDATA) of DATUM))))
(DATATYPE INTERPRESSDATA (IPHEADING IPHEADINGFONT IPXPOS IPYPOS IPFONT IPPREAMBLEFONTS IPPAGEFONTS
IPWIDTHSCACHE IPCOLOR IPLINEFEED IPPAGESTATE IPSHOWSTREAM
XIPPAGEREGION IPBREAKPAGEFN (IPLEFT WORD)
(IPBOTTOM WORD)
(IPRIGHT WORD)
(IPTOP WORD)
(IPPAGENUM WORD)
(IPPREAMBLENEXTFRAMEVAR BYTE)
(IPNEXTFRAMEVAR BYTE)
(IPHEADINGOPVAR BYTE)
(NSCHARSET BYTE)
(NSTRANSTABLE POINTER)
(IPCORRECTSTARTX POINTER
(* Used with IPXPOS to compute width for CORRECTing
char strings during SHOW.))
(IPSPACEFACTOR POINTER)
(IPSPACEWIDTH POINTER (* cached width of space, taking space factor into
account)))
IPXPOS ← 0 IPYPOS ← 0 IPNEXTFRAMEVAR ← 0 IPSPACEFACTOR ← 1
[ACCESSFNS ((IPWIDTH (IDIFFERENCE (fetch (INTERPRESSDATA IPRIGHT)
of DATUM)
(fetch (INTERPRESSDATA IPLEFT)
of DATUM)))
(IPHEIGHT (IDIFFERENCE (fetch (INTERPRESSDATA IPTOP)
of DATUM)
(fetch (INTERPRESSDATA IPBOTTOM)
of DATUM)))
(IPPAGEREGION (fetch (INTERPRESSDATA XIPPAGEREGION)
of DATUM)
(PROGN (replace (INTERPRESSDATA XIPPAGEREGION)
of DATUM with NEWVALUE)
(replace (INTERPRESSDATA IPLEFT)
of DATUM with (fetch (REGION LEFT)
of NEWVALUE))
(replace (INTERPRESSDATA IPBOTTOM)
of DATUM with (fetch (REGION BOTTOM)
of NEWVALUE))
(replace (INTERPRESSDATA IPRIGHT)
of DATUM
with (IPLUS (fetch (REGION LEFT)
of NEWVALUE)
(fetch (REGION WIDTH)
of NEWVALUE)))
(replace (INTERPRESSDATA IPTOP)
of DATUM
with (IPLUS (fetch (REGION BOTTOM)
of NEWVALUE)
(fetch (REGION HEIGHT)
of NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD
BYTE BYTE BYTE BYTE POINTER POINTER POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD
BYTE BYTE BYTE BYTE POINTER POINTER POINTER POINTER)))
(DEFINEQ
(INTERPRESSBITMAP
[LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
(* rmk: "22-Oct-84 15:15")
(* Print a bitmap (usually from the screen) into an IP
file)
(OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
(PROG [(IPSTREAM (OPENIMAGESTREAM (OR OUTPUTFILE (QUOTE {CORE}IPBITMAP.SCRATCH))
(QUOTE INTERPRESS)))
[W (COND
(REGION (fetch (REGION WIDTH) of REGION))
(T (fetch BITMAPWIDTH of BITMAP]
(H (COND
(REGION (fetch (REGION HEIGHT) of REGION))
(T (fetch BITMAPHEIGHT of BITMAP]
(COND
(TITLE (RELMOVETO (IDIFFERENCE (TIMES 4 MICASPERINCH)
(STRINGWIDTH TITLE IPSTREAM))
0 IPSTREAM)
(PRIN1 TITLE IPSTREAM))) (* Try to center around within the pageframe margins)
[COND
(SCALEFACTOR (SETQ W (\RTIMES2 W SCALEFACTOR))
(SETQ H (\RTIMES2 H SCALEFACTOR]
(SELECTQ (SETQ ROTATION (IMOD (OR ROTATION DEFAULT.INTERPRESS.BITMAP.ROTATION)
360))
(0 (SETQ W (\RTIMES2 -1 W))
(SETQ H (\RTIMES2 -1 H)))
[270 (SETQ W (PROG1 H (SETQ H (\RTIMES2 -1 W]
(180)
[90 (SETQ H (PROG1 (\RTIMES2 -1 W)
(SETQ W (\RTIMES2 -1 H]
(ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
[\MOVETO.IP IPSTREAM [\RPLUS2 (\RTIMES2 MICASPERINCH 4.25)
(\RTIMES2 W (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
(\RPLUS2 (\RTIMES2 MICASPERINCH 5.5)
(\RTIMES2 H (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
(* Position so that the bitmap's image is centered on
the paper)
(SHOWBITMAP.IP IPSTREAM BITMAP REGION SCALEFACTOR ROTATION)
(RETURN (CLOSEF IPSTREAM])
)
(ADDTOVAR IMAGESTREAMTYPES (INTERPRESS [OPENSTREAM (LAMBDA (FILE OPTIONS)
(OPENIPSTREAM FILE (LISTGET OPTIONS
(QUOTE REGION))
(LISTGET OPTIONS
(QUOTE HEADING))
(LISTGET OPTIONS
(QUOTE FONTS))
(LISTGET OPTIONS
(QUOTE
BREAKPAGEFILENAME]
(FONTCREATE \CREATEINTERPRESSFONT)
(FONTSAVAILABLE \SEARCHINTERPRESSFONTS)))
(ADDTOVAR PRINTERTYPES ((INTERPRESS 8044)
(CANPRINT (INTERPRESS))
(STATUS NSPRINTER.STATUS)
(PROPERTIES NSPRINTER.PROPERTIES)
(SEND NSPRINT)
(BITMAPSCALE INTERPRESS.BITMAPSCALE)
(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
)
(ADDTOVAR PRINTFILETYPES [INTERPRESS (TEST INTERPRESSFILEP)
(EXTENSION (IP IPR INTERPRESS))
(CONVERSION (TEXT MAKEINTERPRESS TEDIT
(LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T
NIL NIL NIL
(QUOTE
INTERPRESS))
(CLOSEF? FILE)
PFILE])
(RPAQ? DEFAULT.INTERPRESS.BITMAP.ROTATION 90)
(* NS Character Encoding)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS NSCHAR MACRO ((NSCODE)
(LOGAND NSCODE 255)))
(PUTPROPS NSCHARCODE MACRO ((CHARSET CHAR)
(LOGOR (LLSH CHARSET 8)
CHAR)))
(PUTPROPS NSCHARSET MACRO ((NSCODE)
(LRSH NSCODE 8)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ NSCHARSETSHIFT 255)
(CONSTANTS (NSCHARSETSHIFT 255))
)
)
(DEFINEQ
(NSMAP
[LAMBDA (ZERODEFAULT MAP) (* rmk: " 8-Oct-84 16:41")
(PROG ((TABLE (ARRAY 256 (QUOTE WORD)
0 0)))
(OR ZERODEFAULT (for I from 0 to 255 do (SETA TABLE I I)))
[for X in MAP do (SETA TABLE (OR (FIXP (CAR X))
(APPLY* (FUNCTION CHARCODE)
(CAR X)))
(NSCHARCODE (CADR X)
(CADDR X]
(RETURN TABLE])
(\COERCEASCIITONSFONT
[LAMBDA (ASCIITONSMAPARRAY ASCIITONSFIXARRAY ASCIIFAMILY NSFAMILY SIZE FONTFACE ROTATION DEVICE)
(* jds " 6-Nov-84 15:47")
(* Produces an ascii font with the proper widths for
the ns-character correspondences defined by
ASCIITONSMAPARRAY)
(* ASCIITONSFIXARRAY is for temporary problems with
font compatibility between printer and widths/screen.
in OS5.0 fonts)
(PROG (CHARSETDIR [ASCIITONSMAP (fetch (ARRAYP BASE) of (\DTEST (OR ASCIITONSFIXARRAY
ASCIITONSMAPARRAY)
(QUOTE ARRAYP]
(FD (\CREATESTARFONT NSFAMILY SIZE FONTFACE ROTATION DEVICE)))
(OR FD (RETURN NIL))
(SETQ CHARSETDIR (CONS (CONS 0 FD)))
[for I NSCODE CS from 0 to 255 unless (OR (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)))
(ASSOC (SETQ CS (NSCHARSET NSCODE))
CHARSETDIR))
do (* Run thru the translate table looking for non-0
charsets. Add their width info to the directory)
(push CHARSETDIR (CONS CS
(COND
((\CREATESTARFONT NSFAMILY SIZE FONTFACE ROTATION DEVICE CS))
(T (* There isn't any info for that character.
Warn the guy, but continue.)
(FRESHLINE PROMPTWINDOW)
(printout PROMPTWINDOW
"Warning: Information about character set "
.I3.8 CS " missing from font " ASCIIFAMILY ,
SIZE ".")
NIL] (* Return if one of the fonts couldn't be found)
(bind CHARSETINFO for I NSCODE (WD ←(fetch \SFWidths of FD)) from 0 to 255
unless (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)))
when (SETQ CHARSETINFO (CDR (ASSOC (NSCHARSET NSCODE)
CHARSETDIR)))
do (* For each non-ASCII character, look for width info in
the right NS place. If none, use zero width.)
(SETA WD I (CHARWIDTH (NSCHAR NSCODE)
CHARSETINFO)))
[replace OTHERDEVICEFONTPROPS of FD with (fetch (ARRAYP BASE) of (\DTEST ASCIITONSMAPARRAY
(QUOTE ARRAYP]
[COND
((NEQ NSFAMILY ASCIIFAMILY)
(* Update the font deacriptor so it looks like it's really for the family the guy wanted. Also save the info we used
to get here.)
(replace FONTFAMILY of FD with ASCIIFAMILY)
(replace FONTDEVICESPEC of FD with (LIST NSFAMILY SIZE FONTFACE ROTATION DEVICE]
(RETURN FD])
(\CREATEINTERPRESSFONT
[LAMBDA (FAMILY SIZE FONTFACE ROTATION DEVICE) (* rmk: "23-Oct-84 22:15")
(* Creates a font descriptor for an NS font for
hardcopy. Tries first on the assumption that he gave us
the NS font name;)
(DECLARE (GLOBALVARS \SYMBOLTONSARRAY \ASCIITONS \ASCIITOSTAR ASCIITONSTRANSLATIONS))
(PROG (TRANSL) (* PROG so can get RETURN out of SELECTQ below)
(RETURN (COND
((\COERCEASCIITONSFONT \ASCIITONS \ASCIITOSTAR FAMILY FAMILY SIZE FONTFACE
ROTATION DEVICE))
((EQ FAMILY (QUOTE SYMBOL))
(\COERCEASCIITONSFONT \SYMBOLTONSARRAY \SYMBOLTONSARRAY (QUOTE SYMBOL)
(QUOTE MODERN)
SIZE FONTFACE ROTATION DEVICE))
((AND (SETQ TRANSL (SELECTQ FAMILY
(TIMESROMAN (QUOTE CLASSIC))
(HELVETICA (QUOTE MODERN))
(LOGO (QUOTE LOGOTYPES))
(GACHA (QUOTE TERMINAL))
NIL))
(\COERCEASCIITONSFONT \ASCIITONS \ASCIITOSTAR FAMILY TRANSL SIZE FONTFACE
ROTATION DEVICE)))
((SETQ TRANSL (ASSOC FAMILY ASCIITONSTRANSLATIONS))
(\COERCEASCIITONSFONT (COND
((NULL (CADR TRANSL))
\ASCIITONS)
((LITATOM (CADR TRANSL))
(EVAL (CADR TRANSL)))
(T (CADR TRANSL)))
(COND
((NULL (CADR TRANSL))
\ASCIITOSTAR)
(T NIL))
FAMILY
(OR (CADDR TRANSL)
(QUOTE MODERN))
SIZE FONTFACE ROTATION DEVICE])
(\SEARCHINTERPRESSFONTS
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE) (* rrb " 7-Nov-84 15:56")
(* * returns a list of the form (family size face rotation INTERPRESS) for any font matching the specs.
* is used as wildcard.)
(DECLARE (GLOBALVARS INTERPRESSFONTDIRECTORIES))
(bind FONTSFOUND THISFONT (FILENAMEPATTERN ←(\FONTFILENAME FAMILY PSIZE FACE (QUOTE WD)))
for DIR inside INTERPRESSFONTDIRECTORIES
do [for FONTFILE in (DIRECTORY (PACKFILENAME (QUOTE DIRECTORY)
DIR
(QUOTE BODY)
FILENAMEPATTERN))
when [PROGN (SETQ THISFONT (\FONTINFOFROMFILENAME FONTFILE (QUOTE INTERPRESS)))
(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])
)
(RPAQ? ASCIITONSTRANSLATIONS )
(* Catch the GACHA10 and any BI coercions to MODERN)
(ADDTOVAR ASCIITONSTRANSLATIONS (GACHA)
(CLASSIC)
(TIMESROMAN)
(HELVETICA)
(HIPPO HIPPOTONSARRAY CLASSIC)
(CYRILLIC CYRILLICTONSARRAY CLASSIC))
(READVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY)
({Y256 SMALLPOSP 0 0 0 180 42 0 61287 177 61309 61282 61283 61284 61285 0 184 0 0 61296 61298 61273
61272 8549 8550 0 0 61054 61305 61275 61274 8546 61299 0 0 0 174 173 175 61266 61250 61251 61303 61261
61263 0 0 61262 {R4 0} 8551 61258 61259 61281 0 61292 172 61365 61364 61290 61351 {R5 0} 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 61271 61270 0 61366 61367 61238
61239 61362 61363 61360 61361 123 125 61234 61235 61052 8514 61243 61242 8740 8742 61308 35 0 61301 {R
4 0} 167 61232 61233 182 64 211 163 164 {R128 0} } {Y256 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 164 37 38 39 40 41 42 43 44 8510 46
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 9793 9794 9809 9797 9798 9818 9796 9802 9804
9728 9805 9806 9807 9808 9810 9811 9803 9813 9814 9816 9817 9728 9821 9819 9820 9801 91 92 93 173 172
185 9825 9826 9841 9829 9830 9850 9828 9834 9836 9847 9837 9838 9839 9840 9842 9843 9835 9845 9846
9848 9849 9728 9853 9851 9852 9833 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 61220 61221 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 61286 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 } {Y256 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 10023 37 38 39 40
41 10041 43 44 8510 46 47 48 49 10095 51 10071 53 10088 55 10089 57 58 59 171 61 187 63 10047 10017
10018 10046 10021 10022 10038 10020 10049 10026 10027 10028 10029 10030 10031 10032 10033 10039 10034
10035 10036 10037 10019 10024 10045 10048 10025 10090 9984 10091 10044 10092 9984 10065 10066 10110
10069 10070 10086 10068 10097 10074 10075 10076 10077 10078 10079 10080 10081 10087 10082 10083 10084
10085 10067 10072 10093 10096 10073 10042 9984 10043 10040 9984 128 129 130 131 132 133 134 135 136
137 138 139 140 141 142 10094 144 145 146 147 148 149 150 151 152 153 154 61220 61221 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 61286 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 })
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INTERPRESSINIT)
)
(PUTPROPS INTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4306 8425 (\RTIMES2 4316 . 5879) (\RPLUS2 5881 . 7281) (RMINUS 7283 . 7559) (
CREATERATIONAL 7561 . 8211) (RATIONALTOINTEGER 8213 . 8423)) (10410 14720 (APPENDBYTE.IP 10420 . 10555
) (APPENDIDENTIFIER.IP 10557 . 11030) (APPENDINT.IP 11032 . 11259) (APPENDINTEGER.IP 11261 . 11638) (
APPENDLARGEVECTOR.IP 11640 . 12387) (APPENDNUMBER.IP 12389 . 12847) (APPENDOP.IP 12849 . 13254) (
APPENDRATIONAL.IP 13256 . 13596) (APPENDSEQUENCEDESCRIPTOR.IP 13598 . 14384) (BYTESININT.IP 14386 .
14551) (EXTRACTBYTE.IP 14553 . 14718)) (14752 27361 (BEGINMASTER.IP 14762 . 14917) (BEGINPAGE.IP 14919
. 15188) (BEGINPREAMBLE.IP 15190 . 15446) (CONCAT.IP 15448 . 15593) (CONCATT.IP 15595 . 15742) (
ENDMASTER.IP 15744 . 15895) (ENDPAGE.IP 15897 . 16180) (ENDPREAMBLE.IP 16182 . 16866) (FGET.IP 16868
. 17051) (FILLTRAJECTORY.IP 17053 . 17329) (FSET.IP 17331 . 17514) (GETFRAMEVAR.IP 17516 . 17833) (
INITIALIZEMASTER.IP 17835 . 18051) (ISET.IP 18053 . 18354) (LINETO.IP 18356 . 18709) (MASKSTROKE.IP
18711 . 18864) (MOVETO.IP 18866 . 19219) (ROTATE.IP 19221 . 19403) (SCALE.IP 19405 . 19588) (SCALE2.IP
19590 . 19808) (SETFONT.IP 19810 . 20281) (SETSPACE.IP 20283 . 20475) (SETXREL.IP 20477 . 21021) (
SETX.IP 21023 . 21966) (SETXY.IP 21968 . 22834) (SETXYREL.IP 22836 . 23643) (SETY.IP 23645 . 24439) (
SETYREL.IP 24441 . 24704) (SHOW.IP 24706 . 26509) (TRAJECTORY.IP 26511 . 26866) (TRANS.IP 26868 .
27132) (TRANSLATE.IP 27134 . 27359)) (27388 67349 (DEFINEFONT.IP 27398 . 28201) (FONTNAME.IP 28203 .
28987) (HEADINGOP.IP 28989 . 30294) (INTERPRESS.BITMAPSCALE 30296 . 30690) (INTERPRESS.OUTCHARFN 30692
. 32215) (INTERPRESSFILEP 32217 . 33235) (MAKEINTERPRESS 33237 . 33440) (NEWLINE.IP 33442 . 34122) (
NEWPAGE.IP 34124 . 37631) (NEWPAGE?.IP 37633 . 38031) (OPENIPSTREAM 38033 . 40538) (SETUPFONTS.IP
40540 . 41495) (SHOWBITMAP.IP 41497 . 44117) (SHOWBITMAP1.IP 44119 . 48814) (\CHARWIDTH.IP 48816 .
49350) (\CLOSEIPSTREAM 49352 . 49672) (\DRAWCIRCLE.IP 49674 . 50643) (\DRAWCURVE.IP 50645 . 52582) (
\IPCURVE2 52584 . 57686) (\DRAWELLIPSE.IP 57688 . 58705) (\DRAWLINE.IP 58707 . 59322) (
\DSPBOTTOMMARGIN.IP 59324 . 59632) (\DSPFONT.IP 59634 . 61996) (\DSPLEFTMARGIN.IP 61998 . 62348) (
\DSPLINEFEED.IP 62350 . 62900) (\DSPRIGHTMARGIN.IP 62902 . 63255) (\DSPSPACEFACTOR.IP 63257 . 64051) (
\DSPTOPMARGIN.IP 64053 . 64352) (\DSPXPOSITION.IP 64354 . 64920) (\DSPYPOSITION.IP 64922 . 65194) (
\FIXLINELENGTH.IP 65196 . 65930) (\MOVETO.IP 65932 . 66099) (\SETBRUSH.IP 66101 . 66877) (
\STRINGWIDTH.IP 66879 . 67347)) (67350 70410 (\INTERPRESSINIT 67360 . 70408)) (70411 70936 (
SCALEREGION 70421 . 70934)) (86126 88277 (INTERPRESSBITMAP 86136 . 88275)) (89887 96537 (NSMAP 89897
. 90394) (\COERCEASCIITONSFONT 90396 . 93418) (\CREATEINTERPRESSFONT 93420 . 95138) (
\SEARCHINTERPRESSFONTS 95140 . 96535)))))
STOP