(FILECREATED " 6-Jul-86 22:35:36" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;200 219421
changes to: (VARS INTERPRESSCOMS)
(FNS APPENDNUMBER.IP)
previous date: "27-Jun-86 11:49:29" {ERIS}<LISPCORE>SOURCES>INTERPRESS.;199)
(* Copyright (c) 1983, 1984, 1985, 1986 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")
(PRINTSERVICE 10.0))
[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
TESTCOLOR)
(* "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 INITIALIZECOLOR.IP ISET.IP GETCP.IP LINETO.IP
MASKSTROKE.IP MOVETO.IP ROTATE.IP SCALE.IP SCALE2.IP SETCOLOR.IP SETRGB.IP SETCOLORLV.IP
SETCOLOR16.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 \BITMAPSIZE.IP SHOWBITMAP1.IP SHOWSHADE.IP \BITBLT.IP
\SCALEDBITBLT.IP \BLTSHADE.IP \CHARWIDTH.IP \CLOSEIPSTREAM \DRAWCIRCLE.IP \DRAWARC.IP
\DRAWCURVE.IP \DSPCOLOR.IP ENSURE.RGB \IPCURVE2 \DRAWELLIPSE.IP \DRAWLINE.IP
\DSPBOTTOMMARGIN.IP \DSPFONT.IP \DSPLEFTMARGIN.IP \DSPLINEFEED.IP \DSPRIGHTMARGIN.IP
\DSPSPACEFACTOR.IP \DSPTOPMARGIN.IP \DSPXPOSITION.IP \DSPROTATE.IP \PUSHSTATE.IP
\POPSTATE.IP \DEFAULTSTATE.IP \DSPTRANSLATE.IP \DSPSCALE2.IP \DSPYPOSITION.IP
\FILLPOLYGON.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP \STRINGWIDTH.IP
\DSPCLIPPINGREGION.IP \DSPOPERATION.IP)
(COMS (* image state)
(FNS IP-TOS POP-IP-STACK PUSH-IP-STACK)
(RECORDS IPSTATE))
(FNS \CREATECHARSET.IP \CHANGECHARSET.IP)
(FNS \INTERPRESSINIT)
(FNS SCALEREGION)
[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS IPPAGEREGION.ROT180 IPPAGEREGION.ROT270
[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))
(HOSTNAMEP NSPRINTER.HOSTNAMEP)
(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)
(TEDIT.FORMAT.HARDCOPY
[OPENTEXTSTREAM (SETQ
FILE
(OPENSTREAM
FILE
(QUOTE INPUT]
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)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (noInfoCode 32768)))
(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)))
(DECLARE: EVAL@COMPILE DONTCOPY (P (LOADDEF (QUOTE SYSTEMBRUSH)
(QUOTE RESOURCES)
(QUOTE IMAGEIO))
(LOADDEF (QUOTE BRUSH)
(QUOTE RECORDS)
(QUOTE IMAGEIO])
(* "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")
(RPAQ? PRINTSERVICE 10.0)
(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) (* gbn " 6-Jul-86 22:28")
(COND
((FIXP R)
(APPENDINTEGER.IP STREAM R))
((type? RATIONAL R)
(APPENDRATIONAL.IP STREAM (fetch (RATIONAL NUMERATOR) of R)
(fetch (RATIONAL 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])
(TESTCOLOR
[LAMBDA NIL (* edited:
"31-Mar-86 21:24")
[SETQ FOO (OPENIPSTREAM (QUOTE {ERIS}<NUYENS>IP>COLORTEST.COLORIP)
(QUOTE (COLOR T]
(DSPCOLOR (QUOTE RED)
FOO)
(PRINTOUT FOO "THIS SHOULD BE RED (AND READ) " T)
(DRAWCIRCLE 7000 1000 700 (QUOTE (ROUND 100 (0 255 255)))
NIL FOO)
(PRINTOUT FOO "AND MORE RED" T)
(CLOSEF FOO])
)
(* "Operator interface")
(DEFINEQ
(BEGINMASTER.IP
[LAMBDA (IPSTREAM) (* jds
" 4-Dec-84 17:58")
(APPENDOP.IP IPSTREAM BEGINMASTER])
(BEGINPAGE.IP
[LAMBDA (IPSTREAM) (* FS
" 4-Mar-86 14:23")
(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) (* FS
" 4-Mar-86 14:23")
(SHOW.IP IPSTREAM)
(APPENDOP.IP IPSTREAM ENDPAGE)
(replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with NIL])
(ENDPREAMBLE.IP
[LAMBDA (IPSTREAM) (* FS
" 4-Mar-86 14:24")
(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))
(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 RegionOrLeft Bottom Width Height) (* FS
"25-Feb-86 15:40")
(* * Append rectangle description using current Interpress state)
(if (REGIONP RegionOrLeft)
then (SETQ Bottom (fetch BOTTOM of RegionOrLeft))
(SETQ Width (fetch WIDTH of RegionOrLeft))
(SETQ Height (fetch HEIGHT of RegionOrLeft))
(SETQ RegionOrLeft (fetch LEFT of RegionOrLeft)))
(APPENDINTEGER.IP IPSTREAM RegionOrLeft)
(APPENDINTEGER.IP IPSTREAM Bottom)
(APPENDINTEGER.IP IPSTREAM Width)
(APPENDINTEGER.IP IPSTREAM Height)
(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])
(INITIALIZECOLOR.IP
[LAMBDA (IPSTREAM) (* hdj
"23-Jan-86 19:20")
(LET ((COLORMODELOP.FVAR (GETFRAMEVAR.IP IPSTREAM))
(IPDATA (fetch (STREAM IMAGEDATA) of IPSTREAM)))
(* * create data for the color model operator -
colors will range from 0 to 255)
(APPENDINTEGER.IP IPSTREAM 255)
(APPENDINTEGER.IP IPSTREAM 1)
(APPENDOP.IP IPSTREAM MAKEVEC)
(* * name of color model)
(APPENDIDENTIFIER.IP IPSTREAM "Xerox")
(APPENDIDENTIFIER.IP IPSTREAM "Research")
(APPENDIDENTIFIER.IP IPSTREAM "RGBLinear")
(APPENDINTEGER.IP IPSTREAM 3)
(APPENDOP.IP IPSTREAM MAKEVEC)
(* * create the color model)
(APPENDOP.IP IPSTREAM FINDCOLORMODELOPERATOR)
(APPENDOP.IP IPSTREAM DO)
(* * store it in the preamble's frame)
(FSET.IP IPSTREAM COLORMODELOP.FVAR)
(* * remember which fvar it is in)
(replace (INTERPRESSDATA IPCOLORMODEL) of IPDATA with COLORMODELOP.FVAR])
(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])
(GETCP.IP
[LAMBDA (IPSTREAM) (* hdj
"27-Nov-85 17:30")
(* * Pushes current X & Y onto stack)
(APPENDOP.IP IPSTREAM GETCP])
(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) (* hdj
"18-Oct-85 15:58")
(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:
"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) (* edited:
"31-Mar-86 23:01")
(* * Patch around Print Service 8.0 bugs)
(if (AND (STREAMPROP IPSTREAM (QUOTE COLOR))
(LISTP SHADE)
(RGBP (CADR SHADE)))
then (* the dosavesimplebody
is in POLYSHADE.IP.
For now, insist that the
CDR be RGB if color is
desired)
(SETRGB.IP IPSTREAM (CAADR SHADE)
(CADR (CADR SHADE))
(CADDR (CADR SHADE)))
(SETQ SHADE (CAR SHADE)))
(if (EQUAL PRINTSERVICE 8.0)
then (SETCOLOR16.IP IPSTREAM SHADE OPERATION SCALE ANGLE)
else (SETCOLORLV.IP IPSTREAM SHADE OPERATION SCALE ANGLE])
(SETRGB.IP
[LAMBDA (IPSTREAM RED GREEN BLUE) (* hdj
" 3-Feb-86 12:00")
(LET [(COLORMODEL.FVAR (fetch IPCOLORMODEL of (fetch IMAGEDATA of IPSTREAM]
(* hdj
"23-Jan-86 19:21")
(* * force out any stored chars so they get colored)
(SHOW.IP IPSTREAM)
(* * push RED GREEN BLUE vector)
(APPENDINTEGER.IP IPSTREAM RED)
(APPENDINTEGER.IP IPSTREAM GREEN)
(APPENDINTEGER.IP IPSTREAM BLUE)
(APPENDINTEGER.IP IPSTREAM 3)
(APPENDOP.IP IPSTREAM MAKEVEC)
(* * apply the color operator)
(FGET.IP IPSTREAM COLORMODEL.FVAR)
(APPENDOP.IP IPSTREAM DO)
(* * set current color to result)
(ISET.IP IPSTREAM COLOR.IMVAR))
NIL])
(SETCOLORLV.IP
[LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* rrb
"10-Mar-86 17:27")
(* * OSD's Print Service 9.0 supports large vector arrays for
MAKESAMPLEDBLACK, with power-of-2 scale factors up to eight, Also note
that bitmap gets rotated -90 degrees, Non-power-of-two values are rounded.)
(* * Note that OSD's Print Service 9.0 has an INCOMPATIBLE change to
MAKESAMPLEDBLACK.)
(* * I changed this to set SCALE and ANGLE from texture if they are not
given. The 8044 only allows 4x4 textures at the same scale at the screen.
A 4x4 will get a scale of 4 so that it looks like it does on the screen.
A 16x16 will get a scale of 1 so that all of it appears albeit at 1/4 the
size. rrb 7-mar-86)
(PROG (SCRATCHBM (DIM 16))
(COND
((EQ OPERATION (QUOTE ERASE)) (* for now, simulate
ERASE by painting white)
(SETQ SCRATCHBM (BITMAPCREATE DIM DIM))
(SETQ OPERATION (QUOTE REPLACE)))
((AND (BITMAPP SHADE)
(EQ (BITMAPWIDTH SHADE)
16)
(EQ (BITMAPHEIGHT SHADE)
16)) (* 16x16 texture
case.)
(SETQ SCRATCHBM SHADE))
(T (* all other textures)
[COND
((NOT (NUMBERP SCALE))
(COND
((NUMBERP SHADE)
(* make numbered textures be at screen scale and bitmap textures be at
closer to printer scale. This at least allows ways of users getting
different effects.)
(SETQ SCALE 4] (* Move the shade
into the scratch
bitmap, that's dim
wide, so we can tell
Interpress about it)
(SETQ SCRATCHBM (BITMAPCREATE DIM DIM))
(BITBLT NIL 0 0 SCRATCHBM 0 0 DIM DIM (QUOTE TEXTURE)
(QUOTE REPLACE)
SHADE)))
(APPENDNUMBER.IP IPSTREAM DIM) (* X Pixels)
(APPENDNUMBER.IP IPSTREAM DIM) (* Y Pixels)
(APPENDINTEGER.IP IPSTREAM 1) (* Samples per pixel)
(APPENDINTEGER.IP IPSTREAM 1) (* Max Sample Value)
(APPENDINTEGER.IP IPSTREAM 1) (* "Interleaved"
samples)
(SCALE.IP IPSTREAM 1) (* Transform datum to
pixel array)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQLARGEVECTOR (IPLUS 1 (ITIMES DIM DIM)))
(* Header for Vector
type)
(APPENDBYTE.IP IPSTREAM 1) (* bytes / sample)
(* samples / scanline)
(* * Now put put the bitmap -- each line must be a 32-bit multiple long)
[for Y from (SUB1 DIM) to 0 by -1
do (for X from 0 to (SUB1 DIM) do (\BOUT IPSTREAM
(BITMAPBIT SCRATCHBM X Y]
(* put out the bits)
(APPENDOP.IP IPSTREAM MAKEPIXELARRAY) (* make the pixel
array)
(SCALE.IP IPSTREAM (OR (NUMBERP SCALE)
1)) (* the 8044 scans
bitmaps from top to
bottom rather than left
to right so rotate it.)
(ROTATE.IP IPSTREAM (OR (NUMBERP ANGLE)
-90))
(CONCAT.IP IPSTREAM)
(APPENDINTEGER.IP IPSTREAM (SELECTQ OPERATION
(REPLACE 0)
(PAINT 1)
1)) (* 0 is white bits
opaque, 1 is white bits
clear)
(APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK)
(ISET.IP IPSTREAM COLOR.IMVAR)
(RETURN NIL])
(SETCOLOR16.IP
[LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* FS
" 2-Aug-85 00:54")
(* * OSD's Print Service 8.0 only supports 16x16 pixel arrays for
MAKESAMPLEDBLACK, with power-of-2 scale factors up to eight, Also note
that bitmap gets rotated -90 degrees, Non-power-of-two values are rounded,
PSD's interpress is allegedly more restrictive)
(* * Note this version is correct for PS 8.0, by implementing the
incorrect PS 8.0 method. Won't work for later versions)
(PROG (SCRATCHBM BMBASE NBYTES (DIM 16))
(COND
((NOT (NUMBERP SCALE))
(SETQ SCALE 1)))
(COND
((NOT (NUMBERP ANGLE))
(SETQ ANGLE 0)))
(SETQ NBYTES (IQUOTIENT (ITIMES DIM DIM)
8))
(SETQ SCRATCHBM (BITMAPCREATE DIM DIM))
(SETQ BMBASE (fetch (BITMAP BITMAPBASE) of SCRATCHBM))
(BITBLT NIL 0 0 SCRATCHBM 0 0 DIM DIM (QUOTE TEXTURE)
(QUOTE REPLACE)
SHADE) (* Move the shade
into the scratch
bitmap, that's dim
wide, so we can tell
Interpress about it)
(APPENDNUMBER.IP IPSTREAM DIM) (* X Pixels)
(APPENDNUMBER.IP IPSTREAM DIM) (* Y Pixels)
(APPENDINTEGER.IP IPSTREAM 1) (* Samples per pixel)
(APPENDINTEGER.IP IPSTREAM 1) (* Max Sample Value)
(APPENDINTEGER.IP IPSTREAM 1) (* "Interleaved"
samples)
(SCALE.IP IPSTREAM 1) (* Transform datum to
pixel array)
(APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 NBYTES))
(* Header for Vector
type)
(APPENDINT.IP IPSTREAM 1 2) (* bits / sample)
(APPENDINT.IP IPSTREAM DIM 2) (* samples / scanline)
(* * Now put put the bitmap -- each line must be a 32-bit multiple long)
(\BOUTS IPSTREAM BMBASE 0 NBYTES) (* 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 0)
(PAINT 1)
1)) (* 0 is white bits
opaque, 1 is white bits
clear)
(APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK)
(ISET.IP IPSTREAM COLOR.IMVAR)
(RETURN NIL])
(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) (* hdj
"18-Oct-85 15:55")
(* Move to X, without
changing Y.)
(COND
((NUMBERP X)
[APPENDINTEGER.IP IPSTREAM (DIFFERENCE 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) (* hdj
"27-Nov-85 17:56")
(* Move to (X,Y) on
the page.)
(APPENDNUMBER.IP IPSTREAM X)
(APPENDNUMBER.IP IPSTREAM 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) (* hdj
"18-Oct-85 16:01")
(COND
((NUMBERP Y)
[APPENDINTEGER.IP IPSTREAM (FIXR (DIFFERENCE 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 MOVING?) (* jds
"11-Feb-86 14:44")
(* * Shows a string buffered away in SHOWSTREAM)
(* If MOVING? is
true, we're going to be
doing a positioning
operation, so there's
no point to correcting
single characters.)
(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.)
(COND
((OR (IGREATERP LEN 1)
(NOT MOVING?)) (* Let's assume that
a single character
won't get too far off.)
[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)
(COND
((OR (IGREATERP LEN 1)
(NOT MOVING?)) (* Let's assume that
a single character
won't get too far off.)
(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) (* hdj
"18-Oct-85 15:46")
(* 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)
(DIFFERENCE (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) (* jds
" 9-Feb-86 17:37")
(* The \OUTCHAR
method for interpress
streams. Print a
character, taking
account of margins, and
things like ↑L.)
(PROG (NSCODE NEWXPOS (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 (DSPNEWPAGE 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]
(COND
((IGREATERP [SETQ NEWXPOS (PLUS (ffetch IPXPOS of IPDATA)
(COND
((EQ NSCODE (CHARCODE SPACE))
(ffetch IPSPACEWIDTH of IPDATA))
(T (\FGETWIDTH (ffetch IPWIDTHSCACHE
of IPDATA)
(\CHAR8CODE NSCODE]
(ffetch IPRIGHT of IPDATA))
(NEWLINE.IP IPSTREAM))
(T (freplace IPXPOS of IPDATA with NEWXPOS)))
(* 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) (* jds
" 9-Feb-86 17:37")
(* Doesn't check for
page overflow--wait
until something is
actually shown.)
(SHOW.IP IPSTREAM)
(PROG (NEWYPOS (IPDATA (ffetch IPDATA of IPSTREAM)))
(SETQ NEWYPOS (PLUS (ffetch IPYPOS of IPDATA)
(ffetch IPLINEFEED of IPDATA)))
(COND
((LESSP NEWYPOS (fetch IPBOTTOM of IPDATA))
(DSPNEWPAGE IPSTREAM))
(T (SETXY.IP IPSTREAM (ffetch IPLEFT of IPDATA)
NEWYPOS])
(NEWPAGE.IP
[LAMBDA (IPSTREAM) (* jds
" 7-Feb-86 13:57")
(* * Start a new page in an interpress stream)
(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) (* If there's a page
heading, do something
about it.)
(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)
(DIFFERENCE (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)
(DIFFERENCE (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) (* hdj
"18-Oct-85 15:38")
(* Are we about to
overflow the page?)
(COND
((LESSP (fetch IPYPOS of (fetch IPDATA of IPSTREAM))
(fetch IPBOTTOM of (fetch IPDATA of IPSTREAM)))
(NEWPAGE.IP IPSTREAM])
(OPENIPSTREAM
[LAMBDA (IPFILE OPTIONS) (* edited:
"31-Mar-86 15:44")
(* Opens an interpress stream, which user can 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 \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))) (* initialize the stack)
(* 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)))
(COND
((LISTGET OPTIONS (QUOTE COLOR))
(INITIALIZECOLOR.IP IPSTREAM)
(STREAMPROP IPSTREAM (QUOTE COLOR)
T)))
(PUSH-IP-STACK IPSTREAM (create IPSTATE))
(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) (* rrb
"10-Mar-86 18:38")
(* 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))) (* put out to avoid
moire patterns)
(SETQ SCALE [COND
(SCALE (\RTIMES2 SCALE (FQUOTIENT 2540 75)))
(T (\RTIMES2 1 (FQUOTIENT 2540 75] (* 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.)])
(\BITMAPSIZE.IP
[LAMBDA (STREAM BITMAP DIMENSION) (* rrb
"11-Mar-86 10:03")
(* returns the height a bitmap will have on an interpress device.
This is reduced in scale by 4% to avoid moire patterns on the 8044 by
using (FQUOTIENT 2540 75) rather than MICASPERPT)
(SELECTQ DIMENSION
(WIDTH (TIMES (BITMAPWIDTH BITMAP)
(CONSTANT (FQUOTIENT 2540 75))))
(HEIGHT (TIMES (BITMAPHEIGHT BITMAP)
(CONSTANT (FQUOTIENT 2540 75))))
(NIL [CONS (TIMES (BITMAPWIDTH BITMAP)
(CONSTANT (FQUOTIENT 2540 75)))
(TIMES (BITMAPHEIGHT BITMAP)
(CONSTANT (FQUOTIENT 2540 75])
(\ILLEGAL.ARG DIMENSION])
(SHOWBITMAP1.IP
[LAMBDA (IPSTREAM BITMAP LEFT FIRSTROW XPIXELS YPIXELS SCALEFACTOR ROTATION HEIGHT XBYTES
REGIONBOTTOM) (* jds
"13-Jan-86 18:13")
(* 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 (IPLUS FIRSTROW YPIXELS))
(* 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 0 (IPLUS FIRSTROW YPIXELS))
(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 (IDIFFERENCE HEIGHT (IPLUS FIRSTROW YPIXELS))
0)
(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 SCALE ANGLE) (* FS
"25-Feb-86 15:29")
(* * Puts out bit map with lower-left corner at current position.
REGION is a clipping region on the bitmap.)
(SHOW.IP IPSTREAM)
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {)
(SETCOLOR.IP IPSTREAM SHADE OPERATION SCALE ANGLE)
(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 "11-Jun-86 18:47")
(* * "what this does: because there is no device-supported clipping in IP2.1, we are forced to do it ourselves. We transform the bitmap region into IP space, do the clipping there, then transform it back. Most of the ugliness comes from doing arithmetic on regions, which is always big and messy")
(LET*
[(OLDX (\DSPXPOSITION.IP DESTINATION))
(OLDY (\DSPYPOSITION.IP DESTINATION))
(DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY))
(REGION (if CLIPPINGREGION
then [LET* ((STREAMSCALE (DSPSCALE NIL DESTINATION))
(DESTWIDTH (TIMES STREAMSCALE WIDTH))
(DESTHEIGHT (TIMES STREAMSCALE HEIGHT))
(SOURCEREGION (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM DESTWIDTH
DESTHEIGHT))
(DESTINATIONREGION (INTERSECTREGIONS SOURCEREGION CLIPPINGREGION)))
(* * "transform the clipping region into source coord space")
(if DESTINATIONREGION
then (\MOVETO.IP DESTINATION (fetch (REGION LEFT) of
DESTINATIONREGION
)
(fetch (REGION BOTTOM) of DESTINATIONREGION))
(CREATEREGION (PLUS CLIPPEDSOURCELEFT
(FIXR (QUOTIENT (DIFFERENCE
(fetch (REGION LEFT)
of DESTINATIONREGION)
DESTINATIONLEFT)
STREAMSCALE)))
(PLUS CLIPPEDSOURCEBOTTOM
(FIXR (QUOTIENT (DIFFERENCE (fetch (REGION BOTTOM)
of
DESTINATIONREGION
)
DESTINATIONBOTTOM)
STREAMSCALE)))
(FIXR (QUOTIENT (fetch (REGION WIDTH) of
DESTINATIONREGION
)
STREAMSCALE))
(FIXR (QUOTIENT (fetch (REGION HEIGHT) of
DESTINATIONREGION
)
STREAMSCALE]
else (\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
(CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT]
(if REGION
then (SHOWBITMAP.IP DESTINATION SOURCEBITMAP REGION 1)
(\MOVETO.IP DESTINATION OLDX OLDY)
T
else NIL])
(\SCALEDBITBLT.IP
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM SCALE) (* hdj "11-Jun-86 18:47")
(LET*
[(OLDX (\DSPXPOSITION.IP DESTINATION))
(OLDY (\DSPYPOSITION.IP DESTINATION))
(DESTINATIONLEFT (OR DESTINATIONLEFT OLDX))
(DESTINATIONBOTTOM (OR DESTINATIONBOTTOM OLDY))
(REGION (if CLIPPINGREGION
then [LET* ((STREAMSCALE (TIMES SCALE (DSPSCALE NIL DESTINATION)))
(DESTWIDTH (TIMES STREAMSCALE WIDTH))
(DESTHEIGHT (TIMES STREAMSCALE HEIGHT))
(SOURCEREGION (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM DESTWIDTH
DESTHEIGHT))
(DESTINATIONREGION (INTERSECTREGIONS SOURCEREGION CLIPPINGREGION)))
(* * "transform the clipping region into source coord space")
(if DESTINATIONREGION
then (\MOVETO.IP DESTINATION (fetch (REGION LEFT) of
DESTINATIONREGION
)
(fetch (REGION BOTTOM) of DESTINATIONREGION))
(CREATEREGION (PLUS CLIPPEDSOURCELEFT
(FIXR (QUOTIENT (DIFFERENCE
(fetch (REGION LEFT)
of DESTINATIONREGION)
DESTINATIONLEFT)
STREAMSCALE)))
(PLUS CLIPPEDSOURCEBOTTOM
(FIXR (QUOTIENT (DIFFERENCE (fetch (REGION BOTTOM)
of
DESTINATIONREGION
)
DESTINATIONBOTTOM)
STREAMSCALE)))
(FIXR (QUOTIENT (fetch (REGION WIDTH) of
DESTINATIONREGION
)
STREAMSCALE))
(FIXR (QUOTIENT (fetch (REGION HEIGHT) of
DESTINATIONREGION
)
STREAMSCALE]
else (\MOVETO.IP DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM)
(CREATEREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM WIDTH HEIGHT]
(if REGION
then (SHOWBITMAP.IP DESTINATION SOURCEBITMAP REGION SCALE)
(\MOVETO.IP DESTINATION OLDX OLDY)
T
else NIL])
(\BLTSHADE.IP
[LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)
(* rrb
" 5-Mar-86 16:15")
(LET*[(REGION (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT))
(DESTREGION (COND
(CLIPPINGREGION (INTERSECTREGIONS REGION CLIPPINGREGION))
(T REGION]
(COND
((GREATERP PRINTSERVICE 8.0)
(SHOWSHADE.IP STREAM (INSURE.B&W.TEXTURE TEXTURE)
DESTREGION OPERATION))
(T (* 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])
(\DRAWARC.IP
[LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING)
(* rrb
" 4-Oct-85 17:24")
(* draws an arc on an
interpress file)
(\DRAWARC.GENERIC STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING])
(\DRAWCURVE.IP
[LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING) (* edited:
"31-Mar-86 20:40")
(* 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) (* to allow the brush
color to have the correct
scope)
(LET (K)
[OR (CDR KNOTS)
(SETQ KNOTS (LIST (CAR KNOTS)
(CAR KNOTS] (* The funny case of a
single knot)
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {)
(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)))
(APPENDOP.IP IPSTREAM })
(SETXY.IP IPSTREAM (fetch XCOORD of K)
(fetch YCOORD of K]
IPSTREAM])
(\DSPCOLOR.IP
[LAMBDA (IPSTREAM COLOR) (* edited:
"31-Mar-86 15:36")
(if (STREAMPROP IPSTREAM (QUOTE COLOR))
then (* this is an interpress
stream which can interpret
color, otherwise dspcolor
is a no-op)
(if COLOR
then (LET*((IPDATA (fetch IPDATA of IPSTREAM))
(RGB (ENSURE.RGB COLOR)))
(replace (INTERPRESSDATA IPCOLOR) of IPDATA with RGB)
(SETRGB.IP IPSTREAM (CAR RGB)
(CADR RGB)
(CADDR RGB)))
else (fetch (INTERPRESSDATA IPCOLOR) of (fetch IPDATA of IPSTREAM
])
(ENSURE.RGB
[LAMBDA (COLOR NOERRORFLG?) (* edited:
"31-Mar-86 21:41")
(* returns an rgb triple
or errors (NIL if
NOERRORFLG)%. Acceptable
input is RGB, HLS, or
litatom on COLORNAMES)
(LET ((RGB COLOR))
(COND
((LITATOM COLOR)
(if (SETQ RGB (\LOOKUPCOLORNAME COLOR))
then (pop RGB)))
((HLSP RGB)
(HLSTORGB RGB)))
(if (NOT (RGBP RGB))
then (if NOERRORFLG?
then NIL
else (ERROR "Illegal color" COLOR))
else RGB])
(\IPCURVE2
[LAMBDA (IPSTREAM SPLINE DASHING BRUSH) (* jds
" 4-Dec-85 14:20")
(* * Given an Interpress stream, and a spline in the form of derivatives
for each segment, and a brush to draw with, draw line segments to paint
the curve.)
(* * NB: The endpoints of line segments are placed only to 1/300in
accuracy, since that's all the accuracy our printers have.
This speeds things up by a factor of 8 or more.)
(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) (* Make a circular
list of dashing
intervals, so that we
can just CDR down it to
find dashings.)
(SETQ DASHCNT (CAR DASHING))
(SETQ SEG# 0)
(SETQ IPDATA (fetch IMAGEDATA of IPSTREAM))
(MOVETO.IP IPSTREAM X0 Y0) (* Move to the
curve's starting point)
(replace IPXPOS of IPDATA with X0)
(replace IPYPOS of IPDATA with Y0)
(SETQ TT 0.0) (* We paint each
segment by walking the
parameter TT from 0.0
to 1.0)
(SETQ DELTA 1024)
(SETQ IX (FIXR X0))
(SETQ IY (FIXR Y0))
[for KNOT# from 1 to (SUB1 #KNOTS)
do (* Draw each segment
in turn)
(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 (* Run the parameter
TT from 0 to 1 for this
segment)
(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) (* Prevent
divide-by-zero)
(SETQ X'T .0005)))
(COND
((EQP Y'T 0.0) (* Prevent
divide-by-zero)
(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)) (* Decide which of dX
or dY is changing
faster, and use that as
the limiting value)
[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]
(* If we've run TT past 1, or if this knot is duplicated
(meaning make a discontinuity in x' & y') then draw straight to the end
point.)
(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))) (* Find out how close
we come to the ideal)
(SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
NEWYT)))
(COND
((AND (IGREATERP DELTA 8)
(OR (FGTP XDIFF 8.0)
(FGTP YDIFF 8.0))) (* We're more than a
printer dot off, and we
still have room to make
the DX or DY smaller.
Do so & try again.)
(SETQ DELTA (LRSH DELTA 1)))
(T (* This is as close
as we can come.
Draw the line segment.)
[COND
((IGREATERP (add SEG# 1)
MAXSEGSPERTRAJECTORY) (* Our printers limit
the number of segments
in a single TRAJECTORY;
make sure we respect
their limitations)
(\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)) (* Draw the line)
(SETQ IX (IPLUS IX DX))
(SETQ IY (IPLUS IY DY))
(SETQ TT NEWT)
(SETQ XT NEWXT)
(SETQ YT NEWYT)
(COND
((AND (ILESSP DELTA 1024)
(OR (FLESSP XDIFF 4.0)
(FLESSP YDIFF 4.0))) (* If we were REAL
close, we can relax a
bit, and try moving
farther next time.)
(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 DASHING) (* edited:
"31-Mar-86 20:50")
(COND
(DASHING (* added dashing hack -
rrb 27-sept-85)
(DRAWDASHEDLINE X1 Y1 X2 Y2 WIDTH OPERATION IPSTREAM COLOR DASHING))
(T (* 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)
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {)
(MOVETO.IP IPSTREAM X1 Y1)
(LINETO.IP IPSTREAM X2 Y2)
(\SETBRUSH.IP IPSTREAM (LIST (QUOTE BUTT)
WIDTH COLOR))
(MASKSTROKE.IP IPSTREAM)
(APPENDOP.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) (* gbn
"18-Sep-85 18:32")
(* 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)
(\CHANGECHARSET.IP IPDATA \DEFAULTCHARSET)
[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) (* jds
"14-Feb-86 12:13")
(* * DSPXPOSITION method for interpress streams)
(PROG1 (fetch IPXPOS of (fetch IPDATA of IPSTREAM))
(COND
([AND XPOSITION (NOT (EQP XPOSITION (fetch IPXPOS of (fetch IPDATA
of IPSTREAM]
(SHOW.IP IPSTREAM T) (* (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])
(\DSPROTATE.IP
[LAMBDA (IPSTREAM ROTATION) (* hdj
"12-Nov-85 12:16")
(ROTATE.IP IPSTREAM ROTATION)
(CONCATT.IP IPSTREAM])
(\PUSHSTATE.IP
[LAMBDA (IPSTREAM) (* hdj
" 3-Jan-86 11:10")
(* * push a new context onto the stack)
(LET ((XVar# (GETFRAMEVAR.IP IPSTREAM))
(YVar# (GETFRAMEVAR.IP IPSTREAM))
(State (IP-TOS IPSTREAM)))
(replace (IPSTATE XPOS) of State with XVar#)
(replace (IPSTATE YPOS) of State with YVar#)
(* *)
(GETCP.IP IPSTREAM)
(FSET.IP IPSTREAM XVar#)
(FSET.IP IPSTREAM YVar#)
(* *)
(SHOW.IP IPSTREAM)
(PUSH-IP-STACK IPSTREAM (create IPSTATE))
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY)
(APPENDOP.IP IPSTREAM {])
(\POPSTATE.IP
[LAMBDA (IPSTREAM) (* hdj
" 3-Jan-86 11:10")
(* * pop the current context)
(SHOW.IP IPSTREAM)
(APPENDOP.IP IPSTREAM })
(POP-IP-STACK IPSTREAM)
(* * restore X & Y pos)
(LET ((State (IP-TOS IPSTREAM)))
(FGET.IP IPSTREAM (fetch (IPSTATE XPOS) of State))
(FGET.IP IPSTREAM (fetch (IPSTATE YPOS) of State))
(APPENDOP.IP IPSTREAM SETXY])
(\DEFAULTSTATE.IP
[LAMBDA (IPSTREAM) (* hdj
"30-Dec-85 17:18")
(* * establish meter coordinate system)
(SCALE.IP IPSTREAM 1)
(ISET.IP IPSTREAM CURRENTTRANS])
(\DSPTRANSLATE.IP
[LAMBDA (IPSTREAM Tx Ty) (* hdj
"12-Nov-85 12:22")
(TRANSLATE.IP IPSTREAM Tx Ty)
(CONCATT.IP IPSTREAM])
(\DSPSCALE2.IP
[LAMBDA (IPSTREAM Sx Sy) (* hdj
"12-Nov-85 12:23")
(SCALE2.IP IPSTREAM Sx Sy)
(CONCATT.IP 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])
(\FILLPOLYGON.IP
[LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* rrb
" 7-Mar-86 10:56")
(* * OSD 2.1 subset allows convex polygons, note imager state modified.
SAVESIMPLEBODY should undo, this routine not used in DIG due to convexity
requirement, but provided for true interpress printers)
(APPENDOP.IP STREAM DOSAVESIMPLEBODY)
(APPENDOP.IP STREAM {)
(SETCOLOR.IP STREAM TEXTURE OPERATION WINDNUMBER)
(FILLTRAJECTORY.IP STREAM POINTS)
(APPENDOP.IP STREAM }])
(\FIXLINELENGTH.IP
[LAMBDA (IPSTREAM) (* hdj
"18-Oct-85 15:47")
(* 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 (FIXR (QUOTIENT (DIFFERENCE (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) (* jds
"11-Feb-86 14:47")
(* * Do MOVETO for interpress streams)
(SHOW.IP IPSTREAM T) (* First, close out
what we had been doing.)
(SETXY.IP IPSTREAM X Y])
(\SETBRUSH.IP
[LAMBDA (IPSTREAM BRUSH) (* edited:
"31-Mar-86 23:16")
(* Sets the stroke shape
parameters.)
(PROG (WIDTH SHAPE COLOR RGB)
[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)
(if (AND (SETQ COLOR (fetch (BRUSH BRUSHCOLOR) of BRUSH))
(STREAMPROP IPSTREAM (QUOTE COLOR)))
then (* set the color)
(SETQ RGB (ENSURE.RGB COLOR))
(SETRGB.IP IPSTREAM (CAR RGB)
(CADR RGB)
(CADDR RGB])
(\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) (* rrb
" 2-Oct-85 14:02")
(* changed to fetch
the clipping region
field rather than the
page region which is
the margins. Currently
setting this will not
have any effect.)
(LET ((IPDATA (fetch (STREAM IMAGEDATA) of STREAM)))
(PROG1 (fetch (INTERPRESSDATA IPClippingRegion) of IPDATA)
(AND REGION (UNINTERRUPTABLY
(replace (INTERPRESSDATA IPClippingRegion) of IPDATA
with REGION))])
(\DSPOPERATION.IP
[LAMBDA (IPSTREAM OPERATION) (* rrb
" 6-Mar-86 16:16")
(* sets the operation
field of a interpress
stream)
(PROG ((IPDATA (ffetch IMAGEDATA of IPSTREAM)))
(RETURN (PROG1 (ffetch (INTERPRESSDATA IPOPERATION) of IPDATA)
(AND OPERATION (COND
((FMEMB OPERATION (QUOTE (PAINT REPLACE INVERT ERASE)))
(freplace (INTERPRESSDATA IPOPERATION) of IPDATA
with OPERATION))
(T (\ILLEGAL.ARG OPERATION])
)
(* image state)
(DEFINEQ
(IP-TOS
[LAMBDA (IPSTREAM) (* hdj
"30-Dec-85 17:30")
(LET [(STACK (STREAMPROP IPSTREAM (QUOTE STACK]
(if STACK
then (CAR STACK)
else (ERROR "Stack is empty" IPSTREAM])
(POP-IP-STACK
[LAMBDA (IPSTREAM) (* hdj
"30-Dec-85 17:30")
(LET [(STACK (STREAMPROP IPSTREAM (QUOTE STACK]
(if STACK
then (STREAMPROP IPSTREAM (QUOTE STACK)
(CDR STACK))
else (ERROR "Stack is empty" IPSTREAM])
(PUSH-IP-STACK
[LAMBDA (IPSTREAM OBJECT) (* hdj
"30-Dec-85 17:31")
(STREAMPROP IPSTREAM (QUOTE STACK)
(CONS OBJECT (STREAMPROP IPSTREAM (QUOTE STACK])
)
[DECLARE: EVAL@COMPILE
(RECORD IPSTATE (XPOS YPOS))
]
(DEFINEQ
(\CREATECHARSET.IP
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?) (* FS
" 4-Mar-86 14:30")
(* * Build the CHARSETINFO for an Interpress NS font.
If we can't find widths info for that font, return NIL)
(* * Widths array is fully allocated, with zeroes for characters with no
information. An array is not allocated for fixed WidthsY.
DEVICE is PRESS or INTERPRESS)
(DECLARE (GLOBALVARS INTERPRESSFONTDIRECTORIES \ASCIITONS))
(RESETLST (* RESETLST to make
sure the fontfiles get
closed)
(PROG (WFILE WSTRM FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHSY
(NSMICASIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
72)))
(CSINFO (create CHARSETINFO)))
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))
[COND
((SETQ WFILE (FINDFILE (\FONTFILENAME FAMILY PSIZE FACE (QUOTE WD)
CHARSET)
T INTERPRESSFONTDIRECTORIES))
(* * Look thru INTERPRESSFONTDIRECTORIES for a .WD file that describes
the font requested. Only continue if we can find one.)
[RESETSAVE (SETQ WSTRM (OPENSTREAM WFILE (QUOTE INPUT)
(QUOTE OLD)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[COND
((RANDACCESSP WSTRM)
(SETFILEPTR WSTRM 0))
(T (COPYBYTES WSTRM (SETQ WSTRM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(SETQ RELFLAG (\POSITIONFONTFILE WSTRM NSMICASIZE FIRSTCHAR LASTCHAR NIL))
(* * \POSITIONFONTFILE sets FIRSTCHAR LASTCHAR as well as positioning
the font file at the beginning of the widths)
(* * Fill in the widths, and return a flag telling whether the widths
are absolute, or are type-size relative.
0 => relative)
)
(T (* Can't find a file
to describe this font;)
(RETURN (if NOSLUG?
then (* the caller just
wants NIL back to
signal that nothing was
found)
NIL
else (\BUILDSLUGCSINFO (fetch (FONTDESCRIPTOR
FONTAVGCHARWIDTH)
of FONTDESC)
(FONTPROP FONTDESC (QUOTE ASCENT))
(FONTPROP FONTDESC (QUOTE DESCENT))
(FONTPROP FONTDESC (QUOTE DEVICE]
(SETQ RELFLAG (ZEROP RELFLAG)) (* Convert the flag
to a logical value)
(SETFILEPTR WSTRM (UNFOLD (\FIXPIN WSTRM)
BYTESPERWORD))
(* * Read the location of the WD segment for this font
(we're in the directory part of the file now), and go there.)
(SETQ FBBOX (SIGNED (\WIN WSTRM)
BITSPERWORD)) (* replace (
FONTDESCRIPTOR FBBOX)
of FD with (SIGNED
(\WIN WSTRM)
BITSPERWORD))
(* Get the max
bounding width for the
font)
(replace (CHARSETINFO CHARSETDESCENT) of CSINFO
with (IMINUS (SIGNED (\WIN WSTRM)
BITSPERWORD))) (* Descent is -FBBOY)
(\WIN WSTRM) (* replace (
FONTDESCRIPTOR FBBDX)
of FD with (SIGNED
(\WIN WSTRM)
BITSPERWORD))
(* And the standard
kern value (?))
(SETQ CHARSETHEIGHT (SIGNED (\WIN WSTRM)
BITSPERWORD)) (* replace \SFHeight
of FD with (SIGNED
(\WIN WSTRM)
BITSPERWORD))
(* Height is FBBDY)
[COND
(RELFLAG (* Dimensions are
relative, must be
scaled)
(* replace (
FONTDESCRIPTOR FBBOX)
of FD with (IQUOTIENT
(ITIMES (fetch
(FONTDESCRIPTOR FBBOX)
of FD) NSMICASIZE) 1000))
(replace (CHARSETINFO CHARSETDESCENT) of CSINFO
with (IQUOTIENT (ITIMES (fetch (CHARSETINFO CHARSETDESCENT)
of CSINFO)
NSMICASIZE)
1000)) (* replace (
FONTDESCRIPTOR FBBDX)
of FD with (IQUOTIENT
(ITIMES (fetch
(FONTDESCRIPTOR FBBDX)
of FD) NSMICASIZE) 1000))
(SETQ CHARSETHEIGHT (IQUOTIENT (ITIMES CHARSETHEIGHT NSMICASIZE)
1000]
(replace (CHARSETINFO CHARSETASCENT) of CSINFO
with (IDIFFERENCE CHARSETHEIGHT (fetch CHARSETDESCENT of CSINFO)))
(SETQ FIXEDFLAGS (LRSH (\BIN WSTRM)
6)) (* The fixed flags)
(\BIN WSTRM) (* Skip the spares)
[COND
((EQ 2 (LOGAND FIXEDFLAGS 2)) (* This font is fixed
width.)
(SETQ TEM (\WIN WSTRM)) (* Read the fixed
width for this font)
[COND
((AND RELFLAG (NOT (ZEROP TEM))) (* If it's size
relative, scale it.)
(SETQ TEM (IQUOTIENT (ITIMES TEM NSMICASIZE)
1000]
(for I from FIRSTCHAR to LASTCHAR do (* Fill in the char
widths table with the
width.)
(\FSETWIDTH WIDTHS I TEM)))
(T (* Variable width
font, so we have to
read widths.)
(* AIN WIDTHS
FIRSTCHAR (ADD1
(IDIFFERENCE LASTCHAR
FIRSTCHAR)) WSTRM)
(for I from FIRSTCHAR to LASTCHAR
do (\FSETWIDTH WIDTHS I noInfoCode))
(\BINS (\GETOFD WSTRM (QUOTE INPUT))
WIDTHS
(UNFOLD FIRSTCHAR BYTESPERWORD)
(UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
BYTESPERWORD)) (* Read the X widths.)
(for I from FIRSTCHAR to LASTCHAR
when (EQ noInfoCode (\FGETWIDTH WIDTHS I))
do (* For chars that
have no width info, let
width be zero.)
(\FSETWIDTH WIDTHS I 0))
(COND
(RELFLAG (* If the widths are
size-relative, scale
them.)
(for I from FIRSTCHAR to LASTCHAR
do (\FSETWIDTH WIDTHS I (IQUOTIENT (ITIMES (\FGETWIDTH WIDTHS
I)
NSMICASIZE)
1000]
[COND
[(EQ 1 (LOGAND FIXEDFLAGS 1))
(COND
((ILESSP (GETFILEPTR WSTRM)
(GETEOFPTR WSTRM))
(SETQ WIDTHSY (\WIN WSTRM)))
(T (* STAR FONT FILES
LIKE TO LEAVE OFF THE Y
WIDTH.)
(SETQ WIDTHSY 0))) (* The fixed width-Y
for this font;
the width-Y field is a
single integer in the
FD)
(replace (CHARSETINFO YWIDTHS) of CSINFO
with (COND
((AND RELFLAG (NOT (ZEROP WIDTHSY)))
(IQUOTIENT (ITIMES WIDTHSY NSMICASIZE)
1000))
(T WIDTHSY]
(T (* Variable Y-width
font. Fill it in as
above)
(SETQ WIDTHSY (replace (CHARSETINFO YWIDTHS) of CSINFO with (
\CREATECSINFOELEMENT
)))
(for I from FIRSTCHAR to LASTCHAR
do (\FSETWIDTH WIDTHSY I noInfoCode))
(\BINS (\GETOFD WSTRM (QUOTE INPUT))
WIDTHSY
(UNFOLD FIRSTCHAR BYTESPERWORD)
(UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
BYTESPERWORD)) (* Read the Y widths)
(for I from FIRSTCHAR to LASTCHAR
when (EQ noInfoCode (\FGETWIDTH WIDTHSY I))
do (* Let any characters
with no width info be
zero height)
(\FSETWIDTH WIDTHSY I 0))
(COND
(RELFLAG (* If the widths are
size-relative, scale
them.)
(for I from FIRSTCHAR to LASTCHAR
do (\FSETWIDTH WIDTHSY I (IQUOTIENT (ITIMES (\FGETWIDTH
WIDTHSY I)
NSMICASIZE)
1000]
(RETURN CSINFO])
(\CHANGECHARSET.IP
[LAMBDA (IPDATA CHARSET) (* gbn
" 1-Oct-85 17:45")
(* Called when the
character set
information cached in a
display stream doesn't
correspond to CHARSET)
(PROG*((FONT (ffetch IPFONT of IPDATA))
(CSINFO (\GETCHARSETINFO CHARSET FONT)))
(* * since the call to \getcharsetinfo has NOSLUG? = NIL, we know that
we will get a reasonable character set back)
(UNINTERRUPTABLY
(freplace IPWIDTHSCACHE of IPDATA with (ffetch (CHARSETINFO WIDTHS)
of CSINFO))
(freplace NSCHARSET of IPDATA with CHARSET))])
)
(DEFINEQ
(\INTERPRESSINIT
[LAMBDA NIL (* edited:
"31-Mar-86 15:35")
(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 CIRCSHADE.IP)
IMBLTSHADE ←(FUNCTION \BLTSHADE.IP)
IMBITBLT ←(FUNCTION \BITBLT.IP)
IMNEWPAGE ←(FUNCTION NEWPAGE.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)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.IP)
IMCOLOR ←(FUNCTION \DSPCOLOR.IP)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.IP)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.IP)
IMSCALEDBITBLT ←(FUNCTION \SCALEDBITBLT.IP)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.IP)
IMFILLPOLYGON ←(FUNCTION POLYSHADE.IP)
IMDRAWARC ←(FUNCTION \DRAWARC.IP)
IMPUSHSTATE ←(FUNCTION \PUSHSTATE.IP)
IMPOPSTATE ←(FUNCTION \POPSTATE.IP)
IMROTATE ←(FUNCTION \DSPROTATE.IP)
IMSCALE2 ←(FUNCTION \DSPSCALE2.IP)
IMTRANSLATE ←(FUNCTION \DSPTRANSLATE.IP)
IMDEFAULTSTATE ←(FUNCTION \DEFAULTSTATE.IP)
IMOPERATION ←(FUNCTION \DSPOPERATION.IP)
IMBITMAPSIZE ←(FUNCTION \BITMAPSIZE.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? IPPAGEREGION.ROT180 NIL)
(RPAQ? IPPAGEREGION.ROT270 NIL)
(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 POINTER)
(IPYPOS POINTER)
IPFONT IPPREAMBLEFONTS IPPAGEFONTS IPWIDTHSCACHE IPCOLOR (IPLINEFEED POINTER)
IPPAGESTATE IPSHOWSTREAM XIPPAGEREGION IPDOCNAME (IPLEFT POINTER)
(IPBOTTOM POINTER)
(IPRIGHT POINTER)
(IPTOP POINTER)
(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 POINTER) (* 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.)
IPClippingRegion
(* the edges of the paper as far as Interpress is concerned.
Included to allow users to find out how large the page is via
DSPCLIPPINGREGION.)
(IPCOLORMODEL WORD) (* preamble fvar in which we have
stored the color model we are using
(for post-IP 2.1 ONLY))
(IPOPERATION POINTER) (* used to keep the current operation
mode PAINT, REPLACE, ERASE or INVERT.)
)
IPXPOS ← 0 IPYPOS ← 0 IPNEXTFRAMEVAR ← 0 IPSPACEFACTOR ← 1 IPROTATION ← 0 IPXOFFSET ← 0
IPYOFFSET ← 0 IPClippingRegion ←
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 21590
HEIGHT ← 29210)
IPCOLORMODEL ← 0 IPOPERATION ← (QUOTE PAINT)
[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 POINTER POINTER POINTER POINTER WORD BYTE BYTE
BYTE BYTE POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD
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 POINTER)
(INTERPRESSDATA 30 POINTER)
(INTERPRESSDATA 32 POINTER)
(INTERPRESSDATA 34 POINTER)
(INTERPRESSDATA 36 (BITS . 15))
(INTERPRESSDATA 34 (BITS . 7))
(INTERPRESSDATA 32 (BITS . 7))
(INTERPRESSDATA 30 (BITS . 7))
(INTERPRESSDATA 28 (BITS . 7))
(INTERPRESSDATA 38 POINTER)
(INTERPRESSDATA 40 POINTER)
(INTERPRESSDATA 42 POINTER)
(INTERPRESSDATA 44 POINTER)
(INTERPRESSDATA 46 POINTER)
(INTERPRESSDATA 48 POINTER)
(INTERPRESSDATA 50 POINTER)
(INTERPRESSDATA 52 POINTER)
(INTERPRESSDATA 37 (BITS . 15))
(INTERPRESSDATA 54 POINTER)))
(QUOTE 56))
)
(/DECLAREDATATYPE (QUOTE INTERPRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD BYTE BYTE
BYTE BYTE POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD
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 POINTER)
(INTERPRESSDATA 30 POINTER)
(INTERPRESSDATA 32 POINTER)
(INTERPRESSDATA 34 POINTER)
(INTERPRESSDATA 36 (BITS . 15))
(INTERPRESSDATA 34 (BITS . 7))
(INTERPRESSDATA 32 (BITS . 7))
(INTERPRESSDATA 30 (BITS . 7))
(INTERPRESSDATA 28 (BITS . 7))
(INTERPRESSDATA 38 POINTER)
(INTERPRESSDATA 40 POINTER)
(INTERPRESSDATA 42 POINTER)
(INTERPRESSDATA 44 POINTER)
(INTERPRESSDATA 46 POINTER)
(INTERPRESSDATA 48 POINTER)
(INTERPRESSDATA 50 POINTER)
(INTERPRESSDATA 52 POINTER)
(INTERPRESSDATA 37 (BITS . 15))
(INTERPRESSDATA 54 POINTER)))
(QUOTE 56))
(DEFINEQ
(INTERPRESSBITMAP
[LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE) (* kbr:
"26-Feb-86 00:35")
(* Print a bitmap into
an IP file)
(PROG (IPSTREAM W H)
(SETQ IPSTREAM (OPENIMAGESTREAM (OR OUTPUTFILE (QUOTE {SCRATCH}IPBITMAP.SCRATCH))
(QUOTE INTERPRESS)))
[SETQ W (COND
(REGION (fetch (REGION WIDTH) of REGION))
(T (fetch (BITMAP BITMAPWIDTH) of BITMAP]
[SETQ H (COND
(REGION (fetch (REGION HEIGHT) of REGION))
(T (fetch (BITMAP BITMAPHEIGHT) of BITMAP]
(COND
(TITLE (RELMOVETO (IDIFFERENCE (TIMES 4 MICASPERINCH)
(STRINGWIDTH TITLE IPSTREAM))
0 IPSTREAM)
(PRIN1 TITLE IPSTREAM))) (* Try to center
around within the
pageframe margins)
[COND
(SCALEFACTOR (SETQ W (\RTIMES2 W SCALEFACTOR))
(SETQ H (\RTIMES2 H SCALEFACTOR]
(SELECTQ (SETQ ROTATION (IMOD (OR ROTATION DEFAULT.INTERPRESS.BITMAP.ROTATION)
360))
(0 (SETQ W (\RTIMES2 -1 W))
(SETQ H (\RTIMES2 -1 H)))
(270 [SETQ W (PROG1 H (SETQ H (\RTIMES2 -1 W])
(180)
(90 [SETQ H (PROG1 (\RTIMES2 -1 W)
(SETQ W (\RTIMES2 -1 H])
(ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented"))
[\MOVETO.IP IPSTREAM [\RPLUS2 (\RTIMES2 MICASPERINCH 4.25)
(\RTIMES2 W (CONSTANT (FQUOTIENT 635 36]
(\RPLUS2 (\RTIMES2 MICASPERINCH 5.5)
(\RTIMES2 H (CONSTANT (FQUOTIENT 635 36] (* Position so that
the bitmap's image is
centered on the paper
((635 / 36) = half the
micas in a point))
(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))
(HOSTNAMEP NSPRINTER.HOSTNAMEP)
(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)
(TEDIT.FORMAT.HARDCOPY
[OPENTEXTSTREAM (SETQ FILE
(OPENSTREAM
FILE
(QUOTE INPUT]
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)
(* gbn
"12-Sep-85 15:10")
(* 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 (\GETCHARSETINFO 0 FD]
[bind NSCODE CS for I 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
((\GETCHARSETINFO CS FD))
(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 NSCODE (WIDTHS ←(fetch (CHARSETINFO WIDTHS)
of (\GETCHARSETINFO 0 FD))) for I
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.)
(\FSETWIDTH WIDTHS I (\FGETWIDTH (fetch (CHARSETINFO WIDTHS) of
CHARSETINFO
)
(\CHAR8CODE NSCODE]
[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))
(SETQ FACE (\FONTFACE FACE)) (* Normalize face)
(bind FONTSFOUND THISFONT THISFACE (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)))
(SETQ THISFACE (CADDR THISFONT))
(AND (OR (EQ FAMILY (QUOTE *))
(EQ FAMILY (CAR THISFONT)))
(OR (EQ PSIZE (QUOTE *))
(EQ PSIZE (CADR THISFONT)))
(OR (EQ FACE (QUOTE *))
(AND (OR (EQ (CAR FACE)
(QUOTE *))
(EQ (CAR FACE)
(CAR THISFACE)))
(OR (EQ (CADR FACE)
(QUOTE *))
(EQ (CADR FACE)
(CADR THISFACE)))
(OR (EQ (CADDR FACE)
(QUOTE *))
(EQ (CADDR FACE)
(CADDR THISFACE]
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
])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ noInfoCode 32768)
(CONSTANTS (noInfoCode 32768))
)
)
(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)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(LOADDEF (QUOTE SYSTEMBRUSH)
(QUOTE RESOURCES)
(QUOTE IMAGEIO))
(LOADDEF (QUOTE BRUSH)
(QUOTE RECORDS)
(QUOTE IMAGEIO))
)
(PUTPROPS INTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10875 17289 (APPENDBYTE.IP 10885 . 11108) (APPENDIDENTIFIER.IP 11110 . 12033) (
APPENDINT.IP 12035 . 12576) (APPENDINTEGER.IP 12578 . 13077) (APPENDLARGEVECTOR.IP 13079 . 14005) (
APPENDNUMBER.IP 14007 . 14418) (APPENDOP.IP 14420 . 14946) (APPENDRATIONAL.IP 14948 . 15391) (
APPENDSEQUENCEDESCRIPTOR.IP 15393 . 16487) (BYTESININT.IP 16489 . 16749) (TESTCOLOR 16751 . 17287)) (
17323 52764 (BEGINMASTER.IP 17333 . 17577) (BEGINPAGE.IP 17579 . 17911) (BEGINPREAMBLE.IP 17913 .
18257) (CONCAT.IP 18259 . 18492) (CONCATT.IP 18494 . 18729) (ENDMASTER.IP 18731 . 19166) (ENDPAGE.IP
19168 . 19515) (ENDPREAMBLE.IP 19517 . 20555) (FGET.IP 20557 . 20828) (FILLRECTANGLE.IP 20830 . 21659)
(FILLTRAJECTORY.IP 21661 . 22025) (FSET.IP 22027 . 22298) (GETFRAMEVAR.IP 22300 . 22705) (
INITIALIZEMASTER.IP 22707 . 23254) (INITIALIZECOLOR.IP 23256 . 24584) (ISET.IP 24586 . 25138) (
GETCP.IP 25140 . 25440) (LINETO.IP 25442 . 26039) (MASKSTROKE.IP 26041 . 26282) (MOVETO.IP 26284 .
26592) (ROTATE.IP 26594 . 26864) (SCALE.IP 26866 . 27137) (SCALE2.IP 27139 . 27447) (SETCOLOR.IP 27449
. 28659) (SETRGB.IP 28661 . 29803) (SETCOLORLV.IP 29805 . 35644) (SETCOLOR16.IP 35646 . 39635) (
SETFONT.IP 39637 . 40420) (SETSPACE.IP 40422 . 40702) (SETXREL.IP 40704 . 41426) (SETX.IP 41428 .
42780) (SETXY.IP 42782 . 43892) (SETXYREL.IP 43894 . 45024) (SETY.IP 45026 . 46302) (SETYREL.IP 46304
. 46664) (SHOW.IP 46666 . 51435) (TRAJECTORY.IP 51437 . 51925) (TRANS.IP 51927 . 52447) (TRANSLATE.IP
52449 . 52762)) (52791 148914 (DEFINEFONT.IP 52801 . 53781) (FONTNAME.IP 53783 . 55139) (HEADINGOP.IP
55141 . 57370) (INTERPRESS.BITMAPSCALE 57372 . 58020) (INTERPRESS.OUTCHARFN 58022 . 61714) (
INTERPRESSFILEP 61716 . 63714) (MAKEINTERPRESS 63716 . 64008) (NEWLINE.IP 64010 . 65040) (NEWPAGE.IP
65042 . 71453) (NEWPAGE?.IP 71455 . 72046) (OPENIPSTREAM 72048 . 77044) (SETUPFONTS.IP 77046 . 78413)
(SHOWBITMAP.IP 78415 . 85320) (\BITMAPSIZE.IP 85322 . 86229) (SHOWBITMAP1.IP 86231 . 93929) (
SHOWSHADE.IP 93931 . 94524) (\BITBLT.IP 94526 . 98602) (\SCALEDBITBLT.IP 98604 . 102378) (\BLTSHADE.IP
102380 . 103511) (\CHARWIDTH.IP 103513 . 104338) (\CLOSEIPSTREAM 104340 . 104754) (\DRAWCIRCLE.IP
104756 . 106055) (\DRAWARC.IP 106057 . 106616) (\DRAWCURVE.IP 106618 . 109591) (\DSPCOLOR.IP 109593 .
110815) (ENSURE.RGB 110817 . 111910) (\IPCURVE2 111912 . 125362) (\DRAWELLIPSE.IP 125364 . 127367) (
\DRAWLINE.IP 127369 . 129022) (\DSPBOTTOMMARGIN.IP 129024 . 129463) (\DSPFONT.IP 129465 . 133802) (
\DSPLEFTMARGIN.IP 133804 . 134295) (\DSPLINEFEED.IP 134297 . 135256) (\DSPRIGHTMARGIN.IP 135258 .
135752) (\DSPSPACEFACTOR.IP 135754 . 137157) (\DSPTOPMARGIN.IP 137159 . 137650) (\DSPXPOSITION.IP
137652 . 138773) (\DSPROTATE.IP 138775 . 139043) (\PUSHSTATE.IP 139045 . 139947) (\POPSTATE.IP 139949
. 140581) (\DEFAULTSTATE.IP 140583 . 140926) (\DSPTRANSLATE.IP 140928 . 141199) (\DSPSCALE2.IP 141201
. 141466) (\DSPYPOSITION.IP 141468 . 141861) (\FILLPOLYGON.IP 141863 . 142530) (\FIXLINELENGTH.IP
142532 . 143874) (\MOVETO.IP 143876 . 144374) (\SETBRUSH.IP 144376 . 145894) (\STRINGWIDTH.IP 145896
. 146674) (\DSPCLIPPINGREGION.IP 146676 . 147898) (\DSPOPERATION.IP 147900 . 148912)) (148939 150036
(IP-TOS 148949 . 149305) (POP-IP-STACK 149307 . 149734) (PUSH-IP-STACK 149736 . 150034)) (150097
167414 (\CREATECHARSET.IP 150107 . 166196) (\CHANGECHARSET.IP 166198 . 167412)) (167415 173480 (
\INTERPRESSINIT 167425 . 173478)) (173481 174131 (SCALEREGION 173491 . 174129)) (198351 201166 (
INTERPRESSBITMAP 198361 . 201164)) (203351 215535 (NSMAP 203361 . 204151) (\COERCEASCIITONSFONT 204153
. 210008) (\CREATEINTERPRESSFONT 210010 . 212332) (\SEARCHINTERPRESSFONTS 212334 . 215533)))))
STOP