(FILECREATED "14-Mar-84 22:33:18" {PHYLUM}<LISPCORE>SOURCES>INTERPRESS.;4 68465
changes to: (FNS \DSPXPOSITION.IP \DSPYPOSITION.IP)
previous date: "14-Mar-84 10:48:12" {PHYLUM}<LISPCORE>SOURCES>INTERPRESS.;3)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(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 NCHARS.IP INTERPRESS.CHARCODE \RTIMES2 \RPLUS2 RMINUS CREATERATIONAL
RATIONALTOINTEGER)
(DECLARE: DONTCOPY (CONSTANTS * RATIONALS))
(RECORDS RATIONAL))
(FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP
APPENDLISPSTRING.IP APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP
APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP EXTRACTBYTE.IP)
(* Operator interface)
(FNS BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CONCATT.IP CONCAT.IP DRAWLINE.IP
DRAWTRAJECTORY.IP ENDMASTER.IP ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLTRAJECTORY.IP
FSET.IP GETFRAMEVAR.IP INITIALIZEMASTER.IP LINETO.IP MOVETO.IP ROTATE.IP SCALE.IP
SCALE2.IP SETFONT.IP SETSPACE.IP SETXREL.IP SETXY.IP SETXYREL.IP SETYREL.IP SHOW.IP
SHOWSTRING.IP TRAJECTORY.IP TRANSLATE.IP TRANS.IP)
(* Graphics)
(FNS MASKSTROKE.IP STARTTRAJECTORY.IP TRAJECTORYSEGMENT.IP)
(* DIG interface)
(FNS CLOSEIPSTREAM DEFINEFONT.IP FONTNAME.IP HEADINGOP.IP INTERPRESS.OUTCHARFN
INTERPRESSFILEP INTERPRESS.BITMAPSCALE MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP
OPENIPSTREAM SETUPFONTS.IP SHOWBITMAP.IP \CREATEINTERPRESSFONT \DRAWLINE.IP \DSPFONT.IP
\DSPXPOSITION.IP \DSPYPOSITION.IP)
(DECLARE: DONTCOPY (MACROS IPBOUTCHARCODE))
(FNS \INTERPRESSINIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT)))
(FNS SCALEREGION)
[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS (DEFAULTPAGEREGION (SCALEREGION 2540
(CREATEREGION
1.1 .75
(FDIFFERENCE
7.5 1.1)
(FDIFFERENCE
10.5 .75]
[GLOBALRESOURCES (\IPSHOWSTREAM (\OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW]
(* Interpress encoding values)
(DECLARE: DONTCOPY (CONSTANTS * NONPRIMS)
(CONSTANTS * SEQUENCETYPES)
(CONSTANTS * TYPES)
(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 IP.PRIN3 IP.PRINTCENTERED)
[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))
(CONVERSION (TEXT MAKEINTERPRESS TEDIT
(LAMBDA (FILE PFILE)
(TEDIT.IP.HARDCOPY FILE PFILE
T]
[COMS (FNS INTERPRESSFONTPROFILE)
(ADDVARS (FONTSETUPFNS (4 NILL INTERPRESSFONTPROFILE)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (DEFAULTFONT (QUOTE INTERPRESS)
(QUOTE (GACHA 8))
(QUOTE NEW))
(FONTPROFILE FONTPROFILE]
(VARS DEFAULT.INTERPRESS.BITMAP.ROTATION)))
(* Literal interface)
(DECLARE: DONTCOPY
(* Change (or remove) when full IP-82 exists on printers)
(DECLARE: EVAL@COMPILE
(RPAQQ ENCODING IP-82)
(CONSTANTS (ENCODING (QUOTE IP-82)))
)
)
(* Rational operations and useful constants)
(DEFINEQ
(NCHARS.IP
[LAMBDA (STRING) (* jds "14-Mar-84 10:20")
(* Given a string, return the number of characters in
its NS encoding.)
(bind NSCHARS for CH instring (MKSTRING STRING) sum (COND
((LISTP (SETQ NSCHARS (INTERPRESS.CHARCODE
CH)))
(LENGTH NSCHARS))
(T 1])
(INTERPRESS.CHARCODE
[LAMBDA (CHARCODE) (* jds "12-Mar-84 14:03")
(* Given an ASCII character, returns the corresponding
character code (or list of codes, if that's needed) in
the NS character-encoding standard.)
(SELCHARQ CHARCODE
(↑ (* not in IP font)
173)
(← (* not in IP font)
172)
($ (* This is "general currency symbol" in NS charset)
164)
(- (* HYPHEN, as opposed to MINUS SIGN, which is 3x as
wide)
(QUOTE (255 33 62 255 0)))
(` (* Back quote)
185)
(#↑%[ (* EN dash)
(QUOTE (255 239 36 255 0)))
(#↑\ (* EM dash)
(QUOTE (255 239 37 255 0)))
(#7 (* Bullet)
(QUOTE (255 239 102 255 0)))
CHARCODE])
(\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])
(APPENDLISPSTRING.IP
[LAMBDA (STREAM STRING) (* jds "14-Mar-84 10:43")
(* Appends a Lisp string. This is not the APPENDSTRING procedure of the Interpress82 standard, which takes a
vector and encodes elements greater than 255 using the NS encoding (with 255 as an escape). However, an NS vector
can be encoded into a Lisp string by a separate function.)
(* NB THAT THE STRING CHARACTERS ARE CONVERTED INTO
THEIR NS EQUIVALENTS)
(APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQSTRING (NCHARS.IP STRING))
(IP.PRIN3 STRING STREAM])
(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: " 7-JUL-82 00:03")
(APPENDOP.IP IPSTREAM BEGIN])
(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])
(CONCATT.IP
[LAMBDA (IPSTREAM) (* rmk: " 7-JUL-82 00:08")
(APPENDOP.IP IPSTREAM CONCATT])
(CONCAT.IP
[LAMBDA (IPSTREAM) (* rmk: " 7-JUN-83 17:41")
(APPENDOP.IP IPSTREAM CONCAT])
(DRAWLINE.IP
[LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH ENDSHAPE) (* rmk: "23-JUL-82 15:09")
(MOVETO.IP IPSTREAM X1 Y1)
(LINETO.IP IPSTREAM X2 Y2)
(MASKSTROKE.IP IPSTREAM WIDTH ENDSHAPE])
(DRAWTRAJECTORY.IP
[LAMBDA (IPSTREAM POINTS WIDTH ENDSHAPE) (* rmk: "23-JUL-82 15:08")
(TRAJECTORY.IP IPSTREAM POINTS)
(MASKSTROKE.IP IPSTREAM WIDTH ENDSHAPE])
(ENDMASTER.IP
[LAMBDA (IPSTREAM) (* rmk: " 7-JUL-82 00:05")
(APPENDOP.IP IPSTREAM END])
(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: "13-JUL-82 01:12")
(IP.PRIN3 ENCODINGSTRING IPSTREAM])
(LINETO.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "21-JUL-82 14:02")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM LINETO])
(MOVETO.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "23-JUL-82 15:02")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM 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: "20-JUL-82 23:44")
(APPENDNUMBER.IP IPSTREAM S)
(APPENDOP.IP IPSTREAM SCALE])
(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 X) (* edited: "30-MAY-83 23:20")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDOP.IP IPSTREAM SETXREL)
(change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 X DATUM])
(SETXY.IP
[LAMBDA (IPSTREAM X Y) (* rmk: " 7-JUL-82 00:47")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM SETXY)
(replace IPXPOS of (fetch IPDATA of IPSTREAM) with X)
(replace IPYPOS of (fetch IPDATA of IPSTREAM) with Y])
(SETXYREL.IP
[LAMBDA (IPSTREAM X Y) (* edited: " 1-AUG-82 05:04")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM SETXYREL)
(change (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 DATUM X))
(change (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
(\RPLUS2 DATUM 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) (* edited: "30-MAY-83 23:21")
(* Shows a string buffered away in SHOWSTREAM)
(PROG [LEN (SHOWSTREAM (fetch IPSHOWSTREAM of (fetch IPDATA of IPSTREAM]
(SETQ LEN (\GETFILEPTR SHOWSTREAM))
(COND
((IGREATERP LEN 0)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQSTRING LEN)
(COPYBYTES SHOWSTREAM IPSTREAM 0 LEN)
(APPENDOP.IP IPSTREAM SHOW)
(\SETFILEPTR SHOWSTREAM 0])
(SHOWSTRING.IP
[LAMBDA (IPSTREAM STRING) (* rmk: " 7-JUL-82 00:10")
(* Shows a Lisp string--actually, any Lisp object cause
of Lisp's implicit coercions.)
(APPENDLISPSTRING.IP IPSTREAM STRING)
(APPENDOP.IP IPSTREAM SHOW])
(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])
(TRANSLATE.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "21-JUL-82 13:23")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM TRANSLATE])
(TRANS.IP
[LAMBDA (IPSTREAM) (* rmk: "11-JUN-83 22:20")
(* This translates the origin to the current position.)
(APPENDOP.IP IPSTREAM TRANS])
)
(* Graphics)
(DEFINEQ
(MASKSTROKE.IP
[LAMBDA (IPSTREAM WIDTH ENDSHAPE) (* rmk: "19-OCT-83 23:47")
(APPENDNUMBER.IP IPSTREAM (OR WIDTH 1))
(APPENDINTEGER.IP IPSTREAM STROKEWIDTH)
(APPENDOP.IP IPSTREAM ISET)
(APPENDNUMBER.IP IPSTREAM (OR ENDSHAPE ROUND))
(APPENDINTEGER.IP IPSTREAM STROKEEND)
(APPENDOP.IP IPSTREAM ISET)
(APPENDOP.IP IPSTREAM MASKSTROKE])
(STARTTRAJECTORY.IP
[LAMBDA (IPSTREAM STARTX STARTY WIDTH SHAPE) (* edited: "30-MAY-83 23:22")
(APPENDNUMBER.IP IPSTREAM WIDTH)
(APPENDINTEGER.IP IPSTREAM STROKEWIDTH)
(APPENDOP.IP IPSTREAM ISET)
(APPENDNUMBER.IP IPSTREAM SHAPE)
(APPENDINTEGER.IP IPSTREAM STROKEEND)
(APPENDOP.IP IPSTREAM ISET)
(MOVETO.IP IPSTREAM STARTX STARTY])
(TRAJECTORYSEGMENT.IP
[LAMBDA (IPSTREAM X Y) (* rmk: "21-JUL-82 14:02")
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM Y)
(APPENDOP.IP IPSTREAM LINETO])
)
(* DIG interface)
(DEFINEQ
(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])
(DEFINEFONT.IP
[LAMBDA (IPSTREAM FONT) (* rmk: "18-AUG-83 18:13")
(* Note current kludge: Makeinterpress assumes that the
preamble fonts are assigned framevars 1 thru n)
(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 SIZE]
(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) (* jds " 8-Mar-84 19:18")
(* Convert a Lisp font name to the proper NS font name)
(PROG (FACE NAME)
[COND
((EQ (QUOTE ITALIC)
(FONTPROP FONTDESC (QUOTE SLOPE)))
(SETQ FACE (QUOTE (-Italic]
[COND
((EQ (QUOTE BOLD)
(FONTPROP FONTDESC (QUOTE WEIGHT)))
(push FACE (QUOTE -Bold]
[SETQ NAME (.IPFONTNAME. (FONTPROP FONTDESC (QUOTE FAMILY]
[COND
(FACE (SETQ NAME (PACK (CONS NAME FACE]
(RETURN (APPEND (QUOTE (XEROX XC82-0-0))
(CONS NAME])
(HEADINGOP.IP
[LAMBDA (IPSTREAM HEADING) (* rmk: "18-AUG-83 17: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)
(SHOWSTRING.IP IPSTREAM HEADING)
(SETXREL.IP IPSTREAM MICASPERINCH) (* Skip an inch before page number)
(SHOWSTRING.IP IPSTREAM "Page ")
(APPENDOP.IP IPSTREAM SHOW) (* Show the page number argument
(from stack))
(NEWLINE.IP IPSTREAM) (* Skip 2 lines--have to pick up the linefeed from the
heading font)
(NEWLINE.IP IPSTREAM)))
(APPENDOP.IP IPSTREAM })
(FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP IPSTREAM])
(INTERPRESS.OUTCHARFN
[LAMBDA (IPSTREAM CHARCODE) (* jds "12-Mar-84 14:04")
(SELCHARQ CHARCODE
(EOL (NEWLINE.IP IPSTREAM))
[LF (SHOW.IP IPSTREAM) (* Currently doesn't bother to check for page overflow.
Sigh.)
(PROGN (DECLARE (GLOBALVARS PRESSLINELEAD))
(SETYREL.IP IPSTREAM (IMINUS (IPLUS PRESSLINELEAD
(FONTPROP (fetch IPFONT
of (fetch IPDATA
of IPSTREAM))
(QUOTE HEIGHT]
(↑L (NEWPAGE.IP IPSTREAM))
(FOR NSCHARCODE INSIDE (INTERPRESS.CHARCODE CHARCODE) DO (IPBOUTCHARCODE IPSTREAM
NSCHARCODE])
(INTERPRESSFILEP
[LAMBDA (FILE) (* rmk: "22-SEP-83 09:15")
(* 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 ENCODINGSTRING))
when (OR (EOFP STRM)
(NEQ (NTHCHARCODE ENCODINGSTRING I)
(BIN STRM)))
do (RETURN NIL) finally (RETURN (FULLNAME STRM])
(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])
(MAKEINTERPRESS
[LAMBDA (FILE IPFILE FONTS HEADING TABS) (* jds "12-Mar-84 13:59")
(DECLARE (GLOBALVARS PRESSTABSTOPS))
(RESETLST
(PROG [INSTRM SHOWSTREAM INFILE INEOLC MTABS IPSTREAM MAXFONT (FONTARRAY (FONTMAPARRAY
FONTS
(QUOTE INTERPRESS]
(SETQ MAXFONT (ARRAYSIZE FONTARRAY))
[RESETSAVE [SETQ INFILE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
8
(QUOTE ((SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[RESETSAVE [SETQ IPSTREAM (OPENIPSTREAM (OR IPFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE IP)
(QUOTE BODY)
INFILE))
NIL
[AND (NEQ HEADING T)
(OR HEADING (CONCAT INFILE " "
(GETFILEINFO
INFILE
(QUOTE CREATIONDATE]
(for I from 1 to MAXFONT collect (ELT FONTARRAY I]
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
(SETQ SHOWSTREAM (fetch IPSHOWSTREAM of (fetch IMAGEDATA of IPSTREAM)))
(SETQ INSTRM (\INSTREAMARG INFILE))
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION ZERO))
(SETQ INEOLC (fetch EOLCONVENTION of INSTRM))
[bind C FC
do (SETQ C (\BIN INSTRM))
(COND
([IGREATERP C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (↑F CR LF ↑L TAB NULL]
(for CH inside (INTERPRESS.CHARCODE C)
do (* Convert the character to NS character-encoding
standard, if need be, then emit it)
(\BOUT SHOWSTREAM CH)))
(T (SELCHARQ C
[↑F (* Font shift)
(SELCHARQ (SETQ FC (\BIN INSTRM))
[↑T (* tab to absolute pos.)
(COND
((ZEROP (SETQ FC (\BIN INSTRM)))
(\BOUT SHOWSTREAM (CHARCODE ↑F))
(\BOUT SHOWSTREAM (CHARCODE ↑T))
(AND (\EOFP INSTRM)
(RETURN))
(\BOUT SHOWSTREAM FC))
(T [OR MTABS (SETQ MTABS
(for TAB in (OR TABS PRESSTABSTOPS)
collect (millsToMicas TAB]
(SETQ FC (OR (CAR (NTH MTABS FC))
(ERROR
"Undefined absolute tab number"
FC)))
(SHOW.IP IPSTREAM)
(SETXY.IP IPSTREAM FC
(fetch IPYPOS
of (fetch IPDATA of IPSTREAM]
(NULL (\BOUT SHOWSTREAM (CHARCODE ↑F))
(* EOF after ↑F)
(AND (\EOFP INSTRM)
(RETURN))
(\BOUT SHOWSTREAM FC))
(COND
((IGEQ MAXFONT FC)
(\DSPFONT.IP IPSTREAM (ELT FONTARRAY FC)))
(T (\BOUT SHOWSTREAM (CHARCODE ↑F))
(\BOUT SHOWSTREAM FC]
[CR (SELECTC INEOLC
(CR.EOLC (NEWLINE.IP IPSTREAM))
[CRLF.EOLC (COND
((EQ (CHARCODE LF)
(\PEEKBIN INSTRM T))
(\BIN INSTRM)
(NEWLINE.IP IPSTREAM))
(T (PROG ((IPDATA (fetch IPDATA
of IPSTREAM)))
(SHOW.IP IPSTREAM)
(SETXY.IP IPSTREAM
(fetch IPLEFT
of IPDATA)
(fetch IPYPOS
of IPDATA]
(PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
(* Move to left margin)
(SHOW.IP IPSTREAM)
(SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
(fetch IPYPOS of IPDATA]
[LF (COND
((EQ INEOLC LF.EOLC)
(NEWLINE.IP IPSTREAM))
(T (SHOW.IP IPSTREAM)
(PROG (DELTAY (IPDATA (fetch IPDATA of IPSTREAM)))
[SETQ DELTAY (IPLUS PRESSLINELEAD
(FONTPROP (fetch IPFONT
of IPDATA)
(QUOTE HEIGHT]
(COND
((ILESSP (IDIFFERENCE (fetch IPYPOS of IPDATA)
DELTAY)
(fetch IPBOTTOM of IPDATA))
(NEWPAGE.IP IPSTREAM))
(T (SETXYREL.IP IPSTREAM 0 DELTAY]
(↑L (NEWPAGE.IP IPSTREAM))
(TAB (SHOW.IP IPSTREAM)
(SETXYREL.IP IPSTREAM
(UNFOLD (CHARWIDTH (CHARCODE SPACE)
(fetch IPFONT
of (fetch IPDATA
of IPSTREAM)))
8)
0))
(NULL (AND (\EOFP INSTRM)
(RETURN))
(\BOUT SHOWSTREAM C))
(\BOUT SHOWSTREAM C]
(RETURN (LIST (CLOSEF INSTRM)
(CLOSEF IPSTREAM])
(NEWLINE.IP
[LAMBDA (IPSTREAM) (* rmk: "18-AUG-83 17:34")
(* Doesn't check for page overflow--wait until something
is actually shown.)
(DECLARE (GLOBALVARS PRESSLINELEAD))
(SHOW.IP IPSTREAM)
(PROG (NEWYPOS (IPDATA (fetch IPDATA of IPSTREAM)))
[SETQ NEWYPOS (IDIFFERENCE (fetch IPYPOS of IPDATA)
(IPLUS PRESSLINELEAD (FONTPROP (fetch IPFONT of IPDATA)
(QUOTE HEIGHT]
(COND
((ILESSP NEWYPOS (fetch IPBOTTOM of IPDATA))
(NEWPAGE.IP IPSTREAM))
(T (SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA)
NEWYPOS])
(NEWPAGE.IP
[LAMBDA (IPSTREAM) (* rmk: " 2-NOV-83 15:04")
(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)
(TRANSLATE.IP IPSTREAM (fetch (REGION LEFT) of (fetch IPPAGEREGION of IPDATA))
(fetch (REGION BOTTOM) of (fetch IPPAGEREGION of IPDATA)))
(CONCATT.IP IPSTREAM)
[COND
[(fetch IPHEADING of IPDATA)
(SETQ HFONT (fetch IPHEADINGFONT of IPDATA))
(\DSPFONT.IP IPSTREAM HFONT) (* Set up heading font)
(APPENDLISPSTRING.IP IPSTREAM (add (fetch IPPAGENUM of IPDATA)
1))
(SELECTQ ENCODING
(FULLIP-82 (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.IP IPSTREAM HFONT)
(SHOWSTRING.IP IPSTREAM (fetch IPHEADING of IPDATA))
(SETXREL.IP IPSTREAM MICASPERINCH)
(* Skip an inch before page number)
(SHOWSTRING.IP IPSTREAM "Page ")
(APPENDOP.IP IPSTREAM SHOW) (* Show the page number argument
(from stack))
(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 the preamble and
heading)
(\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) (* rmk: "16-Dec-83 12:59")
(* 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))
]
(COND
([OR (NEQ \NOIMAGEOPS (fetch (IPSTREAM IMAGEOPS) of IPSTREAM))
(NOT (ZEROP (GETEOFPTR IPSTREAM]
(ERROR "can't convert existing file to Interpress" IPFILE)
(* 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: "22-SEP-83 22:10")
(* 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 (QUOTE INTERPRESS)))
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) (* lmm "14-JUN-83 02:21")
(* Puts out bit map with lower-left corner at current
position. If given, REGION is a clipping region on the
bitmap.)
(SHOW.IP IPSTREAM)
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {)
(TRANS.IP IPSTREAM) (* Translate to the current position)
[COND
(REGION (* can't handle regions simply.
Just copy for now.)
(SETQ BITMAP (PROG [(BM (BITMAPCREATE (fetch WIDTH of REGION)
(fetch HEIGHT of REGION]
(with REGION REGION (BITBLT BITMAP LEFT BOTTOM BM NIL NIL WIDTH
HEIGHT))
(RETURN BM]
(PROG (NBYTES (XPIXELS (fetch BITMAPWIDTH of BITMAP))
(YPIXELS (fetch BITMAPHEIGHT of BITMAP))
(RW (fetch BITMAPRASTERWIDTH of BITMAP)))
(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 (ROTATE.IP IPSTREAM -90)
(TRANSLATE.IP IPSTREAM 0 YPIXELS)
(CONCAT.IP IPSTREAM))
(90 (* need nop)
(TRANSLATE.IP IPSTREAM 0 0))
(180 (ROTATE.IP IPSTREAM 90)
(TRANSLATE.IP IPSTREAM XPIXELS YPIXELS)
(CONCAT.IP IPSTREAM))
(270 (ROTATE.IP IPSTREAM 180)
(TRANSLATE.IP IPSTREAM XPIXELS 0)
(CONCAT.IP IPSTREAM))
(ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
[SCALE.IP IPSTREAM (COND
[SCALE (\RTIMES2 SCALE (CONSTANT (\RTIMES2 4 MICASPERRAVENSPOT]
(T (CONSTANT (\RTIMES2 4 MICASPERRAVENSPOT]
(* Go to unit of 4 raven spots ~= 1 screen point)
(CONCAT.IP IPSTREAM)
(SETQ NBYTES (ITIMES (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
BYTESPERWORD)
YPIXELS))
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 NBYTES))
(APPENDINT.IP IPSTREAM 1 2)
(APPENDINT.IP IPSTREAM XPIXELS 2)
(\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
0 NBYTES)
(APPENDOP.IP IPSTREAM MAKEPIXELARRAY)
(APPENDOP.IP IPSTREAM MASKPIXEL))
(APPENDOP.IP IPSTREAM }])
(\CREATEINTERPRESSFONT
[LAMBDA (FAMILY SIZE FONTFACE ROTATION DEVICE) (* jds "11-Jan-84 14:48")
(* Temporary hack: It tries to build widths from standard Press widths file. Does name coercion of IP fonts back
to Press fonts as a best approximation.)
(OR [PROG (FONT (FAM (SELECTQ FAMILY
(MODERN (QUOTE FRUTIGER))
(CLASSIC (QUOTE CENTURY))
(LOGOTYPES (QUOTE LOGO))
FAMILY)))
(COND
((AND FAM (SETQ FONT (\CREATESTARFONT FAM SIZE FONTFACE ROTATION DEVICE)))
(replace FONTFAMILY of FONT with FAMILY)
(RETURN FONT]
[PROG (FONT (FAM (SELECTQ (U-CASE (.IPFONTNAME. FAMILY))
(MODERN (QUOTE FRUTIGER))
(CLASSIC (QUOTE CENTURY))
(LOGOTYPES (QUOTE LOGO))
NIL)))
(COND
((AND FAM (SETQ FONT (\CREATESTARFONT FAM SIZE FONTFACE ROTATION DEVICE)))
(replace FONTFAMILY of FONT with FAMILY)
(RETURN FONT]
(\CREATEPRESSFONT FAMILY SIZE FONTFACE ROTATION DEVICE])
(\DRAWLINE.IP
[LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) (* rmk: "19-OCT-83 23:48")
(* A temporary interface function until we resolve the color/endshape/operation conflicts in the D.I.G.
argument structure. Also temporarily, we assume that arguments are in screen points, convert to micas.)
(DRAWLINE.IP IPSTREAM (\RTIMES2 X1 MICASPERSCREENPOINT)
(\RTIMES2 Y1 MICASPERSCREENPOINT)
(\RTIMES2 X2 MICASPERSCREENPOINT)
(\RTIMES2 Y2 MICASPERSCREENPOINT)
(COND
(WIDTH (\RTIMES2 WIDTH MICASPERSCREENPOINT))
(T MICASPERSCREENPOINT])
(\DSPFONT.IP
[LAMBDA (IPSTREAM FONT) (* rmk: "11-Dec-83 21:24")
(PROG (OLDFONT FRAMEVAR (IPDATA (fetch IPDATA of IPSTREAM)))
(SETQ OLDFONT (fetch IPFONT of IPDATA))
(COND
([OR (NULL FONT)
(EQ OLDFONT (SETQ FONT (\GETFONTDESC FONT (QUOTE INTERPRESS]
(RETURN OLDFONT)))
(SHOW.IP IPSTREAM)
[SETQ FRAMEVAR (CDR (OR (ASSOC FONT (fetch IPPAGEFONTS of IPDATA))
(DEFINEFONT.IP IPSTREAM FONT]
(APPENDNUMBER.IP IPSTREAM FRAMEVAR)
(APPENDOP.IP IPSTREAM SETFONT)
(replace IPFONT of IPDATA with FONT)
(replace IPWIDTHSCACHE of IPDATA with (fetch (ARRAYP BASE) of (fetch \SFWidths
of FONT)))
(RETURN OLDFONT])
(\DSPXPOSITION.IP
[LAMBDA (IPSTREAM XPOSITION) (* rmk: "14-Mar-84 22:32")
(PROG [(OLDPOS (fetch IPXPOS of (fetch IPDATA of IPSTREAM]
[COND
(XPOSITION (SHOW.IP IPSTREAM)
(SETXREL.IP IPSTREAM (IDIFFERENCE XPOSITION OLDPOS]
(RETURN OLDPOS])
(\DSPYPOSITION.IP
[LAMBDA (IPSTREAM YPOSITION) (* rmk: "14-Mar-84 22:32")
(PROG [(OLDPOS (fetch IPYPOS of (fetch IPDATA of IPSTREAM]
[COND
(YPOSITION (SHOW.IP IPSTREAM)
(SETYREL.IP IPSTREAM (IDIFFERENCE YPOSITION OLDPOS]
(RETURN OLDPOS])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS IPBOUTCHARCODE MACRO (OPENLAMBDA (IPSTREAM CHARCODE)
(PROG ((IPDATA (fetch IPDATA of IPSTREAM)))
(add (fetch IPXPOS of IPDATA)
(\FGETWIDTH (ffetch IPWIDTHSCACHE of IPDATA)
CHARCODE))
(\BOUT (fetch IPSHOWSTREAM of IPDATA)
CHARCODE))))
)
)
(DEFINEQ
(\INTERPRESSINIT
[LAMBDA NIL (* rmk: "22-OCT-83 13:00")
(DECLARE (GLOBALVARS \IPIMAGEOPS))
(SETQ \IPIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE INTERPRESS)
IMCLOSEFN ←(FUNCTION CLOSEIPSTREAM)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.IP)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.IP)
IMFONT ←(FUNCTION \DSPFONT.IP)
IMLEFTMARGIN ←(FUNCTION \ILLEGAL.ARG)
IMRIGHTMARGIN ←(FUNCTION \ILLEGAL.ARG)
IMLINEFEED ←(FUNCTION \ILLEGAL.ARG)
IMDRAWLINE ←(FUNCTION \DRAWLINE.IP)
IMDRAWCURVE ←(FUNCTION \ILLEGAL.ARG)
IMDRAWCIRCLE ←(FUNCTION \ILLEGAL.ARG)
IMDRAWELLIPSE ←(FUNCTION \ILLEGAL.ARG)
IMFILLCIRCLE ←(FUNCTION \ILLEGAL.ARG)
IMBLTSHADE ←(FUNCTION \ILLEGAL.ARG)
IMBITBLT ←(FUNCTION \ILLEGAL.ARG])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INTERPRESSINIT)
)
(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))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
[PUTDEF (QUOTE \IPSHOWSTREAM)
(QUOTE GLOBALRESOURCES)
(QUOTE (\OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \IPSHOWSTREAM)
)
(RPAQQ \IPSHOWSTREAM NIL)
(* Interpress encoding values)
(DECLARE: DONTCOPY
(RPAQQ NONPRIMS ((BEGIN 102)
(END 103)
({ 106)
(} 107)))
(DECLARE: EVAL@COMPILE
(RPAQQ BEGIN 102)
(RPAQQ END 103)
(RPAQQ { 106)
(RPAQQ } 107)
(CONSTANTS (BEGIN 102)
(END 103)
({ 106)
(} 107))
)
(RPAQQ SEQUENCETYPES ((SEQCOMMENT 6)
(SEQCOMPRESSPIXELVECTOR 10)
(SEQCONTINUED 7)
(SEQIDENTIFIER 5)
(SEQINSERTFILE 11)
(SEQINTEGER 2)
(SEQLARGEVECTOR 8)
(SEQPACKEDPIXELVECTOR 9)
(SEQRATIONAL 4)
(SEQSTRING 1)))
(DECLARE: EVAL@COMPILE
(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 (SEQCOMMENT 6)
(SEQCOMPRESSPIXELVECTOR 10)
(SEQCONTINUED 7)
(SEQIDENTIFIER 5)
(SEQINSERTFILE 11)
(SEQINTEGER 2)
(SEQLARGEVECTOR 8)
(SEQPACKEDPIXELVECTOR 9)
(SEQRATIONAL 4)
(SEQSTRING 1))
)
(RPAQQ TYPES ((COLOR.TYPE 7)
(IDENTIFIER 2)
(NUMBER 1)
(OPERATOR 4)
(OUTLINE 9)
(PIXELARRAY 6)
(TRAJECTORY 8)
(TRANSFORMATION 5)
(VECTOR 3)))
(DECLARE: EVAL@COMPILE
(RPAQQ COLOR.TYPE 7)
(RPAQQ IDENTIFIER 2)
(RPAQQ NUMBER 1)
(RPAQQ OPERATOR 4)
(RPAQQ OUTLINE 9)
(RPAQQ PIXELARRAY 6)
(RPAQQ TRAJECTORY 8)
(RPAQQ TRANSFORMATION 5)
(RPAQQ VECTOR 3)
(CONSTANTS (COLOR.TYPE 7)
(IDENTIFIER 2)
(NUMBER 1)
(OPERATOR 4)
(OUTLINE 9)
(PIXELARRAY 6)
(TRAJECTORY 8)
(TRANSFORMATION 5)
(VECTOR 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)
(EXCH 185)
(FGET 20)
(FINDDECOMPRESSOR 149)
(FINDFONT 147)
(FLOOR 206)
(FSET 21)
(GE 207)
(GETCP 159)
(GT 208)
(IF 239)
(IFCOPY 240)
(IFELSE 241)
(IGET 18)
(ISET 19)
(LINETO 23)
(LINETOX 14)
(LINETOY 15)
(MAKEGRAY 425)
(MAKEOUTLINE 417)
(MAKESAMPLEDBLACK 426)
(MAKESIMPLECO 114)
(MAKEPIXELARRAY 450)
(MAKEVEC 283)
(MAKEVECLU 282)
(MARK 186)
(MASKFILL 409)
(MASKPIXEL 452)
(MASKRECTANGLE 410)
(MASKSTROKE 24)
(MASKUNDERLINE 414)
(MOD 209)
(MODIFYFONT 148)
(MOVE 169)
(MOVETO 25)
(MUL 210)
(NEG 211)
(NOP 1)
(NOT 212)
(OR 213)
(POP 180)
(ROLL 184)
(ROTATE 163)
(SCALE 164)
(SCALE2 166)
(SETCORRECTMEASURE 154)
(SETCORRECTTOLERANCE 155)
(SETFONT 151)
(SETGRAY 424)
(SETXREL 12)
(SETXY 10)
(SETXYREL 11)
(SETYREL 13)
(SHOW 22)
(SHOWANDXREL 146)
(SPACE 16)
(STARTUNDERLINE 413)
(SUB 214)
(TRANS 170)
(TRANSLATE 162)
(TRUNC 215)
(TYPE 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 EXCH 185)
(RPAQQ FGET 20)
(RPAQQ FINDDECOMPRESSOR 149)
(RPAQQ FINDFONT 147)
(RPAQQ FLOOR 206)
(RPAQQ FSET 21)
(RPAQQ GE 207)
(RPAQQ GETCP 159)
(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 MAKESAMPLEDBLACK 426)
(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 MASKUNDERLINE 414)
(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 ROLL 184)
(RPAQQ ROTATE 163)
(RPAQQ SCALE 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 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 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)
(EXCH 185)
(FGET 20)
(FINDDECOMPRESSOR 149)
(FINDFONT 147)
(FLOOR 206)
(FSET 21)
(GE 207)
(GETCP 159)
(GT 208)
(IF 239)
(IFCOPY 240)
(IFELSE 241)
(IGET 18)
(ISET 19)
(LINETO 23)
(LINETOX 14)
(LINETOY 15)
(MAKEGRAY 425)
(MAKEOUTLINE 417)
(MAKESAMPLEDBLACK 426)
(MAKESIMPLECO 114)
(MAKEPIXELARRAY 450)
(MAKEVEC 283)
(MAKEVECLU 282)
(MARK 186)
(MASKFILL 409)
(MASKPIXEL 452)
(MASKRECTANGLE 410)
(MASKSTROKE 24)
(MASKUNDERLINE 414)
(MOD 209)
(MODIFYFONT 148)
(MOVE 169)
(MOVETO 25)
(MUL 210)
(NEG 211)
(NOP 1)
(NOT 212)
(OR 213)
(POP 180)
(ROLL 184)
(ROTATE 163)
(SCALE 164)
(SCALE2 166)
(SETCORRECTMEASURE 154)
(SETCORRECTTOLERANCE 155)
(SETFONT 151)
(SETGRAY 424)
(SETXREL 12)
(SETXY 10)
(SETXYREL 11)
(SETYREL 13)
(SHOW 22)
(SHOWANDXREL 146)
(SPACE 16)
(STARTUNDERLINE 413)
(SUB 214)
(TRANS 170)
(TRANSLATE 162)
(TRUNC 215)
(TYPE 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 ")))
(DECLARE: EVAL@COMPILE
(RPAQ BEGINPREAMBLE {)
(RPAQ ENDPREAMBLE })
(RPAQ BEGINPAGE {)
(RPAQ ENDPAGE })
(RPAQ ENCODINGSTRING "Interpress/Xerox/1.0 ")
(CONSTANTS (BEGINPREAMBLE {)
(ENDPREAMBLE })
(BEGINPAGE {)
(ENDPAGE })
(ENCODINGSTRING "Interpress/Xerox/1.0 "))
)
)
(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-Xerox))
(FRUTIGER (QUOTE MODERN))
(CENTURY (QUOTE CLASSIC))
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 NIL IPPREAMBLEFONTS
IPPAGEFONTS IPWIDTHSCACHE IPCOLOR IPLINEFEED IPPAGESTATE
IPOUTSTREAM IPSHOWSTREAM XIPPAGEREGION (IPWIDTH WORD)
(IPHEIGHT WORD)
(IPPAGENUM WORD)
(IPPREAMBLENEXTFRAMEVAR BYTE)
(IPNEXTFRAMEVAR BYTE)
(IPHEADINGOPVAR BYTE))
IPXPOS ← 0 IPYPOS ← 0 IPNEXTFRAMEVAR ← 0 (* We assume that the origin is translated to the
bottom-left of the page region)
[ACCESSFNS ((IPLEFT (PROGN 0))
(IPBOTTOM (PROGN 0))
(IPRIGHT (fetch (INTERPRESSDATA IPWIDTH) of DATUM))
(IPTOP (fetch (INTERPRESSDATA IPHEIGHT) of DATUM))
(IPPAGEREGION (fetch (INTERPRESSDATA XIPPAGEREGION) of DATUM)
(PROGN (replace (INTERPRESSDATA XIPPAGEREGION) of DATUM
with NEWVALUE)
(replace (INTERPRESSDATA IPWIDTH) of DATUM
with (fetch (REGION WIDTH) of NEWVALUE))
(replace (INTERPRESSDATA IPHEIGHT) of DATUM
with (fetch (REGION HEIGHT) of NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD BYTE
BYTE BYTE)))
)
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD BYTE
BYTE BYTE)))
(DEFINEQ
(INTERPRESSBITMAP
[LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
(* edited: " 1-AUG-83 22:50")
(OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
(PROG [[IPSTREAM (OPENIPSTREAM (OR OUTPUTFILE (QUOTE {CORE}IPBITMAP.SCRATCH]
[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 (IP.PRINTCENTERED TITLE IPSTREAM)
(SHOW.IP 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"))
[SETXY.IP IPSTREAM [\RPLUS2 (\RTIMES2 MICASPERINCH 3)
(\RTIMES2 W (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
(\RPLUS2 (\RTIMES2 MICASPERINCH 4.75)
(\RTIMES2 H (CONSTANT (\RTIMES2 MICASPERPOINT ONEHALF]
(SHOWBITMAP.IP IPSTREAM BITMAP REGION SCALEFACTOR ROTATION)
(RETURN (CLOSEF IPSTREAM])
(IP.PRIN3
[LAMBDA (X STREAM) (* jds "14-Mar-84 10:06")
(* Puts out the characters in X on the Interpress stream. Used in place of PRIN3, cause PRIN3 cause the OUTCHARFN
and therefore does a SHOW, which is not what we intend.)
(for C instring (MKSTRING X) do (for NSCHAR inside (INTERPRESS.CHARCODE C)
do (\BOUT STREAM NSCHAR])
(IP.PRINTCENTERED
[LAMBDA (STRING IPSTREAM) (* rmk: "18-AUG-83 18:12")
[SETXREL.IP IPSTREAM (IDIFFERENCE (TIMES 4 MICASPERINCH)
(STRINGWIDTH STRING (fetch IPFONT of (fetch IPDATA
of IPSTREAM]
(PRIN1 STRING IPSTREAM])
)
(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))
(CONVERSION (TEXT MAKEINTERPRESS TEDIT (LAMBDA (FILE PFILE)
(TEDIT.IP.HARDCOPY
FILE PFILE T])
(DEFINEQ
(INTERPRESSFONTPROFILE
[LAMBDA (CLASSES) (* rmk: "26-SEP-83 16:26")
(* Called via FONTSETUPFNS from FONTPROFILE, with CLASSES a list of (classname font# displayfont pressfont
interpressfont) This function sets up and caches the number to font mappings for interpreting Pspool-format files.
For backward compatibility, if the interpress element is not present, the press one is used instead.)
(FONTMAPARRAY [for C PTAIL in CLASSES when (SETQ PTAIL (CDDDR C))
collect (LIST (CADR C)
(CAR (OR (CDR PTAIL)
PTAIL]
(QUOTE INTERPRESS])
)
(ADDTOVAR FONTSETUPFNS (4 NILL INTERPRESSFONTPROFILE))
(DECLARE: DONTEVAL@LOAD DOCOPY
(DEFAULTFONT (QUOTE INTERPRESS)
(QUOTE (GACHA 8))
(QUOTE NEW))
(FONTPROFILE FONTPROFILE)
)
(RPAQQ DEFAULT.INTERPRESS.BITMAP.ROTATION 90)
(PUTPROPS INTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3849 9673 (NCHARS.IP 3859 . 4317) (INTERPRESS.CHARCODE 4319 . 5562) (\RTIMES2 5564 .
7127) (\RPLUS2 7129 . 8529) (RMINUS 8531 . 8807) (CREATERATIONAL 8809 . 9459) (RATIONALTOINTEGER 9461
. 9671)) (11654 16663 (APPENDBYTE.IP 11664 . 11799) (APPENDIDENTIFIER.IP 11801 . 12274) (APPENDINT.IP
12276 . 12503) (APPENDINTEGER.IP 12505 . 12882) (APPENDLARGEVECTOR.IP 12884 . 13631) (
APPENDLISPSTRING.IP 13633 . 14330) (APPENDNUMBER.IP 14332 . 14790) (APPENDOP.IP 14792 . 15197) (
APPENDRATIONAL.IP 15199 . 15539) (APPENDSEQUENCEDESCRIPTOR.IP 15541 . 16327) (BYTESININT.IP 16329 .
16494) (EXTRACTBYTE.IP 16496 . 16661)) (16695 25223 (BEGINMASTER.IP 16705 . 16854) (BEGINPAGE.IP 16856
. 17125) (BEGINPREAMBLE.IP 17127 . 17383) (CONCATT.IP 17385 . 17532) (CONCAT.IP 17534 . 17679) (
DRAWLINE.IP 17681 . 17908) (DRAWTRAJECTORY.IP 17910 . 18113) (ENDMASTER.IP 18115 . 18260) (ENDPAGE.IP
18262 . 18545) (ENDPREAMBLE.IP 18547 . 19231) (FGET.IP 19233 . 19416) (FILLTRAJECTORY.IP 19418 . 19694
) (FSET.IP 19696 . 19879) (GETFRAMEVAR.IP 19881 . 20198) (INITIALIZEMASTER.IP 20200 . 20360) (
LINETO.IP 20362 . 20581) (MOVETO.IP 20583 . 20802) (ROTATE.IP 20804 . 20986) (SCALE.IP 20988 . 21167)
(SCALE2.IP 21169 . 21387) (SETFONT.IP 21389 . 21860) (SETSPACE.IP 21862 . 22054) (SETXREL.IP 22056 .
22347) (SETXY.IP 22349 . 22722) (SETXYREL.IP 22724 . 23159) (SETYREL.IP 23161 . 23424) (SHOW.IP 23426
. 24007) (SHOWSTRING.IP 24009 . 24371) (TRAJECTORY.IP 24373 . 24728) (TRANSLATE.IP 24730 . 24955) (
TRANS.IP 24957 . 25221)) (25245 26323 (MASKSTROKE.IP 25255 . 25677) (STARTTRAJECTORY.IP 25679 . 26089)
(TRAJECTORYSEGMENT.IP 26091 . 26321)) (26350 50189 (CLOSEIPSTREAM 26360 . 26679) (DEFINEFONT.IP 26681
. 27636) (FONTNAME.IP 27638 . 28315) (HEADINGOP.IP 28317 . 29629) (INTERPRESS.OUTCHARFN 29631 . 30368
) (INTERPRESSFILEP 30370 . 31243) (INTERPRESS.BITMAPSCALE 31245 . 31639) (MAKEINTERPRESS 31641 . 36308
) (NEWLINE.IP 36310 . 37067) (NEWPAGE.IP 37069 . 40262) (NEWPAGE?.IP 40264 . 40662) (OPENIPSTREAM
40664 . 43050) (SETUPFONTS.IP 43052 . 44003) (SHOWBITMAP.IP 44005 . 47025) (\CREATEINTERPRESSFONT
47027 . 48029) (\DRAWLINE.IP 48031 . 48656) (\DSPFONT.IP 48658 . 49505) (\DSPXPOSITION.IP 49507 .
49846) (\DSPYPOSITION.IP 49848 . 50187)) (50588 51484 (\INTERPRESSINIT 50598 . 51482)) (51537 52062 (
SCALEREGION 51547 . 52060)) (64574 66956 (INTERPRESSBITMAP 64584 . 66194) (IP.PRIN3 66196 . 66640) (
IP.PRINTCENTERED 66642 . 66954)) (67463 68133 (INTERPRESSFONTPROFILE 67473 . 68131)))))
STOP