(FILECREATED " 1-AUG-83 23:32:43" {PHYLUM}<LISPCORE>SOURCES>PRESS.;30 127426Q
changes to: (ALISTS (PRINTERMODES PRESS))
previous date: "27-JUL-83 20:35:30" {PHYLUM}<LISPCORE>SOURCES>PRESS.;29)
(* Copyright (c) 1981, 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS [(COMS (FNS \FACECODE \FAMILYCODE \FINDFONT \CREATEPRESSFONT)
(INITVARS [FONTWIDTHSFILES (SELECTQ (SYSTEMTYPE)
(D (QUOTE ({INDIGO}<FONTS>FONTS.WIDTHS)))
(QUOTE (<FONTS>FONTS.WIDTHS]
(EMPRESS.SCRATCH (QUOTE (30 {DSK}EMPRESS.SCRATCH)))
(EMPRESS#SIDES T))
(FNS INTIN)
(DECLARE: DOCOPY (DECLARE: EVAL@LOADWHEN (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
T)
NIL)
(FILES (SYSLOAD FROM BLISP)
DCODEFOR10)))
(DECLARE: DONTCOPY (CONSTANTS noInfoCode)))
(COMS (FNS PRESSBITMAP \WRITEPRESSBITMAP WRITEFONTDIRECTORY MOVETOREC PRESSSCALEFACTOR)
(DECLARE: DONTCOPY (MACROS PRESSBYTES PRESSWORD PUTPRESSLIST)))
(FNS PressBcpl PressDblWord PressPadPage PressPoint PressWord TestPress)
(FNS PressClose PressCloseEntity PressClosePage PressEndPart PressExpand PressStartEntity
PressStartPage SETX.PRESS SETXY.PRESS SETY.PRESS SHOW.PRESS)
(FNS PPRIN PressFont \GETPRESSFONTDIRENTRY PressNewLine PressOutFile PressNewPage)
(DECLARE: DONTCOPY (RECORDS FONTDIRENTRY Rectangle Slug))
(VARS (PRESSXSP)
(PRESSYSP)
(PRESSDEFAULTREGION (QUOTE ((2794 . 1905)
19050 . 25400)))
(PRESSPAGEREGION (COPY PRESSDEFAULTREGION))
(PRESSYPOS)
(PRESSLINELEAD 35)
(PRESSELSTRM)
(PRESSPDSTRM)
(PRESSELSTARTBYTE)
(PRESSDLSTART)
(PRESSPARTSTART)
(PRESSBOUNDBOX)
(PRESSENTITYORIGIN))
(GLOBALVARS CPRESSFONTSET# CPRESSFONT PRESSBOUNDBOX PRESSDEFAULTREGION PRESSDLSTART
PRESSELSTARTBYTE PRESSELSTRM PRESSENTITYORIGIN PRESSFONTDIR PRESSLINELEAD
PRESSMAXFONT PRESSMAXFONTSET PRESSOUTFILE PRESSOUTSTRM PRESSPAGEREGION
PRESSPARTSTART PRESSPDSTRM PRESSXSP PRESSYPOS PRESSYSP PRESSPOSITION)
(E (RESETSAVE (RADIX 8)))
(DECLARE: DONTCOPY
(CONSTANTS 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)
(CONSTANTS SetX SetY ShowCharacters)
(CONSTANTS (BYTESPERRECORD 512)
(LISPENTITYTYPE 6)))
(COMS [DECLARE: DONTEVAL@LOAD DOCOPY (P (DEFAULTFONT (QUOTE PRESS)
(QUOTE (GACHA 8))
(QUOTE NEW]
(FNS PRESSFONTPROFILE EMPRESS MAKEPRESS PRESSFILEP PRINTINGHOST millsToMicas)
[VARS (PRESSTABSTOPS (QUOTE (8000]
(ALISTS (PRINTERMODES PRESS))
[DECLARE: DOCOPY DONTEVAL@LOAD (P (FONTSET (QUOTE PARC))
(PRINTERMODE (QUOTE PRESS]
(INITVARS (DEFAULTPRINTINGHOST NIL)
(FULLPRESSPRINTER NIL)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(\FACECODE
[LAMBDA (FACE) (* rmk: "27-FEB-81 12:16")
(IPLUS (SELECTQ (fetch (FONTFACE EXPANSION) of FACE)
(REGULAR 0)
(COMPRESSED 6)
(EXPANDED 12)
(SHOULDNT))
(SELECTQ (fetch (FONTFACE WEIGHT) of FACE)
(MEDIUM 0)
(BOLD 2)
(LIGHT 4)
(SHOULDNT))
(SELECTQ (fetch (FONTFACE SLOPE) of FACE)
(REGULAR 0)
(ITALIC 1)
(SHOULDNT])
(\FAMILYCODE
[LAMBDA (FAMILY WOFD) (* lmm " 1-SEP-81 12:35")
(* Returns the family CODE for FAMILY in a standard widths file, leaving the file positioned at the beginning of the
next file entry. Returns NIL if FAMILY not found.)
(SETFILEPTR WOFD 0)
(bind TYPE CODE LENGTH (NCHARS ←(NCHARS FAMILY))
NEXT←0 do (SETFILEPTR WOFD NEXT)
(SETQ TYPE (\BIN WOFD))
(SETQ LENGTH (\BIN WOFD))
(add NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 17Q)
10Q))
1))
(SELECTQ (LRSH TYPE 4)
[1 (SETQ CODE (\WIN WOFD))
(COND
([AND (EQ NCHARS (\BIN WOFD))
(for I from 1 to NCHARS always (EQ (\BIN WOFD)
(NTHCHARCODE FAMILY I]
(SETFILEPTR WOFD NEXT)
(* Move file to next entry)
(RETURN CODE]
(0 (RETURN NIL))
NIL])
(\FINDFONT
[LAMBDA (FD MSIZE WOFD) (* rmk: "21-OCT-81 13:34")
(* Finds the widths information for the specified FAMILY, FACECODE, MSIZE, and ROTATION. The FIRSTCHAR and LASTCHAR
of the font are filled in, since we have to read past those to check the size. If successful, returns the size found
in the widths file, with zero indicating that dimensions in the widths file are relative, leaving the file pointing
just after the Rotation word of the font. -
Returns NIL if the font is not found)
(bind TYPE LENGTH SIZE FAMILYCODE (ROTATION ←(fetch ROTATION of FD))
(FACECODE ←(\FACECODE (fetch FONTFACE of FD)))
NEXT←0 first (OR (SETQ FAMILYCODE (\FAMILYCODE (fetch FONTFAMILY of FD)
WOFD))
(RETURN NIL))
do (SETQ TYPE (\BIN WOFD))
(SETQ LENGTH (\BIN WOFD))
(add NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
8))
1))
(SELECTQ (LRSH TYPE 4)
[4 (COND
((AND (EQ FAMILYCODE (\BIN WOFD))
(EQ FACECODE (\BIN WOFD)))
(replace FIRSTCHAR of FD with (\BIN WOFD))
(replace LASTCHAR of FD with (\BIN WOFD))
(COND
((AND (OR (ZEROP (SETQ SIZE (\WIN WOFD)))
(EQ MSIZE SIZE))
(EQ ROTATION (\WIN WOFD)))
(replace \SFFACECODE of FD with FACECODE)
(RETURN SIZE]
(0 (RETURN NIL))
NIL)
(SETFILEPTR WOFD NEXT])
(\CREATEPRESSFONT
[LAMBDA (FAMILY PSIZE FACE ROTATION) (* rmk: "23-FEB-82 20:43")
(* Widths array is fully allocated, with zeroes for
characters with no information.
An array is not allocated for fixed WidthsY.)
(DECLARE (GLOBALVARS FONTWIDTHSFILES))
(RESETLST (* RESETLST to make sure the fontfiles get closed)
(PROG (WFILE WOFD FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHSY
(WIDTHS (ARRAY (ADD1 \MAXCHAR)
(QUOTE SMALLPOSP)
0 0))
(MSIZE (IQUOTIENT (ITIMES PSIZE 2540)
72))
(FD (create FONTDESCRIPTOR
FONTDEVICE ←(QUOTE PRESS)
FONTFAMILY ← FAMILY
FONTSIZE ← PSIZE
FONTFACE ← FACE
\SFFACECODE ←(\FACECODE FACE)
ROTATION ← ROTATION)))
(OR (for F inside FONTWIDTHSFILES when (INFILEP F)
do [COND
((OPENP F (QUOTE INPUT))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
F
(GETFILEPTR F)))
(SETFILEPTR F 0))
(T (RESETSAVE (SETQ WFILE (OPENFILE F (QUOTE INPUT)
(QUOTE OLD)
8))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(SETQ WOFD (\GETOFD WFILE))
(AND (SETQ RELFLAG (\FINDFONT FD MSIZE WOFD))
(RETURN T)))
(RETURN NIL))
(SETQ RELFLAG (ZEROP RELFLAG))
(SETFILEPTR WOFD (LLSH (INTIN WOFD)
1)) (* Locate the segment)
(replace FBBOX of FD with (SIGNED (\WIN WOFD)
BITSPERWORD))
(replace \SFDescent of FD with (IMINUS (SIGNED (\WIN WOFD)
BITSPERWORD)))
(* Descent is -FBBOY)
(replace FBBDX of FD with (SIGNED (\WIN WOFD)
BITSPERWORD))
(replace \SFHeight of FD with (SIGNED (\WIN WOFD)
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)
MSIZE)
1000))
(replace \SFDescent of FD with (IQUOTIENT (ITIMES (fetch \SFDescent
of FD)
MSIZE)
1000))
(replace FBBDX of FD with (IQUOTIENT (ITIMES (fetch FBBDX
of FD)
MSIZE)
1000))
(replace \SFHeight of FD with (IQUOTIENT (ITIMES (fetch \SFHeight
of FD)
MSIZE)
1000]
(replace \SFAscent of FD with (IDIFFERENCE (fetch \SFHeight of FD)
(fetch \SFDescent of FD)))
(SETQ FIXEDFLAGS (LRSH (\BIN WOFD)
6)) (* The fixed flags)
(\BIN WOFD) (* Skip the spares)
[COND
((EQ 2 (LOGAND FIXEDFLAGS 2))
(SETQ TEM (\WIN WOFD)) (* The fixed width for this font)
[COND
((AND RELFLAG (NOT (ZEROP TEM)))
(SETQ TEM (IQUOTIENT (ITIMES TEM MSIZE)
1000]
(for I from FIRSTCHAR to LASTCHAR do (SETA WIDTHS I TEM)))
(T (AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
WOFD)
(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)
MSIZE)
1000]
[COND
[(EQ 1 (LOGAND FIXEDFLAGS 1))
(SETQ WIDTHSY (\WIN WOFD)) (* 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 MSIZE)
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))
WOFD)
(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)
MSIZE)
1000]
(RETURN FD])
)
(RPAQ? FONTWIDTHSFILES (SELECTQ (SYSTEMTYPE)
(D (QUOTE ({INDIGO}<FONTS>FONTS.WIDTHS)))
(QUOTE (<FONTS>FONTS.WIDTHS))))
(RPAQ? EMPRESS.SCRATCH (QUOTE (30 {DSK}EMPRESS.SCRATCH)))
(RPAQ? EMPRESS#SIDES T)
(DEFINEQ
(INTIN
[LAMBDA (OFD) (* lmm " 1-SEP-81 12:37")
(* Read in a full 40Q bit integer)
(LOGOR (LLSH (\WIN OFD)
20Q)
(\WIN OFD])
)
(DECLARE: DOCOPY
(DECLARE: EVAL@LOADWHEN (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
T)
NIL)
(FILESLOAD (SYSLOAD FROM BLISP)
DCODEFOR10)
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ noInfoCode 32768)
(CONSTANTS noInfoCode)
)
)
(DEFINEQ
(PRESSBITMAP
[LAMBDA (FILE BITMAP SCALEFACTOR CLIPPINGREGION) (* rmk: "27-JUL-83 20:34")
(PROG (PADDING REC PRESSFILE PRESSOFD)
(OR BITMAP (SETQ BITMAP (SCREENBITMAP)))
(SETQ PRESSOFD (\GETOFD [SETQ PRESSFILE (OPENFILE FILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(QUOTE OUTPUT)))
(SETQ PADDING (\WRITEPRESSBITMAP BITMAP SCALEFACTOR CLIPPINGREGION))
(SETQ REC (IQUOTIENT (GETFILEPTR PRESSFILE)
512))
(WRITEFONTDIRECTORY) (* Write the part DIRECTORY)
(PRESSBYTES (QUOTE (0 0 0 0)))
(PRESSWORD REC)
(PRESSWORD PADDING)
(PRESSWORD 1)
(PRESSWORD REC)
(PRESSWORD 1)
(MOVETOREC) (* Write the document DIRECTORY)
(PRESSWORD 27183)
(PRESSWORD (IPLUS 3 REC))
(PRESSWORD 2)
(PRESSWORD (ADD1 REC))
(PUTPRESSLIST (QUOTE (1 -1 -1 -1 1 1)))
(MOVETOREC)
(RETURN (CLOSEF PRESSFILE])
(\WRITEPRESSBITMAP
[LAMBDA (BITMAP SCALEFACTOR CLIPPINGREGION) (* lmm "15-OCT-82 14:50")
[IF CLIPPINGREGION
THEN (* UGH)
(SETQ BITMAP (PROG ((BM (BITMAPCREATE CLIPPINGREGION:WIDTH CLIPPINGREGION:HEIGHT)))
(with REGION CLIPPINGREGION
(BITBLT BITMAP LEFT BOTTOM BM NIL NIL WIDTH HEIGHT))
(RETURN BM]
(PROG ((WW (fetch BITMAPRASTERWIDTH of BITMAP))
(HT (fetch BITMAPHEIGHT of BITMAP))
BITMAPADDRESS MICAWIDTH MICAHEIGHT T1 T2 TOTCOUNT)
(COND
((NULL SCALEFACTOR)
(SETQ SCALEFACTOR 1.0)))
(PRESSWORD 256) (* Edotcode)
(PRESSWORD (ITIMES 16 WW)) (* Width)
(PRESSWORD HT) (* Height)
(PRESSWORD (IPLUS 512 3)) (* Edotmode and 3)
(PRESSWORD 2) (* Edotsize)
[PRESSWORD (SETQ MICAWIDTH (FIX (FTIMES SCALEFACTOR (ITIMES 32 (TIMES BITSPERWORD WW]
[PRESSWORD (SETQ MICAHEIGHT (FIX (FTIMES SCALEFACTOR (ITIMES 32 HT]
(PRESSWORD 1) (* Edotwindow)
(PRESSWORD 0)
(PRESSWORD (ITIMES WW 16))
(PRESSWORD 0)
(PRESSWORD HT)
(PRESSWORD 3) (* Edotsfollow)
[\BOUTS PRESSOFD (fetch BITMAPBASE of BITMAP)
0
(ITIMES 2 (SETQ TOTCOUNT (ITIMES HT WW]
(PRESSWORD 0) (* Entity list terminator)
(PRESSWORD (IPLUS 65280 238)) (* Nop, setx)
(PRESSWORD 0)
(PRESSWORD (IPLUS 65280 239)) (* Nop, sety)
(PRESSWORD 0)
(PRESSWORD (IPLUS 65280 252)) (* Nop, show dots)
(PRESSWORD 0)
(PRESSWORD (IPLUS TOTCOUNT 13)) (* Now write out the entity trailer)
(PUTPRESSLIST (QUOTE (0 0 0 0)))
(PRESSWORD (ITIMES (IPLUS TOTCOUNT 13)
2))
(PRESSWORD (LOGAND 65024 (IQUOTIENT (IDIFFERENCE (ITIMES 85 254)
MICAWIDTH)
2)))
(PRESSWORD (LOGAND 65024 (IQUOTIENT (IDIFFERENCE (ITIMES 110 254)
MICAHEIGHT)
2)))
(PUTPRESSLIST (QUOTE (0 0)))
(PRESSWORD MICAWIDTH)
(PRESSWORD MICAHEIGHT)
(PRESSWORD 19)
(RETURN (MOVETOREC])
(WRITEFONTDIRECTORY
[LAMBDA NIL (* lmm "19-SEP-80 11:55")
(* Put out a single font entry, for helvetica 10)
(PUTPRESSLIST (QUOTE (16 0 127)))
[PRESSBYTES (CONSTANT (CONS (NCHARS (QUOTE HELVETICA))
(CHCON (QUOTE HELVETICA]
(PUTPRESSLIST (QUOTE (0 0 0 0 0 0 10 0 0)))
(MOVETOREC])
(MOVETOREC
[LAMBDA NIL (* lmm "19-SEP-80 10:21")
(PROG (CP NP)
(SETQ CP (GETFILEPTR PRESSFILE))
(SETQ NP (LOGAND (IPLUS CP 511)
-512))
(FRPTQ (SETQ NP (IDIFFERENCE NP CP))
(BOUT PRESSOFD 0))
(RETURN (LRSH NP 1])
(PRESSSCALEFACTOR
[LAMBDA (X Y) (* lmm "12-JUN-83 02:15")
(AND FULLPRESSPRINTER (MIN (FQUOTIENT (PROG1 808 (* MAXPRESSHEIGHT))
Y)
(FQUOTIENT (PROG1 615 (* MAXPRESSWIDTH))
X)
(PROG1 2 (* MAXPRESSRATIO)])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS PRESSBYTES MACRO ((L)
(for X in L do (BOUT PRESSOFD X))))
(PUTPROPS PRESSWORD MACRO [LAMBDA (N)
(BOUT PRESSOFD (LRSH (LOGAND N 65535)
8))
(BOUT PRESSOFD (LOGAND N 255])
(PUTPROPS PUTPRESSLIST MACRO ((L)
(for X in L do (PRESSWORD X))))
)
)
(DEFINEQ
(PressBcpl
[LAMBDA (OFD X N) (* rmk: " 2-MAR-81 15:12")
(* 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 OFD NC)
(for I from 1 to NC do (\BOUT OFD (NTHCHARCODE X I)))
(for I from (ADD1 NC) to N do (\BOUT OFD 0])
(PressDblWord
[LAMBDA (OFD D) (* rmk: " 2-MAR-81 15:16")
(\BOUT OFD (LOGAND 255 (LRSH D 24)))
(\BOUT OFD (LOGAND 255 (LRSH D 16)))
(\BOUT OFD (LOGAND 255 (LRSH D 8)))
(\BOUT OFD (LOGAND 255 D])
(PressPadPage
[LAMBDA (OFD) (* rmk: "21-MAY-81 15:25")
(* Move the fileptr to the next record boundary,
returning the number of words skipped.)
(PROG (PADDING (P (GETFILEPTR OFD)))
(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 OFD (IPLUS P (SUB1 PADDING]
(\BOUT OFD 0)))
(RETURN (FOLDLO PADDING BYTESPERWORD])
(PressPoint
[LAMBDA (OFD P) (* rmk: " 3-MAY-81 15:37")
(PressWord OFD (fetch XCOORD of P))
(PressWord OFD (fetch YCOORD of P])
(PressWord
[LAMBDA (OFD W) (* rmk: " 2-MAR-81 15:15")
(\BOUT OFD (LOGAND \CHARMASK (LRSH W 8)))
(\BOUT OFD (LOGAND \CHARMASK W])
(TestPress
[LAMBDA NIL (* rmk: "25-SEP-81 22:46")
(PROG (R)
(SETQ R (PressOutFile (QUOTE TEST.PRESS)
T
(FONTCREATE (QUOTE GACHA)
10 NIL NIL (QUOTE PRESS))
1 "Test Headline Gacha 10"))
(PressFont (FONTCREATE (QUOTE TIMESROMAN)
10 NIL NIL (QUOTE PRESS)))
(PPRIN (CHCON "Test text Timesroman 10")
NIL 23)
(PressNewLine R)
(PPRIN (CHCON "Second line")
NIL 11)
(PressClose])
)
(DEFINEQ
(PressClose
[LAMBDA (FILENAME) (* rmk: " 1-APR-82 16:57")
(* FILENAME is for the printer break page)
(PressClosePage)
(COND
((NOT (ZEROP (GETFILEPTR PRESSPDSTRM)))
(for FDE DESCR in PRESSFONTDIR as I from 0 do (SETQ DESCR (fetch DESCR of FDE))
(PressWord PRESSOUTSTRM 16)
(\BOUT PRESSOUTSTRM (fetch FONTSET#
of FDE))
(* Fontset)
(\BOUT PRESSOUTSTRM (fetch FONT# of FDE))
(* font#)
(\BOUT PRESSOUTSTRM (fetch FIRSTCHAR
of DESCR))
(\BOUT PRESSOUTSTRM (fetch LASTCHAR
of DESCR))
(PressBcpl PRESSOUTSTRM (fetch FONTFAMILY
of DESCR)
20)
(\BOUT PRESSOUTSTRM (fetch \SFFACECODE
of DESCR))
(\BOUT PRESSOUTSTRM (fetch FIRSTCHAR
of DESCR))
(PressWord PRESSOUTSTRM (fetch FONTSIZE
of DESCR))
(PressWord PRESSOUTSTRM (fetch ROTATION
of DESCR)))
(PressWord PRESSOUTSTRM 0) (* Font part ends with 0 word)
(PressEndPart 1 PRESSPARTSTART)
(COPYBYTES PRESSPDSTRM PRESSOUTSTRM 0 (GETFILEPTR PRESSPDSTRM))
(PressPadPage PRESSOUTSTRM)
(PROG (DDRECORD (DDFILEPTR (GETFILEPTR PRESSOUTSTRM)))
(* Write document directory)
(SETQ DDRECORD (FOLDLO DDFILEPTR BYTESPERRECORD))
(PressWord PRESSOUTSTRM 27183) (* password)
(PressWord PRESSOUTSTRM (ADD1 DDRECORD))
(PressWord PRESSOUTSTRM (FOLDLO (GETFILEPTR PRESSPDSTRM)
8)) (* number of parts, since each occupies 8 bytes in PD)
(PressWord PRESSOUTSTRM PRESSPARTSTART) (* part directory)
(PressWord PRESSOUTSTRM (IDIFFERENCE DDRECORD PRESSPARTSTART))
(PressWord PRESSOUTSTRM -1) (* obselete)
(PressDblWord PRESSOUTSTRM (LISP.TO.ALTO.DATE (IDATE)))
(PressWord PRESSOUTSTRM 1)
(PressWord PRESSOUTSTRM 1) (* copies)
(PressWord PRESSOUTSTRM -1)
(PressWord PRESSOUTSTRM -1) (* first and last pages)
(PressWord PRESSOUTSTRM -1) (* printing mode default)
(SETFILEPTR PRESSOUTSTRM (IPLUS DDFILEPTR 256))
(PressBcpl PRESSOUTSTRM FILENAME 52)
(PressBcpl PRESSOUTSTRM USERNAME 32)
(PressBcpl PRESSOUTSTRM (GETFILEINFO PRESSOUTSTRM (QUOTE CREATIONDATE))
40)
(PressPadPage PRESSOUTSTRM))
(CLOSEF PRESSOUTSTRM])
(PressCloseEntity
[LAMBDA (ETYPE) (* rmk: "16-DEC-82 17:43")
(COND
((IGREATERP (GETFILEPTR PRESSELSTRM)
PRESSELSTARTBYTE)
(COND
((ODDP (GETFILEPTR PRESSELSTRM))
(\BOUT PRESSELSTRM NopCode)))
(\BOUT PRESSELSTRM (OR ETYPE LISPENTITYTYPE))
(\BOUT PRESSELSTRM CPRESSFONTSET#) (* fontset)
(PressDblWord PRESSELSTRM (IDIFFERENCE PRESSDLSTART (UNFOLD PRESSPARTSTART BYTESPERRECORD)))
(* part relative start of data list for this entity)
(PressDblWord PRESSELSTRM (IDIFFERENCE (GETFILEPTR PRESSOUTSTRM)
PRESSDLSTART))
(* length of data)
(PressPoint PRESSELSTRM PRESSENTITYORIGIN)
(PressPoint PRESSELSTRM (fetch origin of PRESSBOUNDBOX))
(PressWord PRESSELSTRM (IDIFFERENCE (fetch cornerx of PRESSBOUNDBOX)
(fetch originx of PRESSBOUNDBOX)))
(* width)
(PressWord PRESSELSTRM (IDIFFERENCE (fetch cornery of PRESSBOUNDBOX)
(fetch originy of PRESSBOUNDBOX)))
(* height)
(PressWord PRESSELSTRM (ADD1 (FOLDLO (IDIFFERENCE (GETFILEPTR PRESSELSTRM)
PRESSELSTARTBYTE)
BYTESPERWORD)))
(* Length in words)
(PressStartEntity])
(PressClosePage
[LAMBDA NIL (* rmk: "26-JUN-81 14:44")
(PressCloseEntity)
(COND
((NOT (ZEROP (GETFILEPTR PRESSELSTRM)))
(COND
((ODDP (GETFILEPTR PRESSOUTSTRM))
(\BOUT PRESSOUTSTRM 0)))
(PressWord PRESSOUTSTRM 0) (* 0 word to separate DL from EL)
(COPYBYTES PRESSELSTRM PRESSOUTSTRM 0 (GETFILEPTR PRESSELSTRM))
(PressEndPart 0 PRESSPARTSTART])
(PressEndPart
[LAMBDA (pn start) (* rmk: "21-MAY-81 15:25")
(PROG ((pad (PressPadPage PRESSOUTSTRM)))
(PressWord PRESSPDSTRM pn)
(PressWord PRESSPDSTRM start)
(PressWord PRESSPDSTRM (IDIFFERENCE (SETQ PRESSPARTSTART (FOLDLO (GETFILEPTR PRESSOUTSTRM)
BYTESPERRECORD))
start))
(PressWord PRESSPDSTRM pad)
(PressStartPage])
(PressExpand
[LAMBDA (X) (* rmk: "20-MAR-82 15:49")
(COND
(X (PROG ((SLUG (create Slug)))
(replace charCodes of SLUG with (CHCON X))
(replace nChars of SLUG with (LENGTH (fetch charCodes of SLUG)))
(replace totalWidth of SLUG with (STRINGWIDTH X CPRESSFONT))
(RETURN SLUG])
(PressStartEntity
[LAMBDA NIL (* rmk: "16-DEC-82 17:50")
(SETQ PRESSDLSTART (GETFILEPTR PRESSOUTSTRM))
(SETQ PRESSELSTARTBYTE (GETFILEPTR PRESSELSTRM))
(SETQ PRESSBOUNDBOX NIL) (* cannot last or error will result)
(SETQ PRESSENTITYORIGIN (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
(SETQ PRESSXSP (SETQ PRESSYSP NIL))
(SETQ CPRESSFONT NIL)
(SETQ CPRESSFONTSET# NIL])
(PressStartPage
[LAMBDA NIL (* rmk: "18-FEB-81 21:58")
(SETFILEPTR PRESSELSTRM 0)
(PressStartEntity])
(SETX.PRESS
[LAMBDA (X) (* edited: "31-MAY-83 12:39")
(\BOUT PRESSELSTRM SetXCode)
(PressWord PRESSELSTRM X])
(SETXY.PRESS
[LAMBDA (X Y) (* edited: "31-MAY-83 12:38")
(\BOUT PRESSELSTRM SetXCode)
(PressWord PRESSELSTRM X)
(\BOUT PRESSELSTRM SetYCode)
(PressWord PRESSELSTRM Y])
(SETY.PRESS
[LAMBDA (Y) (* edited: "31-MAY-83 12:39")
(\BOUT PRESSELSTRM SetYCode)
(PressWord PRESSELSTRM Y])
(SHOW.PRESS
[LAMBDA (CNT) (* edited: "31-MAY-83 12:47")
(COND
((IGREATERP CNT 0)
(COND
((ILESSP CNT 33) (* short form)
(\BOUT PRESSELSTRM (IPLUS ShowCharactersShortCode CNT -1)))
(T (* Break up every 255)
(while (IGREATERP CNT 255)
do (\BOUT PRESSELSTRM ShowCharactersCode)
(\BOUT PRESSELSTRM 255)
(SETQ CNT (IDIFFERENCE CNT 255))
finally (\BOUT PRESSELSTRM ShowCharactersCode)
(\BOUT PRESSELSTRM CNT])
)
(DEFINEQ
(PPRIN
[LAMBDA (CHARS W N REGION) (* edited: "31-MAY-83 12:25")
(COND
((AND W REGION (IGREATERP (IPLUS PRESSPOSITION W)
(fetch cornerx of REGION)))
(PressNewLine REGION)))
(for c in CHARS do (\BOUT PRESSOUTSTRM c))
(COND
(N (SHOW.PRESS N)))
(COND
(W (add PRESSPOSITION W])
(PressFont
[LAMBDA (FD) (* rmk: "20-MAR-82 17:03")
(OR (EQ FD CPRESSFONT)
(AND FD (PROG ((FDE (\GETPRESSFONTDIRENTRY FD)))
[COND
((EQ (fetch FONTSET# of FDE)
CPRESSFONTSET#))
(T (* Switch fontsets. Have to switch entities if we've
already been printing in another fontset.)
(AND CPRESSFONTSET# (PressCloseEntity))
(SETQ CPRESSFONTSET# (fetch FONTSET# of FDE]
(SETQ CPRESSFONT FD)
(\BOUT PRESSELSTRM (LOGOR FontCode (fetch FONT# of FDE])
(\GETPRESSFONTDIRENTRY
[LAMBDA (FD) (* rmk: "20-MAR-82 15:32")
(OR (FASSOC FD PRESSFONTDIR)
(CAR (push PRESSFONTDIR (PROGN (COND
((EQ PRESSMAXFONT 15)
(add PRESSMAXFONTSET 1)
(SETQ PRESSMAXFONT 0))
(T (add PRESSMAXFONT 1)))
(create FONTDIRENTRY
DESCR ← FD
FONT# ← PRESSMAXFONT
FONTSET# ← PRESSMAXFONTSET])
(PressNewLine
[LAMBDA (REGION) (* edited: "31-MAY-83 12:35")
(PROG (YPOS)
(replace cornery of REGION with (IDIFFERENCE (IDIFFERENCE (fetch cornery of REGION)
(fetch \SFHeight of CPRESSFONT))
PRESSLINELEAD))
(COND
((ILESSP (SETQ YPOS (IDIFFERENCE (fetch cornery of REGION)
(fetch \SFHeight of CPRESSFONT)))
(fetch originy of REGION))
(PressFont (PROG1 CPRESSFONT
(* A Page starts with a new entity, which is not defined to have a particular fontset. We make sure we continue in
our current font/fontset)
(PressClosePage)
(PressStartPage)))
(PressNewPage REGION))
(T (SETXY.PRESS (SETQ PRESSPOSITION (fetch originx of REGION))
(IPLUS YPOS (fetch \SFDescent of CPRESSFONT])
(PressOutFile
[LAMBDA (PFILE REGION FONT PAGE HEADLINE) (* rmk: "27-JUL-83 20:34")
(* Opens a press output file, plus a temporary part-file. FONT is the initial and heading font, PAGE is the
initial page number if numbering is desired, and HEADLINE is a string to be placed at the top of each page.)
[RESETSAVE [SETQ PRESSOUTFILE (OPENFILE PFILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(QUOTE (AND RESETSTATE (PROGN (CLOSEF? OLDVALUE)
(DELFILE OLDVALUE]
(SETQ PRESSOUTSTRM (\GETOFD PRESSOUTFILE (QUOTE OUTPUT)))
[RESETSAVE [SETQ PRESSPDSTRM (\GETOFD (OPENFILE (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(QUOTE PRESSPDSTRM;S))
(PACKFILENAME (QUOTE NAME)
(QUOTE PRESSPDSTRM)
(QUOTE BODY)
PRESSOUTFILE))
(QUOTE BOTH)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(QUOTE (PROGN (DELFILE (CLOSEF? OLDVALUE]
[RESETSAVE [SETQ PRESSELSTRM (\GETOFD (OPENFILE (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(QUOTE PRESSELSTRM;S))
(PACKFILENAME (QUOTE NAME)
(QUOTE PRESSELSTRM)
(QUOTE BODY)
PRESSOUTFILE))
(QUOTE BOTH)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(QUOTE (PROGN (DELFILE (CLOSEF? OLDVALUE]
(SETQ PRESSFONTDIR NIL)
(SETQ PRESSMAXFONT -1)
(SETQ PRESSMAXFONTSET 0)
(SETQ PRESSPARTSTART 0)
(PressStartPage)
[PressFont (SETQ FONT (FONTCREATE FONT NIL NIL NIL (QUOTE PRESS]
(COND
(REGION [SETQ PRESSPAGENO (COND
(PAGE (SUB1 (OR (FIXP PAGE)
0]
(SETQ PRESSHEADFONT FONT) (* PRESSHEADFONT is a font descriptor)
(SETQ PRESSHEADLINE (PressExpand HEADLINE))
(SETQ PRESSPAGEREGION (OR (LISTP REGION)
PRESSDEFAULTREGION)))
(T (SETQ PRESSPAGENO NIL)
(SETQ PRESSHEADLINE NIL)
(SETQ PRESSPAGEREGION PRESSDEFAULTREGION)))
(PressNewPage (create Rectangle])
(PressNewPage
[LAMBDA (REGION) (* edited: "31-MAY-83 12:44")
(PROG ((OLDFONT CPRESSFONT))
(COND
((OR PRESSHEADLINE PRESSPAGENO) (* heading line to be printed)
(replace originx of REGION with (fetch originx of PRESSPAGEREGION))
(replace originy of REGION with (fetch cornery of PRESSPAGEREGION))
(replace cornerx of REGION with (fetch cornerx of PRESSPAGEREGION))
(replace cornery of REGION with (IPLUS (fetch cornery of PRESSPAGEREGION)
1270))
(SETQ PRESSBOUNDBOX REGION) (* half inch up)
(PressFont PRESSHEADFONT)
(SETY.PRESS (IDIFFERENCE (fetch cornery of REGION)
(fetch \SFAscent of PRESSHEADFONT)))
[COND
(PRESSHEADLINE (SETX.PRESS (fetch originx of PRESSBOUNDBOX))
(PPRIN (fetch charCodes of PRESSHEADLINE)
NIL
(fetch nChars of PRESSHEADLINE]
[COND
(PRESSPAGENO (PROG [(N (CHCON (add PRESSPAGENO 1]
(SETX.PRESS (IDIFFERENCE (fetch cornerx of PRESSBOUNDBOX)
(STRINGWIDTH PRESSPAGENO PRESSHEADFONT)))
(PPRIN N NIL (LENGTH N]
(PressCloseEntity)
(PressFont OLDFONT)))
(SETQ PRESSBOUNDBOX PRESSPAGEREGION)
(replace cornerx of REGION with (fetch cornerx of PRESSPAGEREGION))
(SETXY.PRESS (replace originx of REGION with (fetch originx of PRESSPAGEREGION))
(IDIFFERENCE (replace cornery of REGION with (fetch cornery of PRESSPAGEREGION)
)
(fetch \SFAscent of CPRESSFONT)))
(replace originy of REGION with (fetch originy of PRESSPAGEREGION))
(SETQ PRESSPOSITION 0)
(RETURN REGION])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD FONTDIRENTRY (DESCR FONT# FONTSET#))
(RECORD Rectangle (origin . corner)
(RECORD origin (originx . originy)
originx ← 0 originy ← 0)
(RECORD corner (cornerx . cornery)
cornerx ← 0 cornery ← 0))
(RECORD Slug (nChars totalWidth . charCodes))
]
)
(RPAQQ PRESSXSP NIL)
(RPAQQ PRESSYSP NIL)
(RPAQQ PRESSDEFAULTREGION ((2794 . 1905)
19050 . 25400))
(RPAQ PRESSPAGEREGION (COPY PRESSDEFAULTREGION))
(RPAQQ PRESSYPOS NIL)
(RPAQQ PRESSLINELEAD 35)
(RPAQQ PRESSELSTRM NIL)
(RPAQQ PRESSPDSTRM NIL)
(RPAQQ PRESSELSTARTBYTE NIL)
(RPAQQ PRESSDLSTART NIL)
(RPAQQ PRESSPARTSTART NIL)
(RPAQQ PRESSBOUNDBOX NIL)
(RPAQQ PRESSENTITYORIGIN NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS CPRESSFONTSET# CPRESSFONT PRESSBOUNDBOX PRESSDEFAULTREGION PRESSDLSTART
PRESSELSTARTBYTE PRESSELSTRM PRESSENTITYORIGIN PRESSFONTDIR PRESSLINELEAD PRESSMAXFONT
PRESSMAXFONTSET PRESSOUTFILE PRESSOUTSTRM PRESSPAGEREGION PRESSPARTSTART PRESSPDSTRM
PRESSXSP PRESSYPOS PRESSYSP PRESSPOSITION)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(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 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)
(CONSTANTS SetX SetY ShowCharacters)
)
(DECLARE: EVAL@COMPILE
(RPAQQ BYTESPERRECORD 1000Q)
(RPAQQ LISPENTITYTYPE 6)
(CONSTANTS (BYTESPERRECORD 1000Q)
(LISPENTITYTYPE 6))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(DEFAULTFONT (QUOTE PRESS)
(QUOTE (GACHA 10Q))
(QUOTE NEW))
)
(DEFINEQ
(PRESSFONTPROFILE
[LAMBDA (CLASSES) (* rmk: "23-NOV-81 16:13")
(* Called via FONTSETUPFNS from FONTPROFILE, with CLASSES a list of (classname font# displayfont pressfont) This
function sets up and caches the number to font mappings for)
(FONTMAPARRAY (for C in CLASSES collect (LIST (CADR C)
(CADDDR C)))
(QUOTE PRESS])
(EMPRESS
[LAMBDA (FILE COPIES HOST HEADING #SIDES) (* rmk: " 8-JUL-82 00:08")
(* Returns file name if successful, NIL if not. The RESETLST makes sure the scratch file, if any, is deleted.
-
If FILE has to be converted to a press file and HEADING=NIL, then the filename is used as the heading;
if T, then no heading is printed; otherwise, HEADING is used as the heading. EMPRESS.SCRATCH sets a limit on the
size of the file that will be converted to a CORE press file so as not to use up too much virtual memory with CORE
pages.)
(DECLARE (GLOBALVARS EMPRESS.SCRATCH EMPRESS#SIDES))
(RESETLST (PROG (VAL PFILE FULLFILE)
(COND
((SETQ PFILE (PRESSFILEP FILE))
(SETQ FULLFILE PFILE))
(T [RESETSAVE (SETQ FULLFILE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
10Q))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(* Open here to set FULLFILE for size check below)
[RESETSAVE (SETQ PFILE (CADR (MAKEPRESS
FULLFILE
(COND
[(AND (FIXP (CAR (LISTP EMPRESS.SCRATCH)))
(IGREATERP (GETFILEINFO FULLFILE
(QUOTE SIZE))
(CAR EMPRESS.SCRATCH))
(CAR (LISTP (CDR EMPRESS.SCRATCH]
(T (QUOTE {CORE}EMPRESS.SCRATCH)))
NIL HEADING)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(DELFILE OLDVALUE]
(* Note that PressOutFile guarantees that the file is
deleted if MAKEPRESS is aborted, so we only worry about
the successful case.)
))
(COND
([NLISTP (SETQ VAL (EFTP (OR HOST (PRINTINGHOST))
PFILE
(OR (FIXP COPIES)
1)
(OR #SIDES EMPRESS#SIDES]
(* VAL is the name of the actual press file, but we want
to return the name of the user-specified file.)
(RETURN FULLFILE))
(T (LISPXPRIN1 (CDR VAL)
T)
(LISPXTERPRI T)
(RETURN NIL])
(MAKEPRESS
[LAMBDA (FILE PFILE FONTS HEADING TABS) (* rmk: " 5-JUL-83 18:43")
(DECLARE (GLOBALVARS PRESSTABSTOPS))
(RESETLST (PROG [REGION INSTRM IN MTABS (FA (FONTMAPARRAY FONTS (QUOTE PRESS]
(* FA is an array of font-descriptors)
[RESETSAVE (SETQ IN (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
10Q
(PROGN (QUOTE ((SEQUENTIAL T)))
(* NIL until sequential streams do end-of-stream
properly)
NIL)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[SETQ REGION (PressOutFile (OR PFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE PRESS)
(QUOTE BODY)
IN))
(NEQ HEADING T)
(ELT FA 1)
1
(OR HEADING (CONCAT IN " " (GETFILEINFO
IN
(QUOTE CREATIONDATE]
(SETQ INSTRM (\GETOFD IN (QUOTE INPUT)))
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION NILL))
(* Make \BIN return NIL on EOS)
(bind C FC (CCNT ← 0)
(MAXFONT ←(ARRAYSIZE FA)) while (SETQ C (\BIN INSTRM))
do [COND
([IGREATERP C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (↑F CR ↑L TAB]
(\BOUT PRESSOUTSTRM C)
(add CCNT 1))
(T (SELCHARQ C
[↑F (* Font shift)
(SHOW.PRESS CCNT)
(SETQ CCNT 0)
(SELCHARQ (SETQ FC (\BIN INSTRM))
[↑T
(* tab to absolute pos.)
(COND
((SETQ FC (\BIN INSTRM))
[OR MTABS (SETQ MTABS
(for TAB
in (OR TABS PRESSTABSTOPS)
collect (millsToMicas TAB]
(SETQ FC
(OR (CAR (NTH MTABS FC))
(ERROR
"Undefined absolute tab number"
FC)))
(SETX.PRESS (SETQ PRESSPOSITION FC)))
(T
(* EOS after ↑T)
(\BOUT PRESSOUTSTRM (CHARCODE ↑F))
(\BOUT PRESSOUTSTRM (CHARCODE ↑T))
(add CCNT 2]
(NIL (\BOUT PRESSOUTSTRM (CHARCODE ↑F))
(* EOS after ↑F)
(add CCNT 1))
(COND
((AND (IGEQ MAXFONT FC)
(NEQ FC 0))
(PressFont (ELT FA FC)))
(T (\BOUT PRESSOUTSTRM (CHARCODE ↑F))
(\BOUT PRESSOUTSTRM FC)
(SETQ CCNT 2]
(CR (SHOW.PRESS CCNT)
(SETQ CCNT 0)
(PressNewLine REGION))
(↑L (SHOW.PRESS CCNT)
(SETQ CCNT 0)
(PressFont (PROG1 CPRESSFONT (PressClosePage)
(PressStartPage)))
(PressNewPage REGION))
(TAB (FRPTQ 10Q (\BOUT PRESSOUTSTRM (CHARCODE SPACE)))
(add CCNT 10Q))
(PROGN (\BOUT PRESSOUTSTRM C)
(add CCNT 1]
finally (SHOW.PRESS CCNT))
(RETURN (LIST (CLOSEF IN)
(PressClose IN])
(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])
(PRINTINGHOST
[LAMBDA (NEEDFULLPRESS) (* lmm "12-JUN-83 02:08")
(DECLARE (SPECVARS NEEDFULLPRESS))
(EVAL PRINTINGHOSTFORM])
(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])
)
(RPAQQ PRESSTABSTOPS (17500Q))
(ADDTOVAR PRINTERMODES (PRESS (PRINTER.BITMAPFILE . PRESSBITMAP)
((MOVD (QUOTE EMPRESS)
(QUOTE LISTFILES1)))
(PRINTINGHOSTFORM OR (AND NEEDFULLPRESS FULLPRESSPRINTER)
DEFAULTPRINTINGHOST)
(PRINTER.SENDTOPRINTER . EFTP)
(PRINTER.BITMAPSCALE . PRESSSCALEFACTOR)
(TEditHcpyMode . INTERPRESS)))
(DECLARE: DOCOPY DONTEVAL@LOAD
(FONTSET (QUOTE PARC))
(PRINTERMODE (QUOTE PRESS))
)
(RPAQ? DEFAULTPRINTINGHOST NIL)
(RPAQ? FULLPRESSPRINTER NIL)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS PRESS COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6420Q 25663Q (\FACECODE 6432Q . 7365Q) (\FAMILYCODE 7367Q . 11214Q) (\FINDFONT 11216Q
. 14156Q) (\CREATEPRESSFONT 14160Q . 25661Q)) (26224Q 26551Q (INTIN 26236Q . 26547Q)) (27155Q 40550Q
(PRESSBITMAP 27167Q . 31344Q) (\WRITEPRESSBITMAP 31346Q . 36437Q) (WRITEFONTDIRECTORY 36441Q . 37311Q)
(MOVETOREC 37313Q . 40014Q) (PRESSSCALEFACTOR 40016Q . 40546Q)) (41332Q 46103Q (PressBcpl 41344Q .
42333Q) (PressDblWord 42335Q . 42743Q) (PressPadPage 42745Q . 44214Q) (PressPoint 44216Q . 44540Q) (
PressWord 44542Q . 45036Q) (TestPress 45040Q . 46101Q)) (46104Q 65304Q (PressClose 46116Q . 53755Q) (
PressCloseEntity 53757Q . 57000Q) (PressClosePage 57002Q . 57723Q) (PressEndPart 57725Q . 60653Q) (
PressExpand 60655Q . 61520Q) (PressStartEntity 61522Q . 62531Q) (PressStartPage 62533Q . 63004Q) (
SETX.PRESS 63006Q . 63270Q) (SETXY.PRESS 63272Q . 63660Q) (SETY.PRESS 63662Q . 64144Q) (SHOW.PRESS
64146Q . 65302Q)) (65305Q 102131Q (PPRIN 65317Q . 66120Q) (PressFont 66122Q . 67311Q) (
\GETPRESSFONTDIRENTRY 67313Q . 70223Q) (PressNewLine 70225Q . 72101Q) (PressOutFile 72103Q . 76175Q) (
PressNewPage 76177Q . 102127Q)) (110040Q 126025Q (PRESSFONTPROFILE 110052Q . 110720Q) (EMPRESS 110722Q
. 115100Q) (MAKEPRESS 115102Q . 123430Q) (PRESSFILEP 123432Q . 125037Q) (PRINTINGHOST 125041Q .
125325Q) (millsToMicas 125327Q . 126023Q)))))
STOP