(FILECREATED "14-Dec-84 09:04:25" {ERIS}<LISPNEW>SOURCES>PRESS.;13 257211Q
changes to: (FNS SETX.PRESS \PRESS.OUTCHARFN ENDVECRUN VECPUT \HACKBLTSHADE
\DRAWCURVE.PRESS.LINE)
(VARS PRESSCOMS)
previous date: " 3-Dec-84 17:59:12" {ERIS}<LISPNEW>SOURCES>PRESS.;6)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS [(FNS \HACKBLTSHADE)
(P (MOVD? (QUOTE \HACKBLTSHADE)
(QUOTE BLTSHADE)))
(COMS (FNS \SEARCHPRESSFONTS \GETPRESSFONTNAMES \PRESSFAMILYCODELST \DECODEPRESSFACEBYTE
\CREATEPRESSFONT)
(INITVARS (PRESSFONTWIDTHSFILES (QUOTE {ERIS}<LISP>FONTS>FONTS.WIDTHS)))
(DECLARE: DONTCOPY (CONSTANTS noInfoCode)))
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW WINDOW.BITMAP
\WRITEPRESSBITMAP)
(FNS \BCPLSOUT.PRESS \PAGEPAD.PRESS)
(FNS \ENTITYEND.PRESS \PARTEND.PRESS \ENTITYSTART.PRESS SETX.PRESS SETXY.PRESS SETY.PRESS
SHOW.PRESS)
(FNS OPENPRSTREAM \CLOSEF.PRESS \DRAWLINE.PRESS \ENDPAGE.PRESS NEWLINE.PRESS NEWPAGE.PRESS
SETUPFONTS.PRESS \DEFINEFONT.PRESS \DSPBOTTOMMARGIN.PRESS \DSPFONT.PRESS
\DSPLEFTMARGIN.PRESS \DSPLINEFEED.PRESS \DSPRIGHTMARGIN.PRESS \DSPTOPMARGIN.PRESS
\DSPXPOSITION.PRESS \DSPYPOSITION.PRESS \FIXLINELENGTH.PRESS \PRESS.OUTCHARFN
\STARTPAGE.PRESS SHOWRECTANGLE.PRESS)
[COMS (* Drawcurve code)
(FNS ENDVECRUN VECENCODE VECPUT VECSKIP VECFONTINIT \DRAWCIRCLE.PRESS \DRAWCURVE.PRESS
\DRAWCURVE.PRESS.LINE \DRAWELLIPSE.PRESS \GETBRUSHFONT.PRESS \PRESSCURVE2)
(INITVARS (\VecFontDir))
(CONSTANTS (\MicasPerInch 2540))
(DECLARE: DONTCOPY (CONSTANTS (ScansPerIn 384)
(PointsPerIn 72.27)
(MicasPerScan (FQUOTIENT \MicasPerInch ScansPerIn))
(ScansPerMica (FQUOTIENT ScansPerIn \MicasPerInch))
(ScansPerPoint (FQUOTIENT ScansPerIn PointsPerIn))
(PointsPerScan (FQUOTIENT PointsPerIn ScansPerIn))
(MicasPerPoint (FQUOTIENT \MicasPerInch PointsPerIn))
(PointsPerMica (FQUOTIENT PointsPerIn \MicasPerInch))
(SPRUCEPAPERTOPSCANS 4096)
(SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES
SPRUCEPAPERTOPSCANS
\MicasPerInch)
ScansPerIn)))
(SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch)))
(SPRUCEPAPERRIGHTSCANS (FIX (FTIMES 8.5 ScansPerIn]
(FNS \PRESSINIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\PRESSINIT)))
(DECLARE: DONTCOPY (RECORDS PRESSDATA FONTDIRENTRY))
(INITRECORDS PRESSDATA)
[INITVARS (DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765))
(PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
(TIMES 10 \MicasPerInch]
(GLOBALVARS DEFAULTPAGEREGION)
(DECLARE: DONTCOPY (CONSTANTS (BYTESPERRECORD 512)
(LISPENTITYTYPE 6)
(MICASPERINCH \MicasPerInch))
(E (RESETSAVE (RADIX 8)))
(CONSTANTS * PRESSOPS))
(COMS (FNS MAKEPRESS PRESSFILEP PRESS.BITMAPSCALE millsToMicas)
[INITVARS (PRESSTABSTOPS (QUOTE (8000]
(ALISTS (IMAGESTREAMTYPES PRESS))
(ADDVARS [PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION
ROTATION TITLE)))
((FULLPRESS RAVEN)
(* same as PRESS but can scale bitmaps)
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION
ROTATION TITLE]
(PRINTFILETYPES (PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT
(LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM
FILE))
(TEDIT.FORMAT.HARDCOPY
FILE PFILE T NIL NIL NIL
(QUOTE PRESS))
(CLOSEF? FILE)
PFILE])
(DEFINEQ
(\HACKBLTSHADE
[LAMBDA (TEXTURE DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION
CLIPPINGREGION) (* rmk: "13-Dec-84 17:22")
(BITBLT NIL NIL NIL DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
OPERATION TEXTURE CLIPPINGREGION])
)
(MOVD? (QUOTE \HACKBLTSHADE)
(QUOTE BLTSHADE))
(DEFINEQ
(\SEARCHPRESSFONTS
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE) (* rrb "26-Sep-84 16:35")
(* * returns a list of the form (family size face rotation PRESS) for any font matching the specs.
* is used as wildcard.)
(DECLARE (GLOBALVARS PRESSFONTWIDTHSFILES))
(RESETLST (bind FONTSFOUND WSTRM for F inside PRESSFONTWIDTHSFILES when (INFILEP F)
do [COND
((SETQ WSTRM (\GETSTREAM F (QUOTE INPUT)
T))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
WSTRM
(GETFILEPTR WSTRM)))
(SETFILEPTR WSTRM 0))
(T (RESETSAVE (SETQ WSTRM (OPENSTREAM F (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(SETQ FONTSFOUND (UNION (\GETPRESSFONTNAMES WSTRM FAMILY PSIZE FACE ROTATION)
FONTSFOUND))
finally (RETURN FONTSFOUND])
(\GETPRESSFONTNAMES
[LAMBDA (WSTRM FAMILY PSIZE FACE ROTATION) (* rrb "26-Sep-84 17:56")
(* finds the fonts that exist that match the args.
* is used as wildcard.)
(bind FONTSFOUND TYPE XFACE XFAMILY XSIZE XFACE XROTATION
[XFACECODE ←(COND
((AND (LISTP FACE)
(NOT (MEMB (QUOTE *)
FACE))) (* if complete face is specified, compute code so don't
have to on each font.)
(\FACECODE FACE]
(FAMILYCODELST ←(\PRESSFAMILYCODELST WSTRM))
(NEXT ← 0)
do (SETFILEPTR WSTRM NEXT)
(SETQ TYPE (\BIN WSTRM))
(add NEXT (LLSH (IPLUS (\BIN WSTRM)
(LLSH (LOGAND TYPE 15)
8))
1))
(SELECTQ (LRSH TYPE 4)
[4 (SETQ XFAMILY (OR (CDR (FASSOC (\BIN WSTRM)
FAMILYCODELST))
(ERROR "unknown code number in widths file")))
(COND
((OR (EQ FAMILY (QUOTE *))
(EQ FAMILY XFAMILY))
(COND
([AND (ILESSP (SETQ XFACE (\BIN WSTRM))
18)
(COND
(XFACECODE (AND (EQ XFACECODE XFACE)
(SETQ XFACE FACE)))
((PROGN (SETQ XFACE (\DECODEPRESSFACEBYTE XFACE))
(OR (EQ FACE (QUOTE *))
(EQUAL FACE XFACE)
(for SPEC in FACE as XFIELD in XFACE
always (OR (EQ SPEC XFIELD)
(EQ SPEC (QUOTE *]
(* greater than 18 means either ASCII or other type of
font, ignore it.)
(* skip beg and end chars)
(\BIN WSTRM)
(\BIN WSTRM)
(SETQ XSIZE (FIXR (FQUOTIENT (\WIN WSTRM)
MICASPERPT)))
(COND
((OR (EQ PSIZE (QUOTE *))
(EQUAL PSIZE XSIZE)
(AND (EQUAL XSIZE 0)
(SETQ XSIZE PSIZE)))
(* if XSIZE is 0, the font widths are relative and are to be used for all font sizes. In this case, if the user
asked about a particular size, claim that it is there.)
(SETQ XROTATION (\WIN WSTRM))
(COND
((OR (EQ ROTATION (QUOTE *))
(EQ XROTATION ROTATION))
(push FONTSFOUND (LIST XFAMILY XSIZE XFACE XROTATION
(QUOTE PRESS]
(0 (RETURN FONTSFOUND))
NIL])
(\PRESSFAMILYCODELST
[LAMBDA (WSTRM) (* rrb "26-Sep-84 09:55")
(* returns an ALIST of code -
family pairs from the press font widths file WSTRM.)
(* leaving the file positioned at the beginning of the
next file entry.)
(bind PAIRS TYPE (NEXT ← 0)
do (SETFILEPTR WSTRM NEXT)
(SETQ TYPE (\BIN WSTRM))
(add NEXT (LLSH (IPLUS (\BIN WSTRM)
(LLSH (LOGAND TYPE 15)
8))
1))
(SELECTQ (LRSH TYPE 4)
(1 (SETQ PAIRS (CONS [CONS (\WIN WSTRM)
(PACKC (for I from 1 to (\BIN WSTRM)
collect (\BIN WSTRM]
PAIRS)))
(0 (RETURN PAIRS))
NIL])
(\DECODEPRESSFACEBYTE
[LAMBDA (FACECODE) (* rrb "26-Sep-84 14:28")
(* * returns a list of (weight slope expansion) from a press widths file byte code.)
(COND
[(ILESSP FACECODE 18)
(PROG (EXP SLOPE WEIGHT)
[SETQ EXP (COND
((IGEQ FACECODE 12)
(SETQ FACECODE (IDIFFERENCE FACECODE 12))
(QUOTE EXPANDED))
((IGEQ FACECODE 6)
(SETQ FACECODE (IDIFFERENCE FACECODE 6))
(QUOTE COMPRESSED))
(T (QUOTE REGULAR]
[SETQ WEIGHT (COND
((IGEQ FACECODE 4)
(SETQ FACECODE (IDIFFERENCE FACECODE 4))
(QUOTE LIGHT))
((IGEQ FACECODE 2)
(SETQ FACECODE (IDIFFERENCE FACECODE 2))
(QUOTE BOLD))
(T (QUOTE MEDIUM]
[SETQ SLOPE (COND
((EQ FACECODE 1)
(QUOTE ITALIC))
(T (QUOTE REGULAR]
(RETURN (LIST WEIGHT SLOPE EXP]
(T (* non xerox font)
NIL])
(\CREATEPRESSFONT
[LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE) (* rmk: " 3-Dec-84 17:59")
(* 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 PRESSFONTWIDTHSFILES))
(RESETLST (* RESETLST to make sure the fontfiles get closed)
(PROG (WSTRM STRMCACHE XLATEDFAM FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHSY
(WIDTHS (ARRAY (ADD1 \MAXCHAR)
(QUOTE SMALLPOSP)
0 0))
(PRESSMICASIZE (IQUOTIENT (ITIMES PSIZE 2540)
72))
(NSMICASIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
72)))
(FD (create FONTDESCRIPTOR
FONTDEVICE ← DEVICE
FONTFAMILY ← FAMILY
FONTSIZE ← PSIZE
FONTFACE ← FACE
\SFFACECODE ←(\FACECODE FACE)
ROTATION ← ROTATION)))
(* The PRESS world and the NS world disagree on whether to truncate or round when converting from points to micas.
Hence the different values PRESSMICASIZE and NSMICASIZE.)
(OR [for F inside PRESSFONTWIDTHSFILES when (INFILEP F)
do (* Look thru the candidate PRESSFONTWIDTHSFILES for a
file that has a description for this font.)
[COND
[(SETQ WSTRM (\GETSTREAM F (QUOTE INPUT)
T))
(COND
((RANDACCESSP WSTRM)
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
WSTRM
(GETFILEPTR WSTRM)))
(SETFILEPTR WSTRM 0]
(T (RESETSAVE (SETQ WSTRM (OPENSTREAM F (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[OR (RANDACCESSP WSTRM)
(COPYBYTES WSTRM (SETQ WSTRM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(push STRMCACHE WSTRM) (* Save for coercions below)
(COND
((SETQ RELFLAG (\FINDFONT FD WSTRM PRESSMICASIZE NSMICASIZE))
(* OK, we found this font described in this file.)
(RETURN T]
[AND (SETQ XLATEDFAM (SELECTQ FAMILY
(MODERN (QUOTE HELVETICA))
(CLASSIC (QUOTE TIMESROMAN))
(LOGOTYPE (QUOTE LOGO))
(TERMINAL (QUOTE GACHA))
NIL))
(for old WSTRM in (SETQ STRMCACHE (DREVERSE STRMCACHE))
first (replace FONTFAMILY of FD with XLATEDFAM)
do (* Now try coercing the family name)
(* We know the file was left open and is randaccessp from the previous loop, which must have run off the end of the
file list)
(SETFILEPTR WSTRM 0)
(COND
((SETQ RELFLAG (\FINDFONT FD WSTRM PRESSMICASIZE NSMICASIZE))
(replace FONTDEVICESPEC of FD
with (LIST XLATEDFAM PSIZE FACE ROTATION DEVICE))
(replace FONTFAMILY of FD with FAMILY)
(RETURN T]
[AND (SETQ XLATEDFAM (SELECTQ FAMILY
(MODERN (QUOTE FRUTIGER))
(CLASSIC (QUOTE CENTURY))
NIL))
(for old WSTRM in STRMCACHE first (replace FONTFAMILY of FD
with XLATEDFAM)
do (SETFILEPTR WSTRM 0)
(COND
((SETQ RELFLAG (\FINDFONT FD WSTRM PRESSMICASIZE NSMICASIZE))
(replace FONTDEVICESPEC of FD
with (LIST XLATEDFAM PSIZE FACE ROTATION DEVICE))
(replace FONTFAMILY of FD with FAMILY)
(RETURN T]
(RETURN NIL))
(SETQ RELFLAG (ZEROP RELFLAG)) (* Actually, \FINDFONT returns zero if the font metrics
are size-relative and must be scaled.)
(SETFILEPTR WSTRM (UNFOLD (\FIXPIN WSTRM)
BYTESPERWORD))
(* Locate the segment)
(replace FBBOX of FD with (SIGNED (\WIN WSTRM)
BITSPERWORD))
(replace \SFDescent of FD with (IMINUS (SIGNED (\WIN WSTRM)
BITSPERWORD)))
(* Descent is -FBBOY)
(replace FBBDX of FD with (SIGNED (\WIN WSTRM)
BITSPERWORD))
(replace \SFHeight of FD with (SIGNED (\WIN WSTRM)
BITSPERWORD))
(* Height is FBBDY)
(replace \SFWidths of FD with WIDTHS)
(SETQ FIRSTCHAR (fetch FIRSTCHAR of FD))
(SETQ LASTCHAR (fetch LASTCHAR of FD))
[COND
(RELFLAG (* Dimensions are relative, must be scaled)
(replace FBBOX of FD with (IQUOTIENT (ITIMES (fetch FBBOX
of FD)
PRESSMICASIZE)
1000))
(replace \SFDescent of FD with (IQUOTIENT (ITIMES (fetch \SFDescent
of FD)
PRESSMICASIZE)
1000))
(replace FBBDX of FD with (IQUOTIENT (ITIMES (fetch FBBDX
of FD)
PRESSMICASIZE)
1000))
(replace \SFHeight of FD with (IQUOTIENT (ITIMES (fetch \SFHeight
of FD)
PRESSMICASIZE)
1000]
(replace \SFAscent of FD with (IDIFFERENCE (fetch \SFHeight of FD)
(fetch \SFDescent of FD)))
(SETQ FIXEDFLAGS (LRSH (\BIN WSTRM)
6)) (* The fixed flags)
(\BIN WSTRM) (* Skip the spares)
[COND
((EQ 2 (LOGAND FIXEDFLAGS 2))
(SETQ TEM (\WIN WSTRM)) (* The fixed width for this font)
[COND
((AND RELFLAG (NOT (ZEROP TEM)))
(SETQ TEM (IQUOTIENT (ITIMES TEM PRESSMICASIZE)
1000]
(for I from FIRSTCHAR to LASTCHAR do (SETA WIDTHS I TEM)))
(T (AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
WSTRM)
(for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode (ELT WIDTHS I))
do (SETA WIDTHS I 0))
(COND
(RELFLAG (for I from FIRSTCHAR to LASTCHAR
do (SETA WIDTHS I (IQUOTIENT (ITIMES (ELT WIDTHS I)
PRESSMICASIZE)
1000]
[COND
[(EQ 1 (LOGAND FIXEDFLAGS 1))
(SETQ WIDTHSY (\WIN WSTRM)) (* The fixed width-Y for this font;
the width-Y field is a single integer in the FD)
(replace \SFWidthsY of FD with (COND
((AND RELFLAG (NOT (ZEROP WIDTHSY)))
(IQUOTIENT (ITIMES WIDTHSY PRESSMICASIZE)
1000))
(T WIDTHSY]
(T (replace \SFWidthsY of FD with (SETQ WIDTHSY (ARRAY (ADD1 \MAXCHAR)
(QUOTE SMALLPOSP)
0 0)))
(AIN WIDTHSY FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
WSTRM)
(for I from FIRSTCHAR to LASTCHAR when (EQ noInfoCode (ELT WIDTHSY I))
do (SETA WIDTHSY I 0))
(COND
(RELFLAG (for I from FIRSTCHAR to LASTCHAR
do (SETA WIDTHSY I (IQUOTIENT (ITIMES (ELT WIDTHSY I)
PRESSMICASIZE)
1000]
(RETURN FD])
)
(RPAQ? PRESSFONTWIDTHSFILES (QUOTE {ERIS}<LISP>FONTS>FONTS.WIDTHS))
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ noInfoCode 32768)
(CONSTANTS noInfoCode)
)
)
(DEFINEQ
(PRESSBITMAP
[LAMBDA (FILE BITMAP SCALEFACTOR CLIPPINGREGION) (* gbn "16-Sep-84 18:44")
(* * This routine uses the whole page (ie PRTOP and PRRIGHT as opposed to PRWIDTH and PRHEIGHT) to produce a SPRUCE
Press file. It will truncate if necessary since SPRUCE does not support scaling)
(PROG ((PRSTREAM (OPENPRSTREAM FILE))
WIDTH HEIGHT PRDATA XPOS YPOS (PRESSPAGEHEIGHT (fetch HEIGHT of PRESSBITMAPREGION))
(PRESSPAGEWIDTH (fetch WIDTH of PRESSBITMAPREGION)))
(SETQ PRDATA (fetch IMAGEDATA of PRSTREAM))
(if (AND SCALEFACTOR (NOT (EQUAL SCALEFACTOR 1)))
then (ERROR "Spruce cannot scale bitmaps. Try pressing to a full press printer."))
(* Get width and height in screen pts)
[COND
(CLIPPINGREGION (SETQ WIDTH (fetch WIDTH of CLIPPINGREGION))
(SETQ HEIGHT (fetch HEIGHT of CLIPPINGREGION)))
(T (SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP]
(SETQ XPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEWIDTH (FIX (TIMES MicasPerPoint WIDTH)))
2))
(SETQ YPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEHEIGHT (FIX (TIMES MicasPerPoint HEIGHT)))
2))
[COND
((OR (ILESSP XPOS 0)
(ILESSP YPOS 0))
(printout T "Warning: Bitmap too large for Spruce PRESS page, will be clipped..." T)
(SETQ XPOS (IMAX 0 XPOS))
(SETQ YPOS (IMAX 0 YPOS))
(SETQ CLIPPINGREGION (if CLIPPINGREGION
then [CREATEREGION (fetch LEFT of CLIPPINGREGION)
(fetch BOTTOM of CLIPPINGREGION)
(FIX (MIN WIDTH (QUOTIENT PRESSPAGEWIDTH
MicasPerPoint)))
(FIX (MIN HEIGHT (QUOTIENT PRESSPAGEHEIGHT
MicasPerPoint]
else (CREATEREGION 0 0 (FIX (MIN WIDTH (QUOTIENT PRESSPAGEWIDTH
MicasPerPoint)))
(FIX (MIN HEIGHT (QUOTIENT PRESSPAGEHEIGHT
MicasPerPoint]
(\WRITEPRESSBITMAP BITMAP (IPLUS (fetch LEFT of PRESSBITMAPREGION)
XPOS)
(IPLUS (fetch BOTTOM of PRESSBITMAPREGION)
YPOS)
SCALEFACTOR CLIPPINGREGION PRSTREAM)
(RETURN (CLOSEF PRSTREAM])
(FULLPRESSBITMAP
[LAMBDA (FILE BITMAP SCALEFACTOR CLIPPINGREGION) (* gbn "16-Sep-84 18:51")
(* * This routine uses the whole page (ie PRTOP and PRRIGHT as opposed to PRWIDTH and PRHEIGHT) to produce a full
Press file. It will scale if necessary)
(* * When this fn is called from HARDCOPYW, the scalefactor should already be correct. On a direct call, it will
handle it itself)
(PROG ((PRSTREAM (OPENPRSTREAM FILE))
WIDTH HEIGHT PRDATA XPOS YPOS (PRESSPAGEHEIGHT (fetch HEIGHT of PRESSBITMAPREGION))
(PRESSPAGEWIDTH (fetch WIDTH of PRESSBITMAPREGION)))
(SETQ PRDATA (fetch IMAGEDATA of PRSTREAM))
(if (NOT SCALEFACTOR)
then (SETQ SCALEFACTOR 1.0)) (* Get width and height in screen pts)
[COND
(CLIPPINGREGION (SETQ WIDTH (fetch WIDTH of CLIPPINGREGION))
(SETQ HEIGHT (fetch HEIGHT of CLIPPINGREGION)))
(T (SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP]
(SETQ XPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEWIDTH (FIX (TIMES MicasPerPoint WIDTH
SCALEFACTOR)))
2))
(SETQ YPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEHEIGHT (FIX (TIMES MicasPerPoint HEIGHT
SCALEFACTOR)))
2))
[COND
((OR (ILESSP XPOS 0)
(ILESSP YPOS 0))
(printout T "Warning: Bitmap too large for PRESS page, will be scaled..." T)
(SETQ SCALEFACTOR (PRESS.BITMAPSCALE WIDTH HEIGHT))
(SETQ XPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEWIDTH (FIX (TIMES MicasPerPoint WIDTH
SCALEFACTOR)))
2))
(SETQ YPOS (IQUOTIENT (IDIFFERENCE PRESSPAGEHEIGHT (FIX (TIMES MicasPerPoint HEIGHT
SCALEFACTOR)))
2))
(if (OR (ILESSP XPOS 0)
(ILESSP YPOS 0))
then (ERROR "Internal consistency check failed in FULLPRESSBITMAP."]
(\WRITEPRESSBITMAP BITMAP (IPLUS (fetch LEFT of PRESSBITMAPREGION)
XPOS)
(IPLUS (fetch BOTTOM of PRESSBITMAPREGION)
YPOS)
SCALEFACTOR CLIPPINGREGION PRSTREAM)
(RETURN (CLOSEF PRSTREAM])
(SHOWREGION
[LAMBDA (REGION STREAM) (* gbn "16-Sep-84 19:14")
(* * comment)
(PROG NIL
(MOVETO (fetch LEFT of REGION)
(fetch BOTTOM of REGION)
STREAM)
(RELDRAWTO (fetch WIDTH of REGION)
0 NIL NIL STREAM)
(RELDRAWTO 0 (fetch HEIGHT of REGION)
NIL NIL STREAM)
(RELDRAWTO (MINUS (fetch WIDTH of REGION))
0 NIL NIL STREAM)
(RELDRAWTO 0 (MINUS (fetch HEIGHT of REGION))
NIL NIL STREAM)
(RETURN STREAM])
(SHOWPRESSBITMAPREGION
[LAMBDA NIL (* gbn "16-Sep-84 19:18")
(* * comment)
(PROG [(STR (OPENIMAGESTREAM (QUOTE {LPT})
(QUOTE PRESS]
(SHOWREGION PRESSBITMAPREGION STR)
(RETURN (CLOSEF STR])
(PRESSWINDOW
[LAMBDA (W) (* rmk: " 7-Sep-84 14:18")
(* First Try)
(PROG ((PRSTREAM (OPENPRSTREAM (QUOTE {CORE}WINDOW.PRESS)
(LIST (QUOTE HEADING)
"Press Stream Window Image"
(QUOTE BREAKPAGEFILENAME)
"Press Stream Window Image")))
[BITMAP (WINDOW.BITMAP (OR W (WHICHW]
WIDTH HEIGHT (PTSTOMICAS 35))
(SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
(DSPXPOSITION (IPLUS (fetch PRLEFT of (fetch IMAGEDATA of PRSTREAM))
(IQUOTIENT (IDIFFERENCE (fetch PRWIDTH of (fetch IMAGEDATA
of PRSTREAM))
(ITIMES PTSTOMICAS WIDTH))
2))
PRSTREAM)
(DSPYPOSITION (IPLUS (fetch PRBOTTOM of (fetch IMAGEDATA of PRSTREAM))
(IQUOTIENT (IDIFFERENCE (fetch PRHEIGHT of (fetch IMAGEDATA
of PRSTREAM))
(ITIMES PTSTOMICAS HEIGHT))
2))
PRSTREAM)
(\WRITEPRESSBITMAP BITMAP NIL NIL PRSTREAM)
(RETURN (CLOSEF PRSTREAM])
(WINDOW.BITMAP
[LAMBDA (W) (* rmk: "19-Jun-84 01:57")
(* Returns all of the bitmap of the window)
(PROG [BM (REGION (WINDOWPROP W (QUOTE REGION]
(CLOSEW W)
(SETQ BM (BITMAPCREATE (fetch WIDTH of REGION)
(fetch HEIGHT of REGION)))
(BITBLT (WINDOWPROP W (QUOTE IMAGECOVERED))
NIL NIL BM)
(OPENW W)
(RETURN BM])
(\WRITEPRESSBITMAP
[LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM)
(* gbn "16-Sep-84 15:42")
(* This should define the origin of the bitmap on the
page)
[COND
(CLIPPINGREGION (* UGH)
(SETQ BITMAP (PROG [(BM (BITMAPCREATE (fetch WIDTH of CLIPPINGREGION)
(fetch HEIGHT of CLIPPINGREGION]
(with REGION CLIPPINGREGION
(BITBLT BITMAP LEFT BOTTOM BM NIL NIL WIDTH HEIGHT))
(RETURN BM]
(PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM))
(WW (fetch BITMAPRASTERWIDTH of BITMAP))
(HT (fetch BITMAPHEIGHT of BITMAP))
ELSTREAM TOTCOUNT CURX CURY)
(SETQ ELSTREAM (fetch ELSTREAM of PRDATA))
(SETQ CURX (fetch PRXPOS of PRDATA))
(SETQ CURY (fetch PRYPOS of PRDATA))
(SHOW.PRESS PRSTREAM) (* flush chars before ending entity)
(\ENTITYEND.PRESS PRSTREAM)
(* Close previous entity because we used to specify a translation for the bitmap entity. But now we are using the
current x and y position. All this stuff might therefore be unnecessary)
(\ENTITYSTART.PRESS PRSTREAM)
(SETXY.PRESS PRSTREAM XPOS YPOS)
(COND
((NULL SCALEFACTOR)
(SETQ SCALEFACTOR 1.0)))
(\WOUT PRSTREAM 256) (* Output <<Set-Coding>>. (0 notates bitmap, followed
by 2byte width (in dots) and height
(in dots)))
(\WOUT PRSTREAM (UNFOLD WW BITSPERWORD)) (* Width)
(\WOUT PRSTREAM HT) (* Height)
(\WOUT PRSTREAM (IPLUS 512 3)) (* <<Set-Mode>> notates that the Lisp bitmap is stored
left-to-right and top-to-bottom)
(\WOUT PRSTREAM 2) (* set size in micas of final image on paper, 2byte
width and height)
[\WOUT PRSTREAM (FIX (FTIMES SCALEFACTOR (ITIMES 32 (UNFOLD WW BITSPERWORD]
[\WOUT PRSTREAM (FIX (FTIMES SCALEFACTOR (ITIMES 32 HT]
(\WOUT PRSTREAM 1)
(* Set Window. 2 bytes of how many bytes to skip, 2 bytes of how many dots wide to display followed by the same for
lines)
(\WOUT PRSTREAM 0) (* skip 0 dots)
(\WOUT PRSTREAM (UNFOLD WW BITSPERWORD))
(\WOUT PRSTREAM 0) (* skip 0 lines)
(\WOUT PRSTREAM HT)
(\WOUT PRSTREAM 3) (* <<Dots-Follow>>)
(* TOTCOUNT is a word count.)
(\BOUTS PRSTREAM (fetch BITMAPBASE of BITMAP)
0
(UNFOLD (SETQ TOTCOUNT (ITIMES HT WW))
BYTESPERWORD))
(\BOUT ELSTREAM ShowDotsCode)
(\FIXPOUT ELSTREAM (IPLUS TOTCOUNT 13)) (* Number of DL bytes)
(\ENTITYEND.PRESS PRSTREAM)
(\ENTITYSTART.PRESS PRSTREAM) (* Since START reestablishes X and Y, following might
not be necessary)
(SETXY.PRESS PRSTREAM CURX CURY])
)
(DEFINEQ
(\BCPLSOUT.PRESS
[LAMBDA (STRM X N) (* rmk: "14-Jun-84 19:36")
(* Puts out a Bcpl string X in N bytes, filling with
zeroes or truncating if needed.)
(PROG [(NC (IMIN (NCHARS X)
(SETQ N (SUB1 N]
(\BOUT STRM NC)
(for I from 1 to NC do (\BOUT STRM (NTHCHARCODE X I)))
(for I from (ADD1 NC) to N do (\BOUT STRM 0])
(\PAGEPAD.PRESS
[LAMBDA (STRM) (* rmk: "14-Jun-84 18:30")
(* Move the fileptr to the next record boundary,
returning the number of words skipped.)
(PROG (PADDING (P (GETFILEPTR STRM)))
(SETQ PADDING (MODUP P BYTESPERRECORD))
(COND
((IGREATERP PADDING 0) (* SETFILEPTR for all but 1, then \BOUT to make sure the
file gets extended.)
[AND (NEQ PADDING 1)
(SETFILEPTR STRM (IPLUS P (SUB1 PADDING]
(\BOUT STRM 0)))
(RETURN (FOLDLO PADDING BYTESPERWORD])
)
(DEFINEQ
(\ENTITYEND.PRESS
[LAMBDA (PRSTREAM XOFFSET YOFFSET ETYPE) (* rmk: "23-Aug-84 21:56")
(PROG (ELSTREAM DLLENGTH (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(SETQ ELSTREAM (fetch ELSTREAM of PRDATA))
(SETQ DLLENGTH (IDIFFERENCE (\GETFILEPTR PRSTREAM)
(fetch DLSTARTBYTE of PRDATA)))
(COND
((ODDP (GETFILEPTR ELSTREAM))
(\BOUT ELSTREAM NopCode)))
(\BOUT ELSTREAM (OR ETYPE LISPENTITYTYPE))
(\BOUT ELSTREAM (OR (fetch FONTSET# of (fetch PRCURRFDE of PRDATA))
0)) (* fontset)
(\FIXPOUT ELSTREAM (IDIFFERENCE (fetch DLSTARTBYTE of PRDATA)
(UNFOLD (fetch PRPARTSTART of PRDATA)
BYTESPERRECORD)))
(* (IDIFFERENCE (fetch DLSTARTBYTE of PRDATA)
(UNFOLD (fetch PRPARTSTART of PRDATA) BYTESPERRECORD)))
(* part relative start of data list for this entity)
(\FIXPOUT ELSTREAM DLLENGTH) (* length of data)
(\WOUT ELSTREAM (OR XOFFSET 0)) (* Entity origin)
(\WOUT ELSTREAM (OR YOFFSET 0))
(\WOUT ELSTREAM (fetch PRLEFT of PRDATA)) (* The bounding box for this entity -
MAYBE LEFT AND BOTTOM ARE SIGNED?)
(\WOUT ELSTREAM (fetch PRBOTTOM of PRDATA))
(\WOUT ELSTREAM (IDIFFERENCE (fetch PRRIGHT of PRDATA)
(fetch PRLEFT of PRDATA)))
(* width)
(\WOUT ELSTREAM (IDIFFERENCE (fetch PRTOP of PRDATA)
(fetch PRBOTTOM of PRDATA)))
(* height)
(\WOUT ELSTREAM (ADD1 (FOLDLO (IDIFFERENCE (GETFILEPTR ELSTREAM)
(fetch ELSTARTBYTE of PRDATA))
BYTESPERWORD))) (* Length in words--ADD1 for the length itself)
])
(\PARTEND.PRESS
[LAMBDA (PRSTREAM PARTTYPE) (* rmk: "20-Jun-84 11:16")
(* Closes one part and sets up for the next, by saving
the partstart and emptying the entitylist stream)
(PROG (START PDSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(SETQ PDSTREAM (fetch PDSTREAM of PRDATA))
(SETQ START (fetch PRPARTSTART of PRDATA))
(\WOUT PDSTREAM PARTTYPE)
(\WOUT PDSTREAM START) (* Starting record)
(* Update starting record for next part, and record
length in records of this part)
(\WOUT PDSTREAM (IDIFFERENCE (replace PRPARTSTART of PRDATA with (FOLDHI (GETFILEPTR
PRSTREAM)
BYTESPERRECORD))
START))
(\WOUT PDSTREAM (\PAGEPAD.PRESS PRSTREAM))
(SETFILEPTR (fetch ELSTREAM of PRDATA)
0])
(\ENTITYSTART.PRESS
[LAMBDA (PRSTREAM) (* rmk: "14-Aug-84 14:44")
(PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM)))
(replace PRFONT of PRDATA with NIL)
(* We set the font to NIL, knowing that the current font can be recoverd from the PRCURRFDE.
This font will be set in the press file before the first show, if no explicit dspfont intervenes.
Note, however, that up until the first dspfont, the widthscache still corresponds to what was the PRFONT.)
(replace DLSTARTBYTE of PRDATA with (\GETFILEPTR PRSTREAM))
(replace ELSTARTBYTE of PRDATA with (\GETFILEPTR (fetch ELSTREAM of PRDATA)))
(replace STARTCHARBYTE of PRDATA with (\GETFILEPTR PRSTREAM))
(* Entity starts with position at 0,0 so must
re-establish current position
(?))
(SETXY.PRESS PRSTREAM (fetch PRXPOS of PRDATA)
(fetch PRYPOS of PRDATA])
(SETX.PRESS
[LAMBDA (PRSTREAM X) (* rmk: "14-Dec-84 08:55")
(PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
(COND
((AND (IGEQ X 0)
(ILEQ X SPRUCEPAPERRIGHTMICAS))
(\BOUT ELSTREAM SetXCode) (* Outcharfn ignores characters as long as XPOS is
negative)
(\WOUT ELSTREAM X)))
(replace PRXPOS of (fetch IMAGEDATA of PRSTREAM) with X])
(SETXY.PRESS
[LAMBDA (PRSTREAM X Y) (* rmk: "28-Sep-84 17:33")
(PROG (ELSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(SETQ ELSTREAM (fetch ELSTREAM of PRDATA))
(COND
((AND (IGEQ X 0)
(ILEQ X 65535))
(\BOUT ELSTREAM SetXCode)
(\WOUT ELSTREAM X)))
(replace PRXPOS of PRDATA with X)
(COND
((AND (IGEQ Y 0)
(ILEQ Y 65535))
(\BOUT ELSTREAM SetYCode)
(\WOUT ELSTREAM Y)))
(RETURN (replace PRYPOS of PRDATA with Y])
(SETY.PRESS
[LAMBDA (PRSTREAM Y) (* rmk: "28-Sep-84 17:33")
(PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
(COND
((AND (IGEQ Y 0)
(ILEQ Y 65535))
(\BOUT ELSTREAM SetYCode) (* Outcharfn ignores characters as long as YPOS is
negative)
(\WOUT ELSTREAM Y)))
(replace PRYPOS of (fetch IMAGEDATA of PRSTREAM) with Y])
(SHOW.PRESS
[LAMBDA (PRSTREAM) (* rmk: "28-Jun-84 15:16")
(PROG (CNT ELSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM))
(CURBYTE (\GETFILEPTR PRSTREAM)))
(SETQ ELSTREAM (fetch ELSTREAM of PRDATA))
(SETQ CNT (IDIFFERENCE CURBYTE (fetch STARTCHARBYTE of PRDATA)))
[COND
((IGREATERP CNT 0)
[COND
((NULL (fetch PRFONT of PRDATA))
(* This is the first run of characters in this entity, and there has been no explicit dspfont.
We therefore re-establish the current font as of the end of the last entity)
(replace PRFONT of PRDATA with (fetch DESCR of (fetch PRCURRFDE of PRDATA)))
(\BOUT (fetch ELSTREAM of PRDATA)
(LOGOR FontCode (fetch (FONTDIRENTRY FONT#) of (fetch PRCURRFDE
of PRDATA]
(COND
((ILESSP CNT 33) (* short form)
(\BOUT ELSTREAM (IPLUS ShowCharactersShortCode CNT -1)))
(T (* Break up every 255)
(while (IGREATERP CNT 255)
do (\BOUT ELSTREAM ShowCharactersCode)
(\BOUT ELSTREAM 255)
(SETQ CNT (IDIFFERENCE CNT 255))
finally (\BOUT ELSTREAM ShowCharactersCode)
(\BOUT ELSTREAM CNT]
(replace STARTCHARBYTE of PRDATA with CURBYTE])
)
(DEFINEQ
(OPENPRSTREAM
[LAMBDA (PRFILE OPTIONS) (* rmk: "13-Sep-84 09:04")
(* Opens a Press stream, to which user can do OUTCHAR. OPTIONS can include a REGION, HEADING, BREAKPAGEFILENAME,
and FONTS. FONTS is a list of fonts to be set up initially. Headings will be printed in the first font in FONTS.
If FONTS is NIL, then the stream is initialized with the PRESS DEFAULTFONT)
(DECLARE (GLOBALVARS DEFAULTPAGEREGION \PRESSIMAGEOPS))
(PROG [OPT PRDATA (PRSTREAM (OPENSTREAM PRFILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
[SETQ PRDATA (create PRESSDATA
PRPAGEREGION ←(COND
([type? REGION (SETQ OPT (LISTGET OPTIONS (QUOTE REGION]
OPT)
(T DEFAULTPAGEREGION))
PDSTREAM ←(PROG1 (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW))
(* Make sure the fileptr of the following is zero
(GETRESOURCE \PRESSPDSTREAM)
(and free this in \CLOSE.PRESS))
)
ELSTREAM ←(PROG1 (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW))
(* Make sure the fileptr of the following is zero
(GETRESOURCE \PRESSELSTREAM)
(and free this in \CLOSE.PRESS))
)
PRBREAKPAGEFILENAME ←(LISTGET OPTIONS (QUOTE BREAKPAGEFILENAME]
(COND
((OR (NEQ \NOIMAGEOPS (fetch (STREAM IMAGEOPS) of PRSTREAM))
(NEQ 0 (GETEOFPTR PRSTREAM)))
(ERROR "can't convert existing file to Press" (FULLNAME PRSTREAM))
(* GETEOFPTR might bomb on some streams)
))
(replace (STREAM OUTCHARFN) of PRSTREAM with (FUNCTION \PRESS.OUTCHARFN))
(replace (STREAM IMAGEOPS) of PRSTREAM with \PRESSIMAGEOPS)
(replace (STREAM IMAGEDATA) of PRSTREAM with PRDATA)
(COND
((SETQ OPT (LISTGET OPTIONS (QUOTE HEADING)))
(replace PRHEADING of PRDATA with OPT)))
(SETUPFONTS.PRESS PRSTREAM (LISTGET OPTIONS (QUOTE FONTS)))
(\STARTPAGE.PRESS PRSTREAM)
(RETURN PRSTREAM])
(\CLOSEF.PRESS
[LAMBDA (PRSTREAM) (* rmk: "19-Oct-84 11:12")
(* FILENAME is for the printer break page)
(\ENDPAGE.PRESS PRSTREAM)
(PROG (PDSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(SETQ PDSTREAM (fetch PDSTREAM of PRDATA))
(COND
((NEQ 0 (GETFILEPTR PDSTREAM))
(for FDE DESCR in (fetch PRESSFONTDIR of PRDATA) as I from 0
do (SETQ DESCR (fetch DESCR of FDE))
(\WOUT PRSTREAM 16)
(\BOUT PRSTREAM (fetch FONTSET# of FDE))
(* Fontset)
(\BOUT PRSTREAM (fetch FONT# of FDE)) (* font#)
(\BOUT PRSTREAM (fetch FIRSTCHAR of DESCR))
(\BOUT PRSTREAM (fetch LASTCHAR of DESCR))
(\BCPLSOUT.PRESS PRSTREAM (FONTPROP DESCR (QUOTE DEVICEFAMILY))
20)
[\BOUT PRSTREAM (\FACECODE (FONTPROP DESCR (QUOTE DEVICEFACE]
(\BOUT PRSTREAM (fetch FIRSTCHAR of DESCR))
(\WOUT PRSTREAM (FONTPROP DESCR (QUOTE DEVICESIZE)))
(\WOUT PRSTREAM (fetch ROTATION of DESCR)))
(\WOUT PRSTREAM 0) (* Font part ends with 0 word)
(\PARTEND.PRESS PRSTREAM 1)
(COPYBYTES PDSTREAM PRSTREAM 0 (GETFILEPTR PDSTREAM))
(\PAGEPAD.PRESS PRSTREAM)
(PROG (DDRECORD (DDFILEPTR (GETFILEPTR PRSTREAM)))
(* Write document directory)
(SETQ DDRECORD (FOLDLO DDFILEPTR BYTESPERRECORD))
(\WOUT PRSTREAM 27183) (* password)
(\WOUT PRSTREAM (ADD1 DDRECORD))
(\WOUT PRSTREAM (FOLDLO (GETFILEPTR PDSTREAM)
8)) (* number of parts, since each occupies 8 bytes in PD)
(\WOUT PRSTREAM (fetch PRPARTSTART of PRDATA))
(* part directory)
(\WOUT PRSTREAM (IDIFFERENCE DDRECORD (fetch PRPARTSTART of PRDATA)))
(\SIGNEDWOUT PRSTREAM -1) (* obselete)
(\FIXPOUT PRSTREAM (LISP.TO.ALTO.DATE (IDATE)))
(\WOUT PRSTREAM 1)
(\WOUT PRSTREAM 1) (* copies)
(\SIGNEDWOUT PRSTREAM -1)
(\SIGNEDWOUT PRSTREAM -1) (* first and last pages)
(\SIGNEDWOUT PRSTREAM -1) (* printing mode default)
(SETFILEPTR PRSTREAM (IPLUS DDFILEPTR 256))
(\BCPLSOUT.PRESS PRSTREAM (OR (fetch PRBREAKPAGEFILENAME of PRDATA)
(FULLNAME PRSTREAM))
52)
(\BCPLSOUT.PRESS PRSTREAM USERNAME 32)
(\BCPLSOUT.PRESS PRSTREAM (GETFILEINFO PRSTREAM (QUOTE CREATIONDATE))
40)
(\PAGEPAD.PRESS PRSTREAM])
(\DRAWLINE.PRESS
[LAMBDA (PRSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) (* rmk: "21-Sep-84 09:00")
(\DRAWCURVE.PRESS PRSTREAM (LIST (CREATEPOSITION X1 Y1)
(CREATEPOSITION X2 Y2))
NIL
(LIST (QUOTE BUTT)
WIDTH)
NIL)
Y2])
(\ENDPAGE.PRESS
[LAMBDA (PRSTREAM) (* rmk: "28-Jun-84 15:14")
(PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
(SHOW.PRESS PRSTREAM)
(\ENTITYEND.PRESS PRSTREAM)
(COND
((NEQ 0 (\GETFILEPTR ELSTREAM))
(COND
((ODDP (\GETFILEPTR PRSTREAM))
(\BOUT PRSTREAM 0)))
(\WOUT PRSTREAM 0) (* 0 word to separate DL from EL)
(COPYBYTES ELSTREAM PRSTREAM 0 (\GETFILEPTR ELSTREAM))
(\PARTEND.PRESS PRSTREAM 0])
(NEWLINE.PRESS
[LAMBDA (PRSTREAM) (* rmk: " 4-Oct-84 10:00")
(* Go to next line (or next page))
(PROG (NEWYPOS (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
(SETQ NEWYPOS (IPLUS (ffetch PRYPOS of PRDATA)
(ffetch PRLINEFEED of PRDATA)))
(COND
((ILESSP NEWYPOS (ffetch PRBOTTOM of PRDATA))
(NEWPAGE.PRESS PRSTREAM))
(T (SHOW.PRESS PRSTREAM)
(SETXY.PRESS PRSTREAM (ffetch PRLEFT of PRDATA)
NEWYPOS])
(NEWPAGE.PRESS
[LAMBDA (PRSTREAM) (* rmk: "16-Jun-84 14:29")
(\ENDPAGE.PRESS PRSTREAM)
(\STARTPAGE.PRESS PRSTREAM])
(SETUPFONTS.PRESS
[LAMBDA (PRSTREAM FONTS) (* rmk: "15-Sep-84 02:15")
(* Sets up fonts in the initial fontset. and sets heading font. Leaves PRFONT as NIL. This means that \DSPFONT.PRESS
of the heading font will establish that as the current font when the first page opens.)
(for F FLG inside (OR FONTS DEFAULTFONT)
do (SETQ F (FONTCREATE F NIL NIL NIL (QUOTE PRESS)))
(COND
(FLG (\DEFINEFONT.PRESS PRSTREAM F))
(T (\DSPFONT.PRESS PRSTREAM F) (* Install first font as current font and heading font.
font.)
(\ENTITYEND.PRESS PRSTREAM)
(replace PRHEADINGFONT of (fetch IMAGEDATA of PRSTREAM) with F)
(SETQ FLG T])
(\DEFINEFONT.PRESS
[LAMBDA (PRSTREAM FONT) (* rmk: "15-Jun-84 17:10")
(PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM)))
(RETURN (OR (FASSOC FONT (fetch PRESSFONTDIR of PRDATA))
(CAR (push (fetch PRESSFONTDIR of PRDATA)
(PROG1 (create FONTDIRENTRY
DESCR ← FONT
FONT# ←(fetch PRNEXTFONT# of PRDATA)
FONTSET# ←(fetch PRMAXFONTSET of PRDATA))
(COND
((EQ 16 (add (fetch PRNEXTFONT# of PRDATA)
1))
(add (fetch PRMAXFONTSET of PRDATA)
1)
(replace PRNEXTFONT# of PRDATA with 0])
(\DSPBOTTOMMARGIN.PRESS
[LAMBDA (PRSTREAM YPOSITION) (* rmk: "26-Jun-84 14:05")
(PROG1 (fetch PRBOTTOM of (fetch IMAGEDATA of PRSTREAM))
(COND
(YPOSITION (replace PRBOTTOM of (fetch IMAGEDATA of PRSTREAM) with YPOSITION])
(\DSPFONT.PRESS
[LAMBDA (PRSTREAM FONT) (* rmk: " 4-Oct-84 10:32")
(PROG (OLDFONT FDENTRY (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
(SETQ OLDFONT (ffetch PRFONT of PRDATA))
(COND
([OR (NULL FONT)
(EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT (QUOTE PRESS)
T)
(FONTCOPY OLDFONT FONT]
(RETURN OLDFONT)))
(SHOW.PRESS PRSTREAM)
(SETQ FDENTRY (\DEFINEFONT.PRESS PRSTREAM FONT))
(COND
((NEQ (ffetch FONTSET# of FDENTRY)
(ffetch FONTSET# of (ffetch PRCURRFDE of PRDATA)))
(* Swtich font sets)
(\ENTITYEND.PRESS PRSTREAM)
(\ENTITYSTART.PRESS PRSTREAM)))
(freplace PRCURRFDE of PRDATA with FDENTRY)
(freplace PRFONT of PRDATA with FONT)
(\BOUT (ffetch ELSTREAM of PRDATA)
(LOGOR FontCode (ffetch FONT# of FDENTRY)))
[freplace PRWIDTHSCACHE of PRDATA with (ffetch (ARRAYP BASE)
of (OR (ffetch \SFWidths of FONT)
(ARRAY 256 0]
(* The vector fonts might not have a widths array--but
this might also be anachronistic.
Should be checked)
[freplace PRLINEFEED of PRDATA with (IDIFFERENCE (CONSTANT (IMINUS MicasPerPoint))
(FONTPROP FONT (QUOTE HEIGHT]
(\FIXLINELENGTH.PRESS PRSTREAM)
(RETURN OLDFONT])
(\DSPLEFTMARGIN.PRESS
[LAMBDA (PRSTREAM XPOSITION) (* rmk: " 4-Oct-84 10:35")
(PROG1 (ffetch PRLEFT of (ffetch IMAGEDATA of PRSTREAM))
(COND
(XPOSITION (freplace PRLEFT of (ffetch IMAGEDATA of PRSTREAM) with XPOSITION)
(\FIXLINELENGTH.PRESS PRSTREAM])
(\DSPLINEFEED.PRESS
[LAMBDA (PRSTREAM DELTAY) (* rmk: " 4-Oct-84 09:31")
(* sets the amount that a line feed increases the y
coordinate by.)
(PROG ((PRDATA (ffetch IMAGEDATA of PRSTREAM)))
(RETURN (PROG1 (ffetch PRLINEFEED of PRDATA)
(AND DELTAY (COND
((NUMBERP DELTAY)
(freplace PRLINEFEED of PRDATA with DELTAY))
(T (\ILLEGAL.ARG DELTAY])
(\DSPRIGHTMARGIN.PRESS
[LAMBDA (PRSTREAM XPOSITION) (* rmk: " 4-Oct-84 10:35")
(PROG1 (ffetch PRRIGHT of (ffetch IMAGEDATA of PRSTREAM))
(COND
(XPOSITION (freplace PRRIGHT of (ffetch IMAGEDATA of PRSTREAM) with XPOSITION)
(\FIXLINELENGTH.PRESS PRSTREAM])
(\DSPTOPMARGIN.PRESS
[LAMBDA (PRSTREAM YPOSITION) (* rmk: "26-Jun-84 14:04")
(PROG1 (fetch PRTOP of (fetch IMAGEDATA of PRSTREAM))
(COND
(YPOSITION (replace PRTOP of (fetch IMAGEDATA of PRSTREAM) with YPOSITION])
(\DSPXPOSITION.PRESS
[LAMBDA (PRSTREAM XPOSITION) (* rmk: "14-Jun-84 20:17")
(PROG1 (fetch PRXPOS of (fetch IMAGEDATA of PRSTREAM))
(COND
(XPOSITION (SHOW.PRESS PRSTREAM)
(SETX.PRESS PRSTREAM XPOSITION])
(\DSPYPOSITION.PRESS
[LAMBDA (PRSTREAM YPOSITION) (* rmk: "14-Jun-84 20:17")
(PROG1 (fetch PRYPOS of (fetch IMAGEDATA of PRSTREAM))
(COND
(YPOSITION (SHOW.PRESS PRSTREAM)
(SETY.PRESS PRSTREAM YPOSITION])
(\FIXLINELENGTH.PRESS
[LAMBDA (PRSTREAM) (* rmk: " 4-Oct-84 10:36")
(* PRSTREAM is known to be a stream of type press. Called by RIGHTMARGIN LEFTMARGIN and \DSPFONT.PRESS to update the
LINELENGTH field in the stream. also called when the stream is created.)
(PROG (LLEN (PRDATA (ffetch IMAGEDATA of PRSTREAM)))
(freplace (STREAM LINELENGTH) of PRSTREAM
with (COND
((IGREATERP (SETQ LLEN (IQUOTIENT (IDIFFERENCE (ffetch PRRIGHT of PRDATA)
(ffetch PRLEFT of PRDATA))
(CHARWIDTH (CHARCODE A)
PRSTREAM)))
1)
LLEN)
(T 10])
(\PRESS.OUTCHARFN
[LAMBDA (PRSTREAM CHARCODE) (* rmk: "14-Dec-84 08:55")
(* Handle all the special-purpose characters going to a
PRESS file)
(SELCHARQ CHARCODE
(EOL (* New Line)
(NEWLINE.PRESS PRSTREAM)
(replace (STREAM CHARPOSITION) of PRSTREAM with 0))
[LF (* Line feed--move down, but not over)
(\DSPXPOSITION.PRESS PRSTREAM (PROG1 (DSPXPOSITION NIL PRSTREAM)
(NEWLINE.PRESS PRSTREAM]
(↑L (* Form Feed)
(replace (STREAM CHARPOSITION) of PRSTREAM with 0)
(NEWPAGE.PRESS PRSTREAM))
(PROG (XPOS (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(COND
[(AND (IGEQ (PROG1 (SETQ XPOS (fetch PRXPOS of PRDATA))
(add XPOS (\FGETWIDTH (ffetch PRWIDTHSCACHE of PRDATA)
CHARCODE)))
0)
(ILEQ XPOS SPRUCEPAPERRIGHTMICAS))
(replace PRXPOS of PRDATA with XPOS)
(COND
((IGEQ (fetch PRYPOS of PRDATA)
0)
(\BOUT PRSTREAM CHARCODE]
(T (SHOW.PRESS PRSTREAM) (* Don't put anything out if coordinates are negative)
(SETX.PRESS PRSTREAM XPOS])
(\STARTPAGE.PRESS
[LAMBDA (PRSTREAM) (* rmk: "20-Jun-84 11:01")
(* Should be called only when no previous page is open)
(PROG (CFONT HFONT (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(SETQ CFONT (fetch PRFONT of PRDATA)) (* Save current font and make PRFONT be NIL, indicating
that there is no actual font at the beginning of a page)
(\ENTITYSTART.PRESS PRSTREAM)
[COND
((fetch PRHEADING of PRDATA)
(SETQ HFONT (fetch PRHEADINGFONT of PRDATA))
(\DSPFONT.PRESS PRSTREAM HFONT) (* Set up heading font)
[SETXY.PRESS PRSTREAM (fetch PRLEFT of PRDATA)
(IDIFFERENCE (fetch PRTOP of PRDATA)
(FONTPROP HFONT (QUOTE ASCENT]
(PRIN3 (fetch PRHEADING of PRDATA)
PRSTREAM) (* Skip an inch before page number)
(SHOW.PRESS PRSTREAM)
(SETX.PRESS PRSTREAM (IPLUS MICASPERINCH (fetch PRXPOS of PRDATA)))
(PRIN3 "Page " PRSTREAM)
(PRIN3 (add (fetch PRPAGENUM of PRDATA)
1)
PRSTREAM)
(NEWLINE.PRESS PRSTREAM) (* Skip 2 lines)
(NEWLINE.PRESS PRSTREAM))
(T (SETXY.PRESS PRSTREAM (fetch PRLEFT of PRDATA)
(IDIFFERENCE (fetch PRTOP of PRDATA)
(FONTPROP CFONT (QUOTE ASCENT]
(* Now we set the font to our
(previous) current font)
(\DSPFONT.PRESS PRSTREAM CFONT])
(SHOWRECTANGLE.PRESS
[LAMBDA (PRSTREAM WIDTH HEIGHT) (* rmk: "14-Jun-84 19:39")
(PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
(\BOUT ELSTREAM ShowRectangleCode)
(\WOUT ELSTREAM WIDTH)
(\WOUT ELSTREAM HEIGHT])
)
(* Drawcurve code)
(DEFINEQ
(ENDVECRUN
[LAMBDA (PRSTREAM HALFVECWIDTH) (* rmk: "13-Dec-84 17:55")
(SHOW.PRESS PRSTREAM)
(PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM))
ORIGXPOS ORIGYPOS XPOS YPOS WASDISPLAYING ORIGWASDISPLAYING)
(COND
((NOT (fetch VECMOVINGRIGHT of PRDATA)) (* We've been moving to the left, so it's time to
uncache those characters we saved.)
(SETQ XPOS (fetch VECCURX of PRDATA))
(SETQ YPOS (fetch VECCURY of PRDATA))
(SETQ ORIGXPOS (FIXR (FTIMES MicasPerScan XPOS)))
(* Remember where the end of the line is, so we can
come back here.)
(SETQ ORIGYPOS (FIXR (FTIMES MicasPerScan YPOS)))
[SETQ ORIGWASDISPLAYING (AND (IGEQ XPOS HALFVECWIDTH)
(IGEQ YPOS HALFVECWIDTH)
(ILESSP YPOS (IDIFFERENCE SPRUCEPAPERTOPSCANS HALFVECWIDTH)
)
(ILESSP XPOS (IDIFFERENCE SPRUCEPAPERRIGHTSCANS
HALFVECWIDTH]
(SETQ WASDISPLAYING ORIGWASDISPLAYING) (* Decide whether to start out by displaying any
characters or not.)
(COND
(WASDISPLAYING (SETXY.PRESS PRSTREAM ORIGXPOS ORIGYPOS)))
(* We may have been adjusting the X and Y position in
the PRDATA without actually putting out the file
commands)
[for CH in (fetch VECSEGCHARS of PRDATA)
do (COND
[(AND (IGEQ XPOS HALFVECWIDTH)
(IGEQ YPOS HALFVECWIDTH)
(ILESSP YPOS (IDIFFERENCE SPRUCEPAPERTOPSCANS HALFVECWIDTH))
(ILESSP XPOS (IDIFFERENCE SPRUCEPAPERRIGHTSCANS HALFVECWIDTH)))
(* We're on-paper. Go ahead and display the character.)
(COND
((NOT WASDISPLAYING) (* We haven't really been displaying characters up to
now--we need to reposition.)
(SHOW.PRESS PRSTREAM)
(SETXY.PRESS PRSTREAM (FIXR (FTIMES MicasPerScan XPOS))
(FIXR (FTIMES MicasPerScan YPOS)))
(SETQ WASDISPLAYING T)))
(\BOUT PRSTREAM (VECENCODE (IMINUS (CAR CH))
(IMINUS (CDR CH]
(T (* We are off-paper. Stop displaying, and remember that
we took a hiatus)
(SETQ WASDISPLAYING NIL)))
(SETQ XPOS (IDIFFERENCE XPOS (CAR CH)))
(SETQ YPOS (IDIFFERENCE YPOS (CDR CH]
(SHOW.PRESS PRSTREAM)
(SETXY.PRESS PRSTREAM ORIGXPOS ORIGYPOS)
(replace VECWASDISPLAYING of PRDATA with ORIGWASDISPLAYING)))
(replace VECSEGCHARS of PRDATA with NIL])
(VECENCODE
[LAMBDA (DX DY) (* jds "18-DEC-81 15:48")
(* Given dx and dy in dover pixels, decide which Vector
Font character represents that move, and return it.)
(if (ILESSP 0 DY)
then (IDIFFERENCE (IPLUS 160 DX (IMINUS DY))
(ITIMES 9 (IMAX DX DY)))
else (IDIFFERENCE (IDIFFERENCE (IDIFFERENCE 160 DX)
DY)
(ITIMES 7 (IMAX DX (IMINUS DY])
(VECPUT
[LAMBDA (PRSTREAM DX DY HALFVECWIDTH) (* rmk: "13-Dec-84 17:54")
(* Send this dx,dy pair to the press file;
hold and reverse any strings which run right-to-left on
the page.)
(PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM))
XPOS YPOS)
(COND
((OR (AND (fetch VECMOVINGRIGHT of PRDATA)
(ILESSP DX 0))
(AND (NOT (fetch VECMOVINGRIGHT of PRDATA))
(ILESSP 0 DX))) (* We switched direction (LEFT->RIGHT or RIGHT->LEFT).
Put out what we've got, and start the new run.)
(ENDVECRUN PRSTREAM HALFVECWIDTH)
(replace VECMOVINGRIGHT of PRDATA with (NOT (fetch VECMOVINGRIGHT of PRDATA)))
(* Switch the direction we think we're moving.)
))
(SETQ XPOS (fetch VECCURX of PRDATA)) (* In DOVER spots)
(SETQ YPOS (fetch VECCURY of PRDATA))
(replace VECCURX of PRDATA with (IPLUS XPOS DX))
(replace VECCURY of PRDATA with (IPLUS YPOS DY))
(COND
[(fetch VECMOVINGRIGHT of PRDATA) (* We're moving right, and are really putting out
characters.)
(* SPRUCEPAPERTOPSCANS is in dover points)
(COND
((AND (IGEQ YPOS HALFVECWIDTH)
(ILESSP YPOS (IDIFFERENCE SPRUCEPAPERTOPSCANS HALFVECWIDTH))
(IGEQ XPOS HALFVECWIDTH)
(ILESSP XPOS (IDIFFERENCE SPRUCEPAPERRIGHTSCANS HALFVECWIDTH)))
(* We're on-paper. Go ahead and display this
character.)
(COND
((NOT (fetch VECWASDISPLAYING of PRDATA))
(* We haven't been displaying.
before really putting out the character,)
(SHOW.PRESS PRSTREAM)
(SETXY.PRESS PRSTREAM (FIXR (FTIMES MicasPerScan XPOS))
(FIXR (FTIMES MicasPerScan YPOS)))
(* So move to where we're emerging onto the paper.)
(replace VECWASDISPLAYING of PRDATA with T)))
(\BOUT PRSTREAM (VECENCODE DX DY)))
(T (* We're off-page. Remember to do a SETXY when we get
back on.)
(replace VECWASDISPLAYING of PRDATA with NIL]
(T (* We're moving left--and so caching characters for
later. Don't bother making any checks going this way.)
(push (fetch VECSEGCHARS of PRDATA)
(CONS DX DY)) (* Just cache the DX,DY pair)
])
(VECSKIP
[LAMBDA (PRSTREAM DX DY) (* rmk: " 6-Aug-84 10:35")
(* Put out blank space for DX, DY)
(ENDVECRUN PRSTREAM)
(SETQ VecCurX (IPLUS VecCurX DX))
(SETQ VecCurY (IPLUS VecCurY DY))
(ENDVECRUN PRSTREAM])
(VECFONTINIT
[LAMBDA NIL (* rmk: "30-Nov-84 16:53")
(* Initialize \VecFontDir, a list of lists of dummy font descriptors for the ReDraw vector fonts.
The structure is ((round brushes) (square brushes) (horizontal brushes) (vertical brushes)))
(DECLARE (GLOBALVARS \VecFontDir))
(* WIDTHS is a dummy array descriptor so that \DSPFONT.PRESS doesn't get confused. If any real character output were
done with this descriptor in force, the results would be disastrous. But the RESETSAVE in \PRESSCURVE2 should
prevent this.)
(OR \VecFontDir (SETQ \VecFontDir (for FMLY (SETQ WIDTHS (ARRAY 256 (QUOTE SMALLP)
1 0))
in (QUOTE (NEWVEC SNEWVEC HNEWVEC VNEWVEC))
collect (for BRUSH in (QUOTE (4 8 16 32 64))
collect (create FONTDESCRIPTOR
FONTDEVICE ←(QUOTE PRESS)
FONTFAMILY ← FMLY
FONTSIZE ← BRUSH
FONTFACE ←(QUOTE (MEDIUM REGULAR
REGULAR))
ROTATION ← 0
\SFWidths ← WIDTHS])
(\DRAWCIRCLE.PRESS
[LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* rmk: "27-Sep-84 17:23")
(PROG [(R2RAD (FIXR (FTIMES RADIUS (CONSTANT (FQUOTIENT (SQRT 2)
2]
(DRAWCURVE (LIST (CREATEPOSITION (IPLUS CENTERX RADIUS)
CENTERY)
(CREATEPOSITION (IPLUS CENTERX R2RAD)
(IPLUS CENTERY R2RAD))
(CREATEPOSITION CENTERX (IPLUS CENTERY RADIUS))
(CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
(IPLUS CENTERY R2RAD))
(CREATEPOSITION (IDIFFERENCE CENTERX RADIUS)
CENTERY)
(CREATEPOSITION (IDIFFERENCE CENTERX R2RAD)
(IDIFFERENCE CENTERY R2RAD))
(CREATEPOSITION CENTERX (IDIFFERENCE CENTERY RADIUS))
(CREATEPOSITION (IPLUS CENTERX R2RAD)
(IDIFFERENCE CENTERY R2RAD)))
T BRUSH DASHING STREAM))
(MOVETO CENTERX CENTERY STREAM])
(\DRAWCURVE.PRESS
[LAMBDA (PRSTREAM KNOTS CLOSED BRUSH DASHING) (* rmk: "20-Nov-84 13:59")
(* draws a spline curve with a given brush brush.
Knots and brushwidth assumed to be in micas)
[COND
((LISTP KNOTS)
(SHOW.PRESS PRSTREAM)
(PROG [LASTKNOT (DASHLST (AND DASHING (OR (AND (LISTP DASHING)
(EVERY DASHING (FUNCTION FIXP))
DASHING)
(\ILLEGAL.ARG DASHING]
(* The above makes sure that DASHING is a list of
numbers.)
[OR (CDR KNOTS)
(SETQ KNOTS (LIST (CAR KNOTS)
(CAR KNOTS] (* Handle the trival one-knot case.)
(COND
((AND (NULL DASHING)
(EQ 2 (LENGTH KNOTS))
(\DRAWCURVE.PRESS.LINE PRSTREAM (fetch XCOORD of (CAR KNOTS))
(fetch YCOORD of (CAR KNOTS))
(fetch XCOORD of (CADR KNOTS))
(fetch YCOORD of (CADR KNOTS))
BRUSH DASHING))
(* There were only two knots, and no dashing.
\DRAWCURVE.PRESS.LINE returned T if it managed to draw
the line the fast way.)
(* Have to move to the endpoint of the line.)
)
(T (* Otherwise, use the full-strength curve drawer.)
(\PRESSCURVE2 PRSTREAM (PARAMETRICSPLINE [for KNOT in KNOTS
collect
(CREATEPOSITION
(FIXR (FTIMES (fetch XCOORD
of KNOT)
ScansPerMica))
(FIXR (FTIMES (fetch YCOORD
of KNOT)
ScansPerMica]
CLOSED)
DASHING
(\GETBRUSHFONT.PRESS BRUSH))
(* This already leaves the current position at the
endpoint of the curve.)
))
(SETQ LASTKNOT (CAR (LAST KNOTS)))
(SETXY.PRESS PRSTREAM (fetch XCOORD of LASTKNOT)
(fetch YCOORD of LASTKNOT]
PRSTREAM])
(\DRAWCURVE.PRESS.LINE
[LAMBDA (PRSTREAM X1 Y1 X2 Y2 BRUSH DASHING) (* rmk: "13-Dec-84 16:58")
(* Returns T if this is a horizontal or vertical line,
hence can be drawn as a rectangle.)
(PROG (WIDTH BACKOFF LEFT BOTTOM DIST LB TR (SHAPE (QUOTE ROUND)))
(SETQ WIDTH (OR (COND
((LISTP BRUSH)
(SETQ SHAPE (CAR BRUSH))
(CADR BRUSH))
(T BRUSH))
1))
[SELECTQ SHAPE
(BUTT (SETQ BACKOFF 0))
(ROUND (RETURN NIL))
(PROGN (SETQ BACKOFF (IQUOTIENT WIDTH 2]
(* For butt ends, we want the line to end at the given
coordinate position)
(* LB is left or bottom, TR is top or right, depending
on orientation)
(COND
((EQP X1 X2) (* Vertical line)
(SETQ LEFT (IDIFFERENCE X1 (IQUOTIENT WIDTH 2)))
(* Off to the left or right?)
(AND (OR (ILESSP LEFT 0)
(IGREATERP (IPLUS LEFT WIDTH)
SPRUCEPAPERRIGHTMICAS))
(RETURN T))
(COND
((IGREATERP Y1 Y2)
(SETQ LB Y2)
(SETQ TR Y1))
(T (SETQ LB Y1)
(SETQ TR Y2)))
(SETQ LB (IMAX 0 (IDIFFERENCE LB BACKOFF))) (* Clip to page)
(SETQ TR (IMIN SPRUCEPAPERTOPMICAS (IPLUS TR BACKOFF)))
(SETQ DIST (IDIFFERENCE TR LB))
(OR (IGREATERP DIST 0)
(RETURN T))
(SETXY.PRESS PRSTREAM LEFT LB) (* Move to where the line starts)
(SHOWRECTANGLE.PRESS PRSTREAM WIDTH DIST) (* Draw the rectangle that will do the job.)
(RETURN T))
((EQP Y1 Y2) (* Horizontal line)
(SETQ BOTTOM (IDIFFERENCE Y1 (IQUOTIENT WIDTH 2)))
(* Off to the bottom or top?)
(AND (OR (ILESSP BOTTOM 0)
(IGREATERP (IPLUS BOTTOM WIDTH)
SPRUCEPAPERTOPMICAS))
(RETURN T))
(COND
((IGREATERP X1 X2)
(SETQ LB X2)
(SETQ TR X1))
(T (SETQ LB X1)
(SETQ TR X2)))
(SETQ LB (IMAX 0 (IDIFFERENCE LB BACKOFF))) (* Clip to page)
(SETQ TR (IMIN SPRUCEPAPERRIGHTMICAS (IPLUS TR BACKOFF)))
(SETQ DIST (IDIFFERENCE TR LB))
(OR (IGREATERP DIST 0)
(RETURN T))
(SETXY.PRESS PRSTREAM LB BOTTOM) (* Move to where the line starts)
(SHOWRECTANGLE.PRESS PRSTREAM DIST WIDTH) (* Draw the rectangle that will do the job.)
(RETURN T])
(\DRAWELLIPSE.PRESS
[LAMBDA (PRSTREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
(* rmk: "23-Aug-84 10:51")
(PROG [(SINOR (COND
(ORIENTATION (SIN ORIENTATION))
(T 0.0)))
(COSOR (COND
(ORIENTATION (COS ORIENTATION))
(T 1.0]
(\DRAWCURVE.PRESS 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])
(\GETBRUSHFONT.PRESS
[LAMBDA (BRUSH) (* rmk: "23-Aug-84 19:04")
(VECFONTINIT)
(PROG [(LIST1 (SELECTQ (CAR (LISTP BRUSH))
(ROUND (CAR \VecFontDir))
(SQUARE (CADR \VecFontDir))
(HORIZONTAL (CADDR \VecFontDir))
(VERTICAL (CADDDR \VecFontDir))
(BUTT (CAR \VecFontDir))
(CAR \VecFontDir]
(AND (LISTP BRUSH)
(SETQ BRUSH (CADR BRUSH)))
(RETURN (SELECTQ (FIXR (FTIMES (OR BRUSH 1)
PointsPerMica))
((0 1)
(CAR LIST1))
(2 (CADR LIST1))
((3 4 5)
(CADDR LIST1))
((6 7 8)
(CADDDR LIST1))
(CADDDR LIST1])
(\PRESSCURVE2
[LAMBDA (PRSTREAM SPLINE DASHING BRUSHFONT) (* rmk: " 4-Oct-84 16:45")
(* Given a spline curve and a font, draw the lines to
PRSTREAM)
(RESETLST (RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT BRUSHFONT PRSTREAM)
PRSTREAM))
(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 HALFVECWIDTH)
(SETQ HALFVECWIDTH (FONTPROP BRUSHFONT (QUOTE SIZE)))
(SETQ DASHON T) (* These are initialized outside the prog-bindings
cause the compiler can't hack so many initialized
variables)
(SETQ DASHLST DASHING)
(SETQ DASHCNT (CAR DASHING))
(SETXY.PRESS PRSTREAM (FIXR (FTIMES X0 MicasPerScan))
(FIXR (FTIMES Y0 MicasPerScan)))
(replace VECMOVINGRIGHT of (fetch IMAGEDATA of PRSTREAM) with T)
(replace VECWASDISPLAYING of (fetch IMAGEDATA of PRSTREAM)
with (AND (GEQ X0 0)
(GEQ Y0 0)))
(replace VECSEGCHARS of (fetch IMAGEDATA of PRSTREAM) with NIL)
(replace VECCURX of (fetch IMAGEDATA of PRSTREAM) with X0)
(replace VECCURY of (fetch IMAGEDATA of PRSTREAM) with Y0)
(* Set up initial values in vec variables, perform
SetX/SetY.)
(SETQ TT 0.0)
(SETQ DELTA 16)
(SETQ IX (FIXR X0))
(SETQ IY (FIXR Y0))
(for KNOT# from 1 to (SUB1 #KNOTS)
do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#)
(ELT X'' KNOT#)
(ELT X' KNOT#)
(ELT X KNOT#))
(LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#)
(ELT Y'' KNOT#)
(ELT Y' KNOT#)
(ELT Y KNOT#))
(SETQ XT (EVALPOLY XPOLY TT 3)) (* XT ← X (t) --Evaluate the next point)
(SETQ YT (EVALPOLY YPOLY TT 3)) (* YT ← Y (t))
[until (GEQ TT 1.0)
do (SETQ X'T (EVALPOLY X'POLY TT 2))
(* X'T ← X' (t))
(SETQ Y'T (EVALPOLY Y'POLY TT 2))
(* Y'T ← Y' (t))
(COND
((EQP X'T 0.0)
(SETQ X'T .0005)))
(COND
((EQP Y'T 0.0)
(SETQ Y'T .0005)))
[COND
((FGTP X'T 0.0)
(SETQ DX DELTA))
(T (SETQ DX (IMINUS DELTA]
[COND
((FGTP Y'T 0.0)
(SETQ DY DELTA))
(T (SETQ DY (IMINUS DELTA]
(SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX)
XT)
X'T))
(SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY)
YT)
Y'T))
[COND
((FLESSP XWALLDT YWALLDT)
(SETQ NEWT (FPLUS TT XWALLDT))
(SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T)))
IY)))
(T (SETQ NEWT (FPLUS TT YWALLDT))
(SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T)))
IX]
(COND
([AND (FGTP NEWT 1.0)
(OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS]
(SETQ NEWT 1.0)))
(SETQ NEWXT (EVALPOLY XPOLY NEWT 3))
(* New XT ← X (new t))
(SETQ NEWYT (EVALPOLY YPOLY NEWT 3))
(* New YT ← Y (new t))
(SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX)
NEWXT)))
(SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
NEWYT)))
(COND
((AND (IGREATERP DELTA 1)
(OR (FGTP XDIFF 1.0)
(FGTP YDIFF 1.0)))
(SETQ DELTA (LRSH DELTA 1)))
(T (VECPUT PRSTREAM DX DY HALFVECWIDTH)
(SETQ IX (IPLUS IX DX))
(SETQ IY (IPLUS IY DY))
(SETQ TT NEWT)
(SETQ XT NEWXT)
(SETQ YT NEWYT)
(COND
((AND (ILESSP DELTA 16)
(OR (FLESSP XDIFF .5)
(FLESSP YDIFF .5)))
(SETQ DELTA (LLSH DELTA 1]
(SETQ TT (FDIFFERENCE TT 1.0)))
(ENDVECRUN PRSTREAM HALFVECWIDTH])
)
(RPAQ? \VecFontDir )
(DECLARE: EVAL@COMPILE
(RPAQQ \MicasPerInch 2540)
(CONSTANTS (\MicasPerInch 2540))
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ ScansPerIn 384)
(RPAQQ PointsPerIn 72.27)
(RPAQ MicasPerScan (FQUOTIENT \MicasPerInch ScansPerIn))
(RPAQ ScansPerMica (FQUOTIENT ScansPerIn \MicasPerInch))
(RPAQ ScansPerPoint (FQUOTIENT ScansPerIn PointsPerIn))
(RPAQ PointsPerScan (FQUOTIENT PointsPerIn ScansPerIn))
(RPAQ MicasPerPoint (FQUOTIENT \MicasPerInch PointsPerIn))
(RPAQ PointsPerMica (FQUOTIENT PointsPerIn \MicasPerInch))
(RPAQQ SPRUCEPAPERTOPSCANS 4096)
(RPAQ SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
ScansPerIn)))
(RPAQ SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch)))
(RPAQ SPRUCEPAPERRIGHTSCANS (FIX (FTIMES 8.5 ScansPerIn)))
[CONSTANTS (ScansPerIn 384)
(PointsPerIn 72.27)
(MicasPerScan (FQUOTIENT \MicasPerInch ScansPerIn))
(ScansPerMica (FQUOTIENT ScansPerIn \MicasPerInch))
(ScansPerPoint (FQUOTIENT ScansPerIn PointsPerIn))
(PointsPerScan (FQUOTIENT PointsPerIn ScansPerIn))
(MicasPerPoint (FQUOTIENT \MicasPerInch PointsPerIn))
(PointsPerMica (FQUOTIENT PointsPerIn \MicasPerInch))
(SPRUCEPAPERTOPSCANS 4096)
(SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
ScansPerIn)))
(SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch)))
(SPRUCEPAPERRIGHTSCANS (FIX (FTIMES 8.5 ScansPerIn]
)
)
(DEFINEQ
(\PRESSINIT
[LAMBDA NIL (* rmk: " 4-Oct-84 09:30")
(DECLARE (GLOBALVARS \PRESSIMAGEOPS))
(SETQ \PRESSIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE PRESS)
IMCLOSEFN ←(FUNCTION \CLOSEF.PRESS)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.PRESS)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.PRESS)
IMFONT ←(FUNCTION \DSPFONT.PRESS)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.PRESS)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.PRESS)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.PRESS)
IMDRAWLINE ←(FUNCTION \DRAWLINE.PRESS)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.PRESS)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.PRESS)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.PRESS)
IMFILLCIRCLE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE FILLCIRCLE]
IMBLTSHADE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
IMBITBLT ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE BLTSHADE]
IMSCALE ←[FUNCTION (LAMBDA NIL
(CONSTANT (FQUOTIENT MICASPERINCH 72]
IMTERPRI ←(FUNCTION NEWLINE.PRESS)
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.PRESS)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.PRESS)
IMFONTCREATE ←(QUOTE PRESS)
IMNEWPAGE ←(FUNCTION NEWPAGE.PRESS])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\PRESSINIT)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop each page.)
PRHEADINGFONT (* Font to print the heading in)
PRXPOS (* Current X position)
PRYPOS (* Current Y position)
PRFONT (* Current font)
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
PDSTREAM ELSTREAM XPRPAGEREGION PRBREAKPAGEFILENAME (PRLEFT WORD)
(* Page left margin)
(PRBOTTOM WORD) (* Page bottom margin)
(PRRIGHT WORD) (* Page right margin)
(PRTOP WORD) (* Page top margin)
(PRPAGENUM WORD) (* Current Page number)
(PRNEXTFONT# BYTE)
(PRMAXFONTSET BYTE)
(PRPARTSTART INTEGER)
(DLSTARTBYTE INTEGER)
(ELSTARTBYTE INTEGER)
(STARTCHARBYTE INTEGER)
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with vector fonts, are we
moving to the right?)
(VECWASDISPLAYING FLAG) (* Used during curve/line clipping to remember whether
we were on-screen or not, so we know when to force a
SETXY.)
VECSEGCHARS (* Cache for vector characters while we're moving to
the left.)
VECCURX (* Current X position within vector code, in Dover
spots)
VECCURY (* Current Y position with vector code, in Dover spots)
)
PRXPOS ← 0 PRYPOS ← 0 (* We assume that the origin is translated to the
bottom-left of the page region)
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of DATUM)
(fetch (PRESSDATA PRLEFT) of DATUM)))
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
(fetch (PRESSDATA PRBOTTOM) of DATUM)))
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
(PROGN (replace (PRESSDATA XPRPAGEREGION) of DATUM
with NEWVALUE)
(replace (PRESSDATA PRLEFT) of DATUM
with (fetch (REGION LEFT) of NEWVALUE))
(replace (PRESSDATA PRBOTTOM) of DATUM
with (fetch (REGION BOTTOM) of NEWVALUE))
(replace (PRESSDATA PRRIGHT) of DATUM
with (IPLUS (fetch (REGION LEFT)
of NEWVALUE)
(fetch (REGION WIDTH)
of NEWVALUE)))
(replace (PRESSDATA PRTOP) of DATUM
with (IPLUS (fetch (REGION BOTTOM)
of NEWVALUE)
(fetch (REGION HEIGHT)
of NEWVALUE])
(RECORD FONTDIRENTRY (DESCR FONT# FONTSET#))
]
(/DECLAREDATATYPE (QUOTE PRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD
WORD BYTE BYTE FIXP FIXP FIXP FIXP FLAG FLAG POINTER POINTER
POINTER)))
)
(/DECLAREDATATYPE (QUOTE PRESSDATA)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD
WORD BYTE BYTE FIXP FIXP FIXP FIXP FLAG FLAG POINTER POINTER
POINTER)))
(RPAQ? DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765))
(RPAQ? PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
(TIMES 10 \MicasPerInch)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPAGEREGION)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ BYTESPERRECORD 512)
(RPAQQ LISPENTITYTYPE 6)
(RPAQ MICASPERINCH \MicasPerInch)
(CONSTANTS (BYTESPERRECORD 512)
(LISPENTITYTYPE 6)
(MICASPERINCH \MicasPerInch))
)
(RPAQQ PRESSOPS (SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode
ShowCharactersCode SkipCharactersCode SkipControlBytesCode
ShowCharacterImmediateCode SetSpaceXCode SetSpaceYCode ResetSpaceCode SpaceCode
SetBrightnessCode SetHueCode SetSaturationCode ShowObjectCode ShowDotsCode
ShowDotsOpaqueCode ShowRectangleCode NopCode))
(DECLARE: EVAL@COMPILE
(RPAQQ SetX 0)
(RPAQQ SetY 1)
(RPAQQ ShowCharacters 2)
(RPAQQ ShowCharactersShortCode 0)
(RPAQQ SkipCharactersShortCode 40Q)
(RPAQQ ShowCharactersAndSkipCode 100Q)
(RPAQQ SetSpaceXShortCode 140Q)
(RPAQQ SetSpaceYShortCode 150Q)
(RPAQQ FontCode 160Q)
(RPAQQ SkipControlBytesImmediateCode 353Q)
(RPAQQ AlternativeCode 354Q)
(RPAQQ OnlyOnCopyCode 355Q)
(RPAQQ SetXCode 356Q)
(RPAQQ SetYCode 357Q)
(RPAQQ ShowCharactersCode 360Q)
(RPAQQ SkipCharactersCode 361Q)
(RPAQQ SkipControlBytesCode 362Q)
(RPAQQ ShowCharacterImmediateCode 363Q)
(RPAQQ SetSpaceXCode 364Q)
(RPAQQ SetSpaceYCode 365Q)
(RPAQQ ResetSpaceCode 366Q)
(RPAQQ SpaceCode 367Q)
(RPAQQ SetBrightnessCode 370Q)
(RPAQQ SetHueCode 371Q)
(RPAQQ SetSaturationCode 372Q)
(RPAQQ ShowObjectCode 373Q)
(RPAQQ ShowDotsCode 374Q)
(RPAQQ ShowDotsOpaqueCode 375Q)
(RPAQQ ShowRectangleCode 376Q)
(RPAQQ NopCode 377Q)
(CONSTANTS SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode
ShowCharactersCode SkipCharactersCode SkipControlBytesCode ShowCharacterImmediateCode
SetSpaceXCode SetSpaceYCode ResetSpaceCode SpaceCode SetBrightnessCode SetHueCode
SetSaturationCode ShowObjectCode ShowDotsCode ShowDotsOpaqueCode ShowRectangleCode NopCode)
)
)
(DEFINEQ
(MAKEPRESS
[LAMBDA (FILE PFILE FONTS HEADING TABS) (* rmk: "14-Sep-84 12:01")
(TEXTTOIMAGEFILE FILE PFILE (QUOTE PRESS)
FONTS HEADING TABS])
(PRESSFILEP
[LAMBDA (FILE) (* rmk: " 1-DEC-82 22:27")
(* Returns FILE if it looks like a Press file)
(AND (SETQ FILE (FINDFILE FILE))
(PROG [(LEN (GETFILEINFO FILE (QUOTE LENGTH]
(AND (NOT (ZEROP LEN))
(EVENP LEN BYTESPERRECORD)
[RESETLST [COND
[(OPENP FILE (QUOTE INPUT))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
FILE
(GETFILEPTR FILE]
(T (RESETSAVE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
10Q)
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(SETFILEPTR FILE (IDIFFERENCE LEN BYTESPERRECORD))
(IEQP 65057Q (\WIN (\GETOFD FILE (QUOTE INPUT]
(RETURN FILE])
(PRESS.BITMAPSCALE
[LAMBDA (WIDTH HEIGHT) (* gbn "16-Sep-84 18:50")
(MIN (FQUOTIENT (TIMES (fetch HEIGHT of PRESSBITMAPREGION)
PointsPerMica)
HEIGHT)
(FQUOTIENT (TIMES (fetch WIDTH of PRESSBITMAPREGION)
PointsPerMica)
WIDTH)
(PROG1 2 (* MAXPRESSRATIO)])
(millsToMicas
[LAMBDA (N) (* rmk: "24-FEB-81 21:45")
(* Converts mills to micas. 2540/1000 reduces to 127/50,
which might avoid largeps)
(IQUOTIENT (ITIMES N 177Q)
62Q])
)
(RPAQ? PRESSTABSTOPS (QUOTE (17500Q)))
(ADDTOVAR IMAGESTREAMTYPES (PRESS (OPENSTREAM OPENPRSTREAM)
(FONTCREATE \CREATEPRESSFONT)
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
(ADDTOVAR PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
((FULLPRESS RAVEN)
(* same as PRESS but can scale bitmaps)
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT
(LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL (QUOTE PRESS))
(CLOSEF? FILE)
PFILE])
(PUTPROPS PRESS COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10041Q 10571Q (\HACKBLTSHADE 10053Q . 10567Q)) (10660Q 43506Q (\SEARCHPRESSFONTS 10672Q
. 12631Q) (\GETPRESSFONTNAMES 12633Q . 17764Q) (\PRESSFAMILYCODELST 17766Q . 21611Q) (
\DECODEPRESSFACEBYTE 21613Q . 23726Q) (\CREATEPRESSFONT 23730Q . 43504Q)) (43766Q 71667Q (PRESSBITMAP
44000Q . 50724Q) (FULLPRESSBITMAP 50726Q . 55455Q) (SHOWREGION 55457Q . 56661Q) (SHOWPRESSBITMAPREGION
56663Q . 57362Q) (PRESSWINDOW 57364Q . 61641Q) (WINDOW.BITMAP 61643Q . 62640Q) (\WRITEPRESSBITMAP
62642Q . 71665Q)) (71670Q 74172Q (\BCPLSOUT.PRESS 71702Q . 72705Q) (\PAGEPAD.PRESS 72707Q . 74170Q)) (
74173Q 112754Q (\ENTITYEND.PRESS 74205Q . 100346Q) (\PARTEND.PRESS 100350Q . 102446Q) (
\ENTITYSTART.PRESS 102450Q . 104617Q) (SETX.PRESS 104621Q . 105660Q) (SETXY.PRESS 105662Q . 107072Q) (
SETY.PRESS 107074Q . 110113Q) (SHOW.PRESS 110115Q . 112752Q)) (112755Q 154443Q (OPENPRSTREAM 112767Q
. 117514Q) (\CLOSEF.PRESS 117516Q . 125462Q) (\DRAWLINE.PRESS 125464Q . 126144Q) (\ENDPAGE.PRESS
126146Q . 127267Q) (NEWLINE.PRESS 127271Q . 130475Q) (NEWPAGE.PRESS 130477Q . 130764Q) (
SETUPFONTS.PRESS 130766Q . 132467Q) (\DEFINEFONT.PRESS 132471Q . 133754Q) (\DSPBOTTOMMARGIN.PRESS
133756Q . 134445Q) (\DSPFONT.PRESS 134447Q . 137775Q) (\DSPLEFTMARGIN.PRESS 137777Q . 140543Q) (
\DSPLINEFEED.PRESS 140545Q . 141616Q) (\DSPRIGHTMARGIN.PRESS 141620Q . 142367Q) (\DSPTOPMARGIN.PRESS
142371Q . 143047Q) (\DSPXPOSITION.PRESS 143051Q . 143505Q) (\DSPYPOSITION.PRESS 143507Q . 144143Q) (
\FIXLINELENGTH.PRESS 144145Q . 145504Q) (\PRESS.OUTCHARFN 145506Q . 150430Q) (\STARTPAGE.PRESS 150432Q
. 153744Q) (SHOWRECTANGLE.PRESS 153746Q . 154441Q)) (154477Q 227336Q (ENDVECRUN 154511Q . 162405Q) (
VECENCODE 162407Q . 163407Q) (VECPUT 163411Q . 171506Q) (VECSKIP 171510Q . 172233Q) (VECFONTINIT
172235Q . 174470Q) (\DRAWCIRCLE.PRESS 174472Q . 176406Q) (\DRAWCURVE.PRESS 176410Q . 203141Q) (
\DRAWCURVE.PRESS.LINE 203143Q . 211106Q) (\DRAWELLIPSE.PRESS 211110Q . 213217Q) (\GETBRUSHFONT.PRESS
213221Q . 214470Q) (\PRESSCURVE2 214472Q . 227334Q)) (232321Q 235207Q (\PRESSINIT 232333Q . 235205Q))
(251543Q 255030Q (MAKEPRESS 251555Q . 252055Q) (PRESSFILEP 252057Q . 253464Q) (PRESS.BITMAPSCALE
253466Q . 254330Q) (millsToMicas 254332Q . 255026Q)))))
STOP