(FILECREATED " 8-NOV-83 17:02:45" {PHYLUM}<LISPCORE>SOURCES>PRESS.;42 127176Q
changes to: (FNS MAKEPRESS)
previous date: "31-OCT-83 08:42:20" {PHYLUM}<LISPCORE>SOURCES>PRESS.;41)
(* Copyright (c) 1981, 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS [(COMS (FNS SHOWRECTANGLE.PRESS \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)
(DECLARE: DONTCOPY (MACROS PRESSBYTES PRESSWORD PUTPRESSLIST)))
(FNS PressBcpl PressDblWord PressPadPage PressPoint PressWord)
(FNS PressClose PressCloseEntity PressClosePage PressEndPart PressExpand PressStartEntity
PressStartPage SETX.PRESS SETXY.PRESS SETY.PRESS SHOW.PRESS)
(DECLARE: DONTCOPY (MACROS NEWLINE.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 (FNS PRESSFONTPROFILE MAKEPRESS PRESSFILEP PRESS.BITMAPSCALE millsToMicas)
[VARS (PRESSTABSTOPS (QUOTE (8000]
[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 (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION
ROTATION TITLE]
(PRINTFILETYPES (PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT
(LAMBDA (FILE PFILE FONTS HEADING)
(TEDIT.PRESS.HARDCOPY FILE
PFILE T]
(ADDVARS (FONTSETUPFNS (3 NILL PRESSFONTPROFILE)))
(DECLARE: DOCOPY DONTEVAL@LOAD (P (DEFAULTFONT (QUOTE PRESS)
(QUOTE (GACHA 8))
(QUOTE NEW))
(FONTPROFILE FONTPROFILE)))
(INITVARS (DEFAULTPRINTINGHOST NIL])
(DEFINEQ
(SHOWRECTANGLE.PRESS
[LAMBDA (WIDTH HEIGHT) (* jds "26-SEP-83 14:15")
(\BOUT PRESSELSTRM ShowRectangleCode)
(PressWord PRESSELSTRM WIDTH)
(PressWord PRESSELSTRM HEIGHT])
(\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 DEVICE) (* rmk: "21-SEP-83 17:06")
(* 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 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 ← DEVICE
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])
)
(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])
)
(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])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS NEWLINE.PRESS MACRO (NIL (SHOW.PRESS CCNT)
(SETQ CCNT 0)
(PressNewLine REGION)))
)
)
(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))
)
)
(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])
(MAKEPRESS
[LAMBDA (FILE PFILE FONTS HEADING TABS) (* rmk: " 8-NOV-83 17:02")
(DECLARE (GLOBALVARS PRESSTABSTOPS))
(RESETLST
(PROG [PRSTREAM REGION INSTRM INFILE INEOLC MTABS (FA (FONTMAPARRAY FONTS (QUOTE PRESS]
(* FA is an array of font-descriptors)
[RESETSAVE [SETQ INFILE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
10Q
(QUOTE ((SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[SETQ REGION (PressOutFile (OR PFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE PRESS)
(QUOTE BODY)
INFILE))
(NEQ HEADING T)
(ELT FA 1)
1
(OR HEADING (CONCAT INFILE " " (GETFILEINFO INFILE
(QUOTE
CREATIONDATE]
(SETQ INSTRM (\INSTREAMARG INFILE))
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION NILL))
(SETQ INEOLC (fetch EOLCONVENTION of INSTRM)) (* 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 LF ↑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 (SELECTC INEOLC
(CR.EOLC (NEWLINE.PRESS PRSTREAM))
[CRLF.EOLC (COND
((EQ (CHARCODE LF)
(\PEEKBIN INSTRM T))
(\BIN INSTRM)
(NEWLINE.PRESS PRSTREAM))
(T (SHOW.PRESS CCNT)
(* Move to left margin)
(SETQ CCNT 0)
(SETX.PRESS (SETQ PRESSPOSITION
(fetch originx
of REGION]
(PROGN (SHOW.PRESS CCNT)
(SETQ CCNT 0)
(SETX.PRESS (SETQ PRESSPOSITION
(fetch originx of REGION]
[LF (COND
((EQ INEOLC LF.EOLC)
(NEWLINE.PRESS PRSTREAM))
(T (SHOW.PRESS CCNT)
(* This is a vertical tab--DSPYPOSITION?)
(SETQ CCNT 0)
(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 (SETY.PRESS (IPLUS YPOS (fetch \SFDescent
of CPRESSFONT]
(↑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 INFILE)
(PressClose INFILE])
(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) (* lmm " 3-OCT-83 21:30")
(MIN (FQUOTIENT (PROG1 1450Q (* MAXPRESSHEIGHT))
HEIGHT)
(FQUOTIENT (PROG1 1147Q (* MAXPRESSWIDTH))
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])
)
(RPAQQ PRESSTABSTOPS (17500Q))
(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 (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
(TEDIT.PRESS.HARDCOPY
FILE PFILE T])
(ADDTOVAR FONTSETUPFNS (3 NILL PRESSFONTPROFILE))
(DECLARE: DOCOPY DONTEVAL@LOAD
(DEFAULTFONT (QUOTE PRESS)
(QUOTE (GACHA 10Q))
(QUOTE NEW))
(FONTPROFILE FONTPROFILE)
)
(RPAQ? DEFAULTPRINTINGHOST NIL)
(PUTPROPS PRESS COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7713Q 27470Q (SHOWRECTANGLE.PRESS 7725Q . 10300Q) (\FACECODE 10302Q . 11235Q) (
\FAMILYCODE 11237Q . 13064Q) (\FINDFONT 13066Q . 16026Q) (\CREATEPRESSFONT 16030Q . 27466Q)) (30031Q
30356Q (INTIN 30043Q . 30354Q)) (30762Q 41623Q (PRESSBITMAP 30774Q . 33151Q) (\WRITEPRESSBITMAP 33153Q
. 40244Q) (WRITEFONTDIRECTORY 40246Q . 41116Q) (MOVETOREC 41120Q . 41621Q)) (42405Q 46113Q (PressBcpl
42417Q . 43406Q) (PressDblWord 43410Q . 44016Q) (PressPadPage 44020Q . 45267Q) (PressPoint 45271Q .
45613Q) (PressWord 45615Q . 46111Q)) (46114Q 65314Q (PressClose 46126Q . 53765Q) (PressCloseEntity
53767Q . 57010Q) (PressClosePage 57012Q . 57733Q) (PressEndPart 57735Q . 60663Q) (PressExpand 60665Q
. 61530Q) (PressStartEntity 61532Q . 62541Q) (PressStartPage 62543Q . 63014Q) (SETX.PRESS 63016Q .
63300Q) (SETXY.PRESS 63302Q . 63670Q) (SETY.PRESS 63672Q . 64154Q) (SHOW.PRESS 64156Q . 65312Q)) (
65553Q 102377Q (PPRIN 65565Q . 66366Q) (PressFont 66370Q . 67557Q) (\GETPRESSFONTDIRENTRY 67561Q .
70471Q) (PressNewLine 70473Q . 72347Q) (PressOutFile 72351Q . 76443Q) (PressNewPage 76445Q . 102375Q))
(110134Q 125102Q (PRESSFONTPROFILE 110146Q . 111014Q) (MAKEPRESS 111016Q . 122175Q) (PRESSFILEP
122177Q . 123604Q) (PRESS.BITMAPSCALE 123606Q . 124402Q) (millsToMicas 124404Q . 125100Q)))))
STOP