(FILECREATED "21-Mar-84 15:33:46" {PHYLUM}<LISPUSERS>LANDPRESS.;3 9532
changes to: (FNS LandPressNewPage LANDPRESS)
previous date: "28-JUN-83 13:50:14" {PHYLUM}<LISPUSERS>LANDPRESS.;1)
(PRETTYCOMPRINT LANDPRESSCOMS)
(RPAQQ LANDPRESSCOMS ((FNS LANDFINDFONT LANDPRESS LandPressNewLine LandPressNewPage LANDPPRIN \WIN)
(RECORDS FONTDESCRIPTOR Slug WORD)))
(DEFINEQ
(LANDFINDFONT
(LAMBDA (FD MSIZE WOFD) (* edited: "28-JUN-83 03:42")
(* 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 FAMILYCODE←(\FAMILYCODE FD:FONTFAMILY WOFD) or (RETURN NIL)
do (TYPE←(\BIN WOFD))
(LENGTH←(\BIN WOFD))
(add NEXT (LLSH LENGTH+(LLSH (LOGAND TYPE 15)
8)
1))
(SELECTQ (LRSH TYPE 4)
(4 (if FAMILYCODE=(\BIN WOFD) and FACECODE=(\BIN WOFD)
then FD:FIRSTCHAR←(\BIN WOFD)
FD:LASTCHAR←(\BIN WOFD)
(if (SIZE←(\WIN WOFD)=0 or MSIZE=SIZE) and (PROGN (\WIN WOFD)
T)
then FD:\SFFACECODE←FACECODE
(RETURN SIZE))))
(0 (RETURN NIL))
NIL)
(SETFILEPTR WOFD NEXT))))
(LANDPRESS
(LAMBDA (FILE COPIES HOST HEADING SIDES FONT) (* fgh: "21-Mar-84 15:06")
(RESETLST
(RESETSAVE (PROGN (MOVD (QUOTE PPRIN)
(QUOTE \HOLDPPRIN))
(MOVD (QUOTE LANDPPRIN)
(QUOTE PPRIN)))
(LIST (QUOTE MOVD)
(QUOTE \HOLDPPRIN)
(QUOTE PPRIN)))
(RESETSAVE (PROGN (MOVD (QUOTE PressNewLine)
(QUOTE \HoldPressNewLine))
(MOVD (QUOTE LandPressNewLine)
(QUOTE PressNewLine)))
(LIST (QUOTE MOVD)
(QUOTE \HoldPressNewLine)
(QUOTE PressNewLine)))
(RESETSAVE (PROGN (MOVD (QUOTE PressNewPage)
(QUOTE \HoldPressNewPage))
(MOVD (QUOTE LandPressNewPage)
(QUOTE PressNewPage)))
(LIST (QUOTE MOVD)
(QUOTE \HoldPressNewPage)
(QUOTE PressNewPage)))
(RESETSAVE (PROGN (MOVD (QUOTE \FINDFONT)
(QUOTE \HOLDFINDFONT))
(MOVD (QUOTE LANDFINDFONT)
(QUOTE \FINDFONT)))
(LIST (QUOTE MOVD)
(QUOTE \HOLDFINDFONT)
(QUOTE \FINDFONT)))
(RESETSAVE \FONTMAPCACHE (COPYALL \FONTMAPCACHE))
(RESETLST
(PROG (VAL PFILE FULLFILE)
(COND
((SETQ PFILE (PRESSFILEP FILE))
(SETQ FULLFILE PFILE))
(T (RESETSAVE (SETQ FULLFILE (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
8))
(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)))
(COND
(FONT (COND
((EQ (LENGTH FONT)
2)
(LIST (LIST 1 (APPEND FONT (QUOTE (STANDARD
5400))))))
(T (QUOTE ((1 (GACHA 8 STANDARD 5400)))))))
(T (QUOTE ((1 (GACHA 8 STANDARD 5400))))))
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 (COND
((NLISTP DEFAULTPRINTINGHOST)
DEFAULTPRINTINGHOST)
(T (for X in DEFAULTPRINTINGHOST
when (EQ (PRINTERTYPE X)
(QUOTE PRESS))
thereis X))))
PFILE))) (* 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))))))))
(LandPressNewLine
(LAMBDA (REGION) (* edited: "28-JUN-83 04:07")
(PROG (XPOS)
(REGION:originx←REGION:originx+CPRESSFONT:\SFHeight+PRESSLINELEAD)
(if XPOS←REGION:originx+CPRESSFONT:\SFHeight
gt REGION:cornerx
then (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)
else (SETXY.PRESS XPOS-CPRESSFONT:\SFDescent PRESSPOSITION←REGION:originy)))))
(LandPressNewPage
(LAMBDA (REGION) (* fgh: "21-Mar-84 15:12")
(PROG ((OLDFONT CPRESSFONT))
(COND
((OR PRESSHEADLINE PRESSPAGENO) (* heading line to be printed)
(replace originx of REGION with (IDIFFERENCE (fetch originx of PRESSPAGEREGION)
1270))
(replace originy of REGION with (fetch originy of PRESSPAGEREGION))
(replace cornerx of REGION with (fetch cornerx of PRESSPAGEREGION))
(replace cornery of REGION with (fetch cornery of PRESSPAGEREGION))
(SETQ PRESSBOUNDBOX REGION) (* half inch up)
(PressFont PRESSHEADFONT)
(SETX.PRESS (IPLUS (fetch originx of REGION)
(fetch \SFAscent of PRESSHEADFONT)))
(COND
(PRESSHEADLINE (SETY.PRESS (fetch originy of PRESSBOUNDBOX))
(PPRIN (fetch charCodes of PRESSHEADLINE)
NIL
(fetch nChars of PRESSHEADLINE))))
(COND
(PRESSPAGENO (PROG ((N (CHCON (add PRESSPAGENO 1))))
(SETY.PRESS (IDIFFERENCE (fetch cornery 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 (IPLUS (replace originx of REGION with (fetch originx of PRESSPAGEREGION))
(fetch \SFAscent of CPRESSFONT))
(replace originy of REGION with (fetch originy of PRESSPAGEREGION)))
(replace cornery of REGION with (fetch cornery of PRESSPAGEREGION))
(SETQ PRESSPOSITION 0)
(RETURN REGION))))
(LANDPPRIN
(LAMBDA (CHARS W N REGION) (* edited: "28-JUN-83 04:40")
(if W and REGION and PRESSPOSITION+W gt REGION:cornery
then (PressNewLine REGION))
(for c in CHARS do (\BOUT PRESSOUTSTRM c))
(if N
then (SHOW.PRESS N))
(if W
then (add PRESSPOSITION W))))
(\WIN
(LAMBDA (S) (* edited: "28-JUN-83 04:46")
(create WORD
HIBYTE ←(\BIN S)
LOBYTE ←(\BIN S))))
)
[DECLARE: EVAL@COMPILE
(DATATYPE FONTDESCRIPTOR (FONTDEVICE CHARACTERBITMAP FONTFAMILY FONTSIZE FONTFACE \SFWidths
\SFOffsets \SFWidthsY (FIRSTCHAR WORD)
(LASTCHAR WORD)
(\SFAscent WORD)
(\SFDescent WORD)
(\SFHeight WORD)
(ROTATION WORD)
(FBBOX SIGNEDWORD)
(FBBOY SIGNEDWORD)
(FBBDX SIGNEDWORD)
(FBBDY SIGNEDWORD)
(\SFFACECODE BITS 8)
\SFLKerns \SFRWidths)
(DATATYPE FONTDESCRIPTOR (FONTDEVICE CHARACTERBITMAP FONTFAMILY FONTSIZE
FONTFACE \SFWidths \SFOffsets
\SFWidthsY (FIRSTCHAR WORD)
(LASTCHAR WORD)
(\SFAscent WORD)
(\SFDescent WORD)
(\SFHeight WORD)
(ROTATION WORD)
(\SFMaxRasterWidth SIGNEDWORD)
(\SFTotalRasterWidth SIGNEDWORD)
(\SFMaxCharWidth SIGNEDWORD)
(\SFTotalCharWidth SIGNEDWORD)
(\SFFACECODE BITS 8)
\SFLKerns \SFRWidths)))
(RECORD Slug (nChars totalWidth . charCodes))
(ACCESSFNS WORD ((HIBYTE (LRSH DATUM 8))
(LOBYTE (LOGAND DATUM 255)))
(CREATE (IPLUS (LLSH HIBYTE 8)
LOBYTE)))
]
(/DECLAREDATATYPE (QUOTE FONTDESCRIPTOR)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD
WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
(BITS 8)
POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE FONTDESCRIPTOR)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD
WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
(BITS 8)
POINTER POINTER)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (390 7815 (LANDFINDFONT 400 . 1746) (LANDPRESS 1748 . 4624) (LandPressNewLine 4626 .
5304) (LandPressNewPage 5306 . 7268) (LANDPPRIN 7270 . 7639) (\WIN 7641 . 7813)))))
STOP