(FILECREATED "19-Jul-85 20:22:56" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;145 111906
changes to: (FNS SETCOLOR.IP SHOWSHADE.IP FILLTRAJECTORY.IP TRAJECTORY.IP APPENDIDENTIFIER.IP
FILLRECTANGLE.IP)
(VARS INTERPRESSCOMS)
previous date: "17-Jul-85 11:15:09" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;143)
(* Copyright (c) 1983, 1984, 1985 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]
(INITVARS (CHARACTERCODEVERSION (QUOTE XC1-1-1))
(INTERPRESSVERSION "2.1"))
[COMS (DECLARE: DONTCOPY (CONSTANTS * RATIONALS)
(* "MICASPERINCH is used by HARDCOPY")
(EXPORT (CONSTANTS (MICASPERINCH 2540)))
(CONSTANTS (\INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH]
(FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP
APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP)
(* "Operator interface")
(FNS BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CONCAT.IP CONCATT.IP ENDMASTER.IP
ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLRECTANGLE.IP FILLTRAJECTORY.IP FSET.IP
GETFRAMEVAR.IP INITIALIZEMASTER.IP ISET.IP LINETO.IP MASKSTROKE.IP MOVETO.IP ROTATE.IP
SCALE.IP SCALE2.IP SETCOLOR.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 SHOWSHADE.IP \BITBLT.IP \SCALEDBITBLT.IP
\BLTSHADE.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
\DSPCLIPPINGREGION.IP)
(FNS \CREATECHARSET.IP \CHANGECHARSET.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]
(DEFAULTLANDPAGEREGION (SCALEREGION
2540
(CREATEREGION .75 1.1
(FDIFFERENCE
10.5 .75)
(FDIFFERENCE
7.5 1.1]
(* "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))
(ALISTS (SYSTEMINITVARS INTERPRESSFONTDIRECTORIES))
[INITVARS (INTERPRESSFONTDIRECTORIES (QUOTE {ERIS}<LISP>FONTS>))
(INTERPRESSPRINTWHEELFAMILIES (QUOTE (BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD
SCIENTIFIC SPOKESMAN TITAN TREND
TRENDPS TROJAN VINTAGE)))
(INTERPRESSFAMILYALIASES (QUOTE (LOGO LOGOTYPES-XEROX]
(COMS (* "NS Character Encoding")
(FNS NSMAP \COERCEASCIITONSFONT \CREATEINTERPRESSFONT \SEARCHINTERPRESSFONTS)
(INITVARS (ASCIITONSTRANSLATIONS))
(* "Catch the GACHA10 and any BI coercions to MODERN")
(ADDVARS (ASCIITONSTRANSLATIONS (TIMESROMAN NIL CLASSIC)
(GACHA NIL TERMINAL)
(HELVETICA)
(CLASSIC)
(GACHA)
(TIMESROMAN)
(LOGO NIL LOGOTYPES)
(HIPPO HIPPOTONSARRAY CLASSIC)
(CYRILLIC CYRILLICTONSARRAY CLASSIC)
(SYMBOL \SYMBOLTONSARRAY MODERN)))
(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)))
)
)
(RPAQ? CHARACTERCODEVERSION (QUOTE XC1-1-1))
(RPAQ? INTERPRESSVERSION "2.1")
(DECLARE: DONTCOPY
(RPAQQ RATIONALS (METERSPERRAVENSPOT MICASPERSCREENPOINT SCREENPOINTSPERMICA
(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 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 (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)
)
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(RPAQQ MICASPERINCH 2540)
(CONSTANTS (MICASPERINCH 2540))
)
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
(RPAQ \INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH))
(CONSTANTS (\INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH)))
)
)
(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) (* lmm " 2-May-85 21:13") (for I from (SUB1 LENGTH) to 0 by -1 do (
APPENDBYTE.IP STREAM (LOADBYTE NUM (UNFOLD I BITSPERBYTE) BITSPERBYTE)))))
(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) (* lmm "14-Apr-85 19:20")
(COND
((FIXP R)
(APPENDINTEGER.IP STREAM R))
((type? RATIONAL R)
(APPENDRATIONAL.IP STREAM (fetch NUMERATOR of R)
(fetch DENOMINATOR of R)))
(T (APPENDNUMBER.IP STREAM (MAKERATIONAL R])
(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])
)
(* "Operator interface")
(DEFINEQ
(BEGINMASTER.IP
[LAMBDA (IPSTREAM) (* jds " 4-Dec-84 17:58")
(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) (* jds " 4-Dec-84 17:58")
(* Put out the token to end the master)
(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])
(FILLRECTANGLE.IP
[LAMBDA (IPSTREAM REGION) (* FS "19-Jul-85 12:13")
(* * Append rectangle description using current Interpress state)
(APPENDINTEGER.IP IPSTREAM (fetch LEFT of REGION))
(APPENDINTEGER.IP IPSTREAM (fetch BOTTOM of REGION))
(APPENDINTEGER.IP IPSTREAM (fetch WIDTH of REGION))
(APPENDINTEGER.IP IPSTREAM (fetch HEIGHT of REGION))
(APPENDOP.IP IPSTREAM MASKRECTANGLE])
(FILLTRAJECTORY.IP
[LAMBDA (IPSTREAM POINTS) (* FS "19-Jul-85 11:55")
(TRAJECTORY.IP IPSTREAM POINTS)
(APPENDINTEGER.IP IPSTREAM 1)
(APPENDOP.IP IPSTREAM MAKEOUTLINE)
(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) (* jds "10-Jan-85 15:48")
[for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE NOVERSIONENCODINGSTRING I)
(RETURN]
[for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE INTERPRESSVERSION I)
(RETURN]
(\BOUT IPSTREAM (CHARCODE SPACE])
(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])
(SETCOLOR.IP
[LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* FS "19-Jul-85 19:43")
(* * Sets the Image variable color to given texture)
(PROG ((SCRATCHBM (BITMAPCREATE 32 32))
BMBASE)
(SETQ BMBASE (fetch (BITMAP BITMAPBASE) of SCRATCHBM))
(BITBLT NIL 0 0 SCRATCHBM 0 0 32 32 (QUOTE TEXTURE)
(QUOTE REPLACE)
SHADE) (* Move the shade into the scratch bitmap, so we can
tell Interpress about it)
(* WE NEED A PIXEL ARRAY THAT'S 32 WIDE, TO MAKE IP
WORK)
(APPENDNUMBER.IP IPSTREAM 32) (* For the master, this is the number of pixels in the
slow direction)
(APPENDNUMBER.IP IPSTREAM BITSPERCELL) (* Number of pixels in the master's fast direction)
(APPENDINTEGER.IP IPSTREAM 1) (* Samples per pixel)
(APPENDINTEGER.IP IPSTREAM 1) (* Max sample value)
(APPENDINTEGER.IP IPSTREAM 1) (* "Interleaved" samples)
(SCALE.IP IPSTREAM 1) (* THE SHADE IS IN PRINTER POINTS PER PIXEL)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 (ITIMES BYTESPERCELL 32)
))
(APPENDINT.IP IPSTREAM 1 2)
(APPENDINT.IP IPSTREAM BITSPERCELL 2)
(* * Now put put the bitmap -- each line must be a 32-bit multiple long)
(\BOUTS IPSTREAM BMBASE 0 (ITIMES BYTESPERCELL 32))
(* PUT OUT THE BITS)
(APPENDOP.IP IPSTREAM MAKEPIXELARRAY) (* MAKE THE PIXEL ARRAY)
(SCALE.IP IPSTREAM SCALE)
(ROTATE.IP IPSTREAM ANGLE)
(CONCAT.IP IPSTREAM)
(APPENDINTEGER.IP IPSTREAM (SELECTQ OPERATION
(REPLACE (* The "white" bits are opaque)
0)
(PAINT (* The "white" bits are clear)
1)
1))
(APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK)
(ISET.IP IPSTREAM COLOR.IMVAR])
(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) (* jds " 6-May-85 15:10")
(* 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)
(COND
((NOT (IEQP (fetch NSCHARSET of IPDATA)
0)) (* If we're not in charset zero, change back to it.)
(\CHANGECHARSET.IP IPDATA 0)))
(freplace IPCORRECTSTARTX of IPDATA with (ffetch IPXPOS of IPDATA))
(* And notice out new real location for future
CORRECTs.)
])
(TRAJECTORY.IP
[LAMBDA (IPSTREAM POINTS) (* FS "19-Jul-85 11:53")
(MOVETO.IP IPSTREAM (fetch XCOORD of (CAR POINTS))
(fetch YCOORD of (CAR POINTS)))
(for P in (CDR POINTS) do (LINETO.IP IPSTREAM (fetch XCOORD of P)
(fetch YCOORD of P])
(TRANS.IP
[LAMBDA (IPSTREAM) (* rmk: "27-Mar-85 14:24")
(* This translates the origin to the current position.)
(APPENDOP.IP IPSTREAM TRANS.IPOP])
(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) (* jds "17-Jul-85 11:00")
(* Convert a Lisp font name to the proper NS font name)
(DECLARE (GLOBALVARS INTERPRESSPRINTWHEELFAMILIES INTERPRESSFAMILYALIASES))
(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)))
[AND (MEMB NAME INTERPRESSPRINTWHEELFAMILIES)
(SETQ NAME (PACK* NAME (QUOTE -PRINTWHEEL]
[COND
((MEMB NAME INTERPRESSFAMILYALIASES)
(SETQ NAME (LISTGET INTERPRESSFAMILYALIASES NAME]
[COND
(FACE (SETQ NAME (PACK (CONS NAME FACE]
(RETURN (LIST (QUOTE XEROX)
CHARACTERCODEVERSION 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: "11-Apr-85 17:23")
(PROG (NSCODE (IPDATA (ffetch IPDATA of IPSTREAM)))
[SETQ NSCODE (COND
((\FATCHARCODEP CHARCODE)
CHARCODE)
(T (\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]
(↑L (NEWPAGE.IP IPSTREAM))
(PROGN [COND
((NEQ (\CHARSET NSCODE)
(ffetch NSCHARSET of IPDATA))
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
NSCHARSETSHIFT) (* Switch character set)
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
(\CHARSET NSCODE))
(\CHANGECHARSET.IP IPDATA (\CHARSET NSCODE]
[add (ffetch IPXPOS of IPDATA)
(COND
((EQ NSCODE (CHARCODE SPACE))
(ffetch IPSPACEWIDTH of IPDATA))
(T (\FGETWIDTH (ffetch IPWIDTHSCACHE of IPDATA)
(\CHAR8CODE NSCODE]
(* Assume the widths for the untranslated code
correspond to the translated character)
(\BOUT (ffetch IPSHOWSTREAM of IPDATA)
(\CHAR8CODE NSCODE])
(INTERPRESSFILEP
[LAMBDA (FILE NOOPEN) (* jds "18-Feb-85 09:41")
(* Returns fullname of FILE if it looks like an
Interpress file)
(OR (EQ (GETFILEINFO FILE (QUOTE FILETYPE))
FILETYPE.INTERPRESS)
(RESETLST (PROG (STRM)
[COND
((SETQ STRM (\GETSTREAM FILE (QUOTE INPUT)
T))
(OR (RANDACCESSP STRM)
(RETURN))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
STRM
(GETFILEPTR STRM)))
(SETFILEPTR STRM 0))
(NOOPEN (RETURN))
(T (RESETSAVE (SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(RETURN (for I from 1 to (CONSTANT (NCHARS 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 OPTIONS) (* jds " 9-May-85 16:28")
(TEXTTOIMAGEFILE FILE IPFILE (QUOTE INTERPRESS)
FONTS HEADING TABS OPTIONS])
(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) (* jds " 9-May-85 14:10")
(PROG (CFONT HFONT ROTATION XOFFSET YOFFSET (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
([NOT (ZEROP (SETQ ROTATION (fetch IPROTATION of IPDATA]
(* Take care of any rotation)
(ROTATE.IP IPSTREAM ROTATION)
(CONCATT.IP IPSTREAM)))
(COND
([OR [NOT (ZEROP (SETQ XOFFSET (fetch IPXOFFSET of IPDATA]
(NOT (ZEROP (SETQ YOFFSET (fetch IPYOFFSET of IPDATA]
(* Take care of any translations)
(TRANSLATE.IP IPSTREAM XOFFSET YOFFSET)
(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)
(COND
((NOT (EQP 1 (ffetch IPSPACEFACTOR of IPDATA)))
(* 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 OPTIONS) (* jds " 9-May-85 14:01")
(* Opens an interpress stream, to which user can do OUTCHAR to. The FONTS option can be a list of fonts to be set up
in the preamble. Headings will be printed in the first font in that list. If that list is NIL, then the stream is
initialized with the INTERPRESS DEFAULTFONT)
(DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS \IPLANDIMAGEOPS \NOIMAGEOPS))
(PROG [OPT IPDATA (IPSTREAM (OPENSTREAM IPFILE (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(QUOTE ((TYPE INTERPRESS]
[SETQ IPDATA (create INTERPRESSDATA
IPPAGEREGION ←(COND
([type? REGION (SETQ OPT (LISTGET OPTIONS (QUOTE REGION]
OPT)
((LISTGET OPTIONS (QUOTE LANDSCAPE))
(* Landscape printing: Set up things sideways.)
DEFAULTLANDPAGEREGION)
(T 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))
)
IPDOCNAME ←(LISTGET OPTIONS (QUOTE DOCUMENT.NAME]
(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)
(COND
((LISTGET OPTIONS (QUOTE LANDSCAPE)) (* For landscape printing, set up the default rotation
and Y translate)
(replace (INTERPRESSDATA IPROTATION) of IPDATA with 90)
(replace (INTERPRESSDATA IPYOFFSET) of IPDATA with -21590)))
(INITIALIZEMASTER.IP IPSTREAM)
(BEGINMASTER.IP IPSTREAM)
(BEGINPREAMBLE.IP IPSTREAM)
(COND
((SETQ OPT (LISTGET OPTIONS (QUOTE HEADING)))
(replace IPHEADING of IPDATA with OPT)
(SELECTQ ENCODING
(FULLIP-82 (HEADINGOP.IP IPSTREAM OPT))
(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 (LISTGET OPTIONS (QUOTE FONTS)))
(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) (* jds "10-Jun-85 15:58")
(* 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 (* Clip the incoming bitmap to the specified region.)
(COND
([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 (* The clipping region doesn't overlap this bitmap.
Punt.)
(RETURN]
(T (SETQ XPIXELS (fetch BITMAPWIDTH of BITMAP))
(SETQ YPIXELS (fetch BITMAPHEIGHT of BITMAP]
(SETQ XBYTES (CEIL (FOLDHI XPIXELS BITSPERBYTE)
BYTESPERCELL)) (* 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"))
((ZEROP XBYTES) (* Don't want to do anything if the bitmap is zero wide
or high.)
(RETURN))
((ZEROP YPIXELS) (* Don't want to do anything if the bitmap is zero wide
or high.)
(RETURN)))
(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 "18-Feb-85 09:39")
(* 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.)
(* By the time we get here, XBYTES should have been raised to the next multiple of 32-bits-worth, since that's the
required width of packed pixel vectors.)
(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 (CEIL XPIXELS BITSPERCELL))
(* 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 (CEIL XPIXELS BITSPERCELL)
2)
(* * Now put put the bitmap -- each line must be a 32-bit multiple long)
(for Y (XWORDS ←(FOLDHI XBYTES BYTESPERWORD)) from 1 to YPIXELS
do (BITBLT BITMAP (OR LEFT 0)
(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
(CEIL XBYTES BYTESPERCELL)))
(APPENDOP.IP IPSTREAM MAKEPIXELARRAY)
(APPENDOP.IP IPSTREAM MASKPIXEL)
(APPENDOP.IP IPSTREAM }])
(SHOWSHADE.IP
[LAMBDA (IPSTREAM SHADE REGION OPERATION) (* FS "19-Jul-85 20:10")
(* 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 {)
(SETCOLOR.IP IPSTREAM SHADE OPERATION 1 0)
(FILLRECTANGLE.IP IPSTREAM REGION)
(APPENDOP.IP IPSTREAM }])
(\BITBLT.IP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM) (* hdj " 5-Dec-84 18:40")
(LET* ((OLDX (\DSPXPOSITION.IP DESTINATION))
(OLDY (\DSPYPOSITION.IP DESTINATION))
(DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY)))
(\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
(SHOWBITMAP.IP DESTINATION SOURCEBITMAP (COND
(CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION (CREATEREGION
CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM
WIDTH HEIGHT)))
(T (CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT)))
1)
(\MOVETO.IP DESTINATION OLDX OLDY))
T])
(\SCALEDBITBLT.IP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM SCALE) (* hdj "14-Feb-85 14:33")
(LET* ((OLDX (\DSPXPOSITION.IP DESTINATION))
(OLDY (\DSPYPOSITION.IP DESTINATION))
(DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY)))
(\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
(SHOWBITMAP.IP DESTINATION SOURCEBITMAP (COND
(CLIPPINGREGION (INTERSECTREGIONS CLIPPINGREGION (CREATEREGION
CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM
WIDTH HEIGHT)))
(T (CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT)))
SCALE)
(\MOVETO.IP DESTINATION OLDX OLDY))
T])
(\BLTSHADE.IP
[LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
(* rmk: "24-Apr-85 11:31")
(LET* ((REGION (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT))
(DESTREGION (if CLIPPINGREGION
then (INTERSECTREGIONS REGION CLIPPINGREGION)
else REGION)))
(* * (SHOWSHADE.IP STREAM TEXTURE DESTREGION OPERATION))
(* until 8044s can print scaled textures without
crashing)
(\BLTSHADE.GENERICPRINTER TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT
OPERATION CLIPPINGREGION \INTERPRESSSCALE])
(\CHARWIDTH.IP
[LAMBDA (STREAM CHARCODE) (* rmk: "12-Apr-85 09:42")
(* Gets the width of CHARCODE in an Interpress STREAM,
observing spacefactor)
(COND
((EQ CHARCODE (CHARCODE SPACE))
(ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM)))
(T (\FGETCHARWIDTH (ffetch IPFONT of (ffetch IMAGEDATA of STREAM))
CHARCODE])
(\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) (* hdj "13-Mar-85 18:08")
(* 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 (POLYEVAL TT XPOLY 3)) (* XT ← X (t) --Evaluate the next point)
(SETQ YT (POLYEVAL TT YPOLY 3)) (* YT ← Y (t))
(COND
[(NOT (IEQP KNOT# (SUB1 #KNOTS))) (* This isn't the last knot.
Check to see if the next knot in line is a duplicated
knot.)
(SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#))
(ELT X (IPLUS KNOT# 2)))
(EQP (ELT Y (ADD1 KNOT#))
(ELT Y (IPLUS KNOT# 2]
(T (SETQ DUPLICATEKNOT NIL)))
[until (GEQ TT 1.0)
do (SETQ X'T (POLYEVAL TT X'POLY 2)) (* X'T ← X' (t))
(SETQ Y'T (POLYEVAL TT Y'POLY 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 (POLYEVAL NEWT XPOLY 3))
(* New XT ← X (new t))
(SETQ NEWYT (POLYEVAL NEWT YPOLY 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))
(* Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try
to keep the line going from where it got to in passing the last knot.)
(COND
(DUPLICATEKNOT
(* This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems
trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are
discontinuous there.)
(add KNOT# 1]
(\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: "27-Nov-84 18:32")
(* 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))
(ffetch FONTAVGCHARWIDTH
of (ffetch IPFONT of IPDATA]
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) (* hdj "14-Mar-85 14:38")
(* 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 MICASPERPOINT]
(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: "12-Apr-85 09:39")
(* Returns the width of STRING in the interpress
STREAM, observing spacefactor)
(\STRINGWIDTH.GENERIC STRING (ffetch IPFONT of (ffetch IMAGEDATA of STREAM))
RDTBL
(ffetch IPSPACEWIDTH of (ffetch IMAGEDATA of STREAM])
(\DSPCLIPPINGREGION.IP
[LAMBDA (STREAM REGION) (* hdj "21-Feb-85 11:14")
(LET ((IPDATA (fetch (STREAM IMAGEDATA) of STREAM)))
(PROG1 (fetch (INTERPRESSDATA IPPAGEREGION) of IPDATA)
(AND REGION (UNINTERRUPTABLY
(replace (INTERPRESSDATA IPPAGEREGION) of IPDATA with REGION))])
)
(DEFINEQ
(\CREATECHARSET.IP
[LAMBDA (CHARSET FONT) (* jds "11-Apr-85 12:33")
(* Creates and returns the CHARSETINFO for charset
CHARSET in font FONT, installing it in fonts
FONTCHARSETVECTOR)
(AND (IGREATERP CHARSET \MAXCHARSET)
(\ILLEGAL.ARG CHARSET))
(PROG (NEWFONT)
[COND
((EQ CHARSET 0) (* If charset is to be 0, we've filled in the fields in
FONT already when it was created.)
(SETQ NEWFONT FONT))
(T (* For other charsets, create a font descriptor of info
for that charset, and use it to fill things in.)
(SETQ NEWFONT (APPLY (FUNCTION \CREATESTARFONT)
(APPEND (FONTPROP FONT (QUOTE DEVICESPEC))
(LIST CHARSET]
(RETURN (\RPLPTR (ffetch FONTCHARSETVECTOR of FONT)
CHARSET
(create CHARSETINFO
WIDTHS ←(ffetch (ARRAYP BASE) of (ffetch \SFWidths of NEWFONT))
OFFSETS ←(ffetch (ARRAYP BASE) of (ffetch \SFOffsets of NEWFONT))
IMAGEWIDTHS ←(ffetch (ARRAYP BASE) of (ffetch \SFWidths
of NEWFONT))
YWIDTHS ←(OR (FIXP (ffetch \SFWidthsY of NEWFONT))
(ffetch (ARRAYP BASE) of (ffetch \SFWidthsY
of NEWFONT)))
CHARSETASCENT ←(ffetch \SFAscent of NEWFONT)
CHARSETDESCENT ←(ffetch \SFDescent of NEWFONT])
(\CHANGECHARSET.IP
[LAMBDA (IPDATA CHARSET) (* jds " 6-May-85 15:09")
(* Called when the character set information cached in
a display stream doesn't correspond to CHARSET)
(PROG [(CSINFO (\GETCHARSETINFO CHARSET (ffetch IPFONT of IPDATA]
(UNINTERRUPTABLY
(freplace IPWIDTHSCACHE of IPDATA with (ffetch (CHARSETINFO WIDTHS) of CSINFO))
(freplace NSCHARSET of IPDATA with CHARSET))])
)
(DEFINEQ
(\INTERPRESSINIT
[LAMBDA NIL (* hdj "11-Mar-85 18:31")
(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 \BLTSHADE.IP)
IMBITBLT ←(FUNCTION \BITBLT.IP)
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)
IMSCALEDBITBLT ←(FUNCTION \SCALEDBITBLT.IP)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.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)
NIL])
)
(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))))
(RPAQ? DEFAULTLANDPAGEREGION (SCALEREGION 2540 (CREATEREGION .75 1.1 (FDIFFERENCE 10.5 .75)
(FDIFFERENCE 7.5 1.1))))
)
(* "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.IPOP 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.IPOP 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.IPOP 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.IPOP 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.IPOP 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.IPOP 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)))
(FILETYPE.INTERPRESS 4361)))
(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)))
(RPAQQ FILETYPE.INTERPRESS 4361)
(CONSTANTS (BEGINPREAMBLE {)
(ENDPREAMBLE })
(BEGINPAGE {)
(ENDPAGE })
(ENCODINGSTRING "Interpress/Xerox/1.0 ")
(NOVERSIONENCODINGSTRING "Interpress/Xerox/")
(MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))
(FILETYPE.INTERPRESS 4361))
)
)
(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 IPDOCNAME (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)
(IPROTATION WORD) (* Default rotation in which this document is to be
printed: Set up witn ROTATE and CONCATT at the start of
each new page.)
(IPXOFFSET POINTER) (* Default X offset, akin to the rotation.
Used to do landscape printing)
(IPYOFFSET POINTER) (* Default Y offset.)
)
IPXPOS ← 0 IPYPOS ← 0 IPNEXTFRAMEVAR ← 0 IPSPACEFACTOR ← 1 IPROTATION ← 0 IPXOFFSET ← 0
IPYOFFSET ← 0 [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 WORD POINTER
POINTER))
(QUOTE ((INTERPRESSDATA 0 POINTER)
(INTERPRESSDATA 2 POINTER)
(INTERPRESSDATA 4 POINTER)
(INTERPRESSDATA 6 POINTER)
(INTERPRESSDATA 8 POINTER)
(INTERPRESSDATA 10 POINTER)
(INTERPRESSDATA 12 POINTER)
(INTERPRESSDATA 14 POINTER)
(INTERPRESSDATA 16 POINTER)
(INTERPRESSDATA 18 POINTER)
(INTERPRESSDATA 20 POINTER)
(INTERPRESSDATA 22 POINTER)
(INTERPRESSDATA 24 POINTER)
(INTERPRESSDATA 26 POINTER)
(INTERPRESSDATA 28 (BITS . 15))
(INTERPRESSDATA 29 (BITS . 15))
(INTERPRESSDATA 30 (BITS . 15))
(INTERPRESSDATA 31 (BITS . 15))
(INTERPRESSDATA 32 (BITS . 15))
(INTERPRESSDATA 26 (BITS . 7))
(INTERPRESSDATA 24 (BITS . 7))
(INTERPRESSDATA 22 (BITS . 7))
(INTERPRESSDATA 20 (BITS . 7))
(INTERPRESSDATA 34 POINTER)
(INTERPRESSDATA 36 POINTER)
(INTERPRESSDATA 38 POINTER)
(INTERPRESSDATA 40 POINTER)
(INTERPRESSDATA 33 (BITS . 15))
(INTERPRESSDATA 42 POINTER)
(INTERPRESSDATA 44 POINTER)))
(QUOTE 46))
)
(/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 WORD POINTER
POINTER))
(QUOTE ((INTERPRESSDATA 0 POINTER)
(INTERPRESSDATA 2 POINTER)
(INTERPRESSDATA 4 POINTER)
(INTERPRESSDATA 6 POINTER)
(INTERPRESSDATA 8 POINTER)
(INTERPRESSDATA 10 POINTER)
(INTERPRESSDATA 12 POINTER)
(INTERPRESSDATA 14 POINTER)
(INTERPRESSDATA 16 POINTER)
(INTERPRESSDATA 18 POINTER)
(INTERPRESSDATA 20 POINTER)
(INTERPRESSDATA 22 POINTER)
(INTERPRESSDATA 24 POINTER)
(INTERPRESSDATA 26 POINTER)
(INTERPRESSDATA 28 (BITS . 15))
(INTERPRESSDATA 29 (BITS . 15))
(INTERPRESSDATA 30 (BITS . 15))
(INTERPRESSDATA 31 (BITS . 15))
(INTERPRESSDATA 32 (BITS . 15))
(INTERPRESSDATA 26 (BITS . 7))
(INTERPRESSDATA 24 (BITS . 7))
(INTERPRESSDATA 22 (BITS . 7))
(INTERPRESSDATA 20 (BITS . 7))
(INTERPRESSDATA 34 POINTER)
(INTERPRESSDATA 36 POINTER)
(INTERPRESSDATA 38 POINTER)
(INTERPRESSDATA 40 POINTER)
(INTERPRESSDATA 33 (BITS . 15))
(INTERPRESSDATA 42 POINTER)
(INTERPRESSDATA 44 POINTER)))
(QUOTE 46))
(DEFINEQ
(INTERPRESSBITMAP
[LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE)
(* lmm "14-Apr-85 19:48")
(* Print a bitmap (usually from the screen) into an IP
file)
(OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
(PROG [(IPSTREAM (OPENIMAGESTREAM (OR OUTPUTFILE (QUOTE {SCRATCH}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)
550Q))
(0 (SETQ W (\RTIMES2 -1 W))
(SETQ H (\RTIMES2 -1 H)))
[416Q (SETQ W (PROG1 H (SETQ H (\RTIMES2 -1 W]
(264Q)
[132Q (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 OPENIPSTREAM)
(FONTCREATE \CREATEINTERPRESSFONT)
(FONTSAVAILABLE \SEARCHINTERPRESSFONTS)
(CREATECHARSET \CREATECHARSET.IP)))
(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)
(ADDTOVAR SYSTEMINITVARS (INTERPRESSFONTDIRECTORIES {DSK}))
(RPAQ? INTERPRESSFONTDIRECTORIES (QUOTE {ERIS}<LISP>FONTS>))
(RPAQ? INTERPRESSPRINTWHEELFAMILIES (QUOTE (BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD SCIENTIFIC
SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)))
(RPAQ? INTERPRESSFAMILYALIASES (QUOTE (LOGO LOGOTYPES-XEROX)))
(* "NS Character Encoding")
(DEFINEQ
(NSMAP
[LAMBDA (ZERODEFAULT MAP) (* rmk: " 3-Dec-84 11:15")
(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)))
(LOGOR (LLSH (CADR X)
8)
(CADDR X]
(RETURN TABLE])
(\COERCEASCIITONSFONT
[LAMBDA (ASCIITONSMAPARRAY ASCIITONSFIXARRAY ASCIIFAMILY NSFAMILY SIZE FONTFACE ROTATION DEVICE)
(* rmk: " 3-Dec-84 11:11")
(* 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 (\CHARSET 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 (\CHARSET 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 (\CHAR8CODE 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) (* mjs "14-Feb-85 19:59")
(* 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 \ASCIITONS \ASCIITOSTAR ASCIITONSTRANSLATIONS))
(if (\COERCEASCIITONSFONT \ASCIITONS \ASCIITOSTAR FAMILY FAMILY SIZE FONTFACE ROTATION DEVICE)
elseif (for TRANSL in ASCIITONSTRANSLATIONS bind NEWFONT
when (AND (EQ FAMILY (CAR TRANSL))
(SETQ NEWFONT (\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)))
do (RETURN NEWFONT])
(\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 (TIMESROMAN NIL CLASSIC)
(GACHA NIL TERMINAL)
(HELVETICA)
(CLASSIC)
(GACHA)
(TIMESROMAN)
(LOGO NIL LOGOTYPES)
(HIPPO HIPPOTONSARRAY CLASSIC)
(CYRILLIC CYRILLICTONSARRAY CLASSIC)
(SYMBOL \SYMBOLTONSARRAY MODERN))
(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 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7356 11582 (APPENDBYTE.IP 7366 . 7505) (APPENDIDENTIFIER.IP 7507 . 7991) (APPENDINT.IP
7993 . 8181) (APPENDINTEGER.IP 8183 . 8584) (APPENDLARGEVECTOR.IP 8586 . 9381) (APPENDNUMBER.IP 9383
. 9754) (APPENDOP.IP 9756 . 10197) (APPENDRATIONAL.IP 10199 . 10548) (APPENDSEQUENCEDESCRIPTOR.IP
10550 . 11404) (BYTESININT.IP 11406 . 11580)) (11616 27638 (BEGINMASTER.IP 11626 . 11780) (
BEGINPAGE.IP 11782 . 12055) (BEGINPREAMBLE.IP 12057 . 12317) (CONCAT.IP 12319 . 12464) (CONCATT.IP
12466 . 12613) (ENDMASTER.IP 12615 . 12870) (ENDPAGE.IP 12872 . 13155) (ENDPREAMBLE.IP 13157 . 13849)
(FGET.IP 13851 . 14034) (FILLRECTANGLE.IP 14036 . 14549) (FILLTRAJECTORY.IP 14551 . 14825) (FSET.IP
14827 . 15010) (GETFRAMEVAR.IP 15012 . 15341) (INITIALIZEMASTER.IP 15343 . 15746) (ISET.IP 15748 .
16049) (LINETO.IP 16051 . 16404) (MASKSTROKE.IP 16406 . 16559) (MOVETO.IP 16561 . 16914) (ROTATE.IP
16916 . 17098) (SCALE.IP 17100 . 17283) (SCALE2.IP 17285 . 17503) (SETCOLOR.IP 17505 . 19884) (
SETFONT.IP 19886 . 20381) (SETSPACE.IP 20383 . 20575) (SETXREL.IP 20577 . 21121) (SETX.IP 21123 .
22066) (SETXY.IP 22068 . 22934) (SETXYREL.IP 22936 . 23743) (SETY.IP 23745 . 24539) (SETYREL.IP 24541
. 24804) (SHOW.IP 24806 . 26772) (TRAJECTORY.IP 26774 . 27138) (TRANS.IP 27140 . 27409) (TRANSLATE.IP
27411 . 27636)) (27665 75087 (DEFINEFONT.IP 27675 . 28478) (FONTNAME.IP 28480 . 29605) (HEADINGOP.IP
29607 . 30912) (INTERPRESS.BITMAPSCALE 30914 . 31352) (INTERPRESS.OUTCHARFN 31354 . 32920) (
INTERPRESSFILEP 32922 . 34091) (MAKEINTERPRESS 34093 . 34299) (NEWLINE.IP 34301 . 34981) (NEWPAGE.IP
34983 . 39173) (NEWPAGE?.IP 39175 . 39581) (OPENIPSTREAM 39583 . 42907) (SETUPFONTS.IP 42909 . 43864)
(SHOWBITMAP.IP 43866 . 47101) (SHOWBITMAP1.IP 47103 . 51814) (SHOWSHADE.IP 51816 . 52376) (\BITBLT.IP
52378 . 53309) (\SCALEDBITBLT.IP 53311 . 54252) (\BLTSHADE.IP 54254 . 55040) (\CHARWIDTH.IP 55042 .
55548) (\CLOSEIPSTREAM 55550 . 55874) (\DRAWCIRCLE.IP 55876 . 56845) (\DRAWCURVE.IP 56847 . 58784) (
\IPCURVE2 58786 . 64853) (\DRAWELLIPSE.IP 64855 . 65980) (\DRAWLINE.IP 65982 . 66605) (
\DSPBOTTOMMARGIN.IP 66607 . 66923) (\DSPFONT.IP 66925 . 69287) (\DSPLEFTMARGIN.IP 69289 . 69639) (
\DSPLINEFEED.IP 69641 . 70191) (\DSPRIGHTMARGIN.IP 70193 . 70546) (\DSPSPACEFACTOR.IP 70548 . 71342) (
\DSPTOPMARGIN.IP 71344 . 71651) (\DSPXPOSITION.IP 71653 . 72219) (\DSPYPOSITION.IP 72221 . 72501) (
\FIXLINELENGTH.IP 72503 . 73262) (\MOVETO.IP 73264 . 73431) (\SETBRUSH.IP 73433 . 74220) (
\STRINGWIDTH.IP 74222 . 74683) (\DSPCLIPPINGREGION.IP 74685 . 75085)) (75088 77387 (\CREATECHARSET.IP
75098 . 76796) (\CHANGECHARSET.IP 76798 . 77385)) (77388 80459 (\INTERPRESSINIT 77398 . 80457)) (80460
81017 (SCALEREGION 80470 . 81015)) (98953 101106 (INTERPRESSBITMAP 98963 . 101104)) (102472 108583 (
NSMAP 102482 . 102997) (\COERCEASCIITONSFONT 102999 . 106024) (\CREATEINTERPRESSFONT 106026 . 107184)
(\SEARCHINTERPRESSFONTS 107186 . 108581)))))
STOP