(FILECREATED " 4-Mar-85 03:14:48" {ERIS}<LISPCORE>LISPUSERS>LANDPRESS.;3 17804
changes to: (VARS LANDPRESSCOMS)
(FNS OPENLPRSTREAM \LANDPRESS.INIT \DSPFONT.LANDPRESS \FONTCREATE.LANDPRESS
\CLOSEF.LANDPRESS \DSPYPOSITION.LANDPRESS)
previous date: "25-Feb-85 16:05:39" {ERIS}<LISPCORE>LISPUSERS>LANDPRESS.;2)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LANDPRESSCOMS)
(RPAQQ LANDPRESSCOMS [(FNS LANDPRESS MAKELANDPRESS NEWLINE.LANDPRESS NEWPAGE.LANDPRESS OPENLPRSTREAM
\LANDPRESS.INIT \LANDPRESS.OUTCHARFN \STARTPAGE.LANDPRESS
\CLOSEF.LANDPRESS \DSPFONT.LANDPRESS \SETSPACE.LANDPRESS
\DSPYPOSITION.LANDPRESS)
(VARS DEFAULTLANDPRESSREGION)
(INITVARS (PRESSLINELEAD 35))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
PRESS))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\LANDPRESS.INIT))
(ADDVARS (IMAGESTREAMTYPES (LANDPRESS (OPENSTREAM OPENLPRSTREAM])
(DEFINEQ
(LANDPRESS
[LAMBDA (FILE COPIES HOST HEADING SIDES FONT) (* edited: "13-Aug-84 14:20")
(RESETLST (PROG (VAL PFILE FULLFILE)
(if (SETQ PFILE (PRESSFILEP FILE))
then (SETQ FULLFILE PFILE)
elseif (SETQ FULLFILE (FINDFILE FILE))
then [RESETSAVE (SETQ PFILE
(CADR (MAKELANDPRESS 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)))
(if FONT
else (QUOTE (GACHA 8 STANDARD)))
HEADING NIL)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(DELFILE OLDVALUE]
else (ERROR "FILE NOT FOUND")
(RETURN))
(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])
(MAKELANDPRESS
[LAMBDA (FILE PFILE FONT HEADING TABS) (* edited: "13-Aug-84 14:20")
(PROG ((SOURCESTREAM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)))
LPRSTREAM)
(SETQ LPRSTREAM (OPENLPRSTREAM PFILE NIL [OR HEADING (CONCAT (FULLNAME SOURCESTREAM)
" "
(GETFILEINFO SOURCESTREAM
(QUOTE
CREATIONDATE]
FONT
(FULLNAME SOURCESTREAM)))
(replace (STREAM ENDOFSTREAMOP) of SOURCESTREAM with (FUNCTION NILL))
(bind C while (SETQ C (\BIN SOURCESTREAM)) do (if (EQ C (CHARCODE CR))
then (NEWLINE.LANDPRESS LPRSTREAM)
else (\BOUT LPRSTREAM C)))
(RETURN (LIST (CLOSEF SOURCESTREAM)
(CLOSEF LPRSTREAM])
(NEWLINE.LANDPRESS
[LAMBDA (LPRSTREAM) (* mjs " 9-Aug-84 14:38")
(* Go to next line (or next page))
(DECLARE (GLOBALVARS PRESSLINELEAD))
(PROG (NEWXPOS (PRDATA (fetch IMAGEDATA of LPRSTREAM)))
[SETQ NEWXPOS (IPLUS (fetch PRXPOS of PRDATA)
(IPLUS PRESSLINELEAD (FONTPROP (fetch PRFONT of PRDATA)
(QUOTE HEIGHT]
(COND
((IGREATERP NEWXPOS (fetch PRRIGHT of PRDATA))
(NEWPAGE.LANDPRESS LPRSTREAM))
(T (SHOW.PRESS LPRSTREAM)
(SETXY.PRESS LPRSTREAM NEWXPOS (fetch PRBOTTOM of PRDATA])
(NEWPAGE.LANDPRESS
[LAMBDA (PRSTREAM) (* mjs " 9-Aug-84 14:38")
(\ENDPAGE.PRESS PRSTREAM)
(\STARTPAGE.LANDPRESS PRSTREAM])
(OPENLPRSTREAM
[LAMBDA (LPRFILE REGION HEADING FONT BREAKPAGEFILENAME) (* jds " 4-Mar-85 02:58")
(* Opens a LANDPRESS stream, to which user can do OUTCHAR. FONT is a list of fonts to be set up initially.
Headings will be printed in the first font in FONTS. If FONT is NIL, then the stream is initialized with the PRESS
DEFAULTFONT)
(DECLARE (GLOBALVARS DEFAULTPAGEREGION \LANDPRESSIMAGEOPS))
(PROG ([LPRSTREAM (OPENSTREAM LPRFILE (QUOTE OUTPUT)
(QUOTE NEW)
8
(QUOTE ((TYPE BINARY]
(LPRDATA (create PRESSDATA
PRPAGEREGION ←(COND
((type? REGION REGION)
REGION)
(T DEFAULTLANDPRESSREGION))
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))
)
PRDOCNAME ← BREAKPAGEFILENAME)))
(replace (STREAM OUTCHARFN) of LPRSTREAM with (FUNCTION \LANDPRESS.OUTCHARFN))
(replace (STREAM IMAGEOPS) of LPRSTREAM with \LANDPRESSIMAGEOPS)
(replace (STREAM IMAGEDATA) of LPRSTREAM with LPRDATA)
(COND
(HEADING (replace PRHEADING of LPRDATA with HEADING)))
[COND
((NULL FONT)
(SETQ FONT (QUOTE (GACHA 8 MRR]
(SETQ FONT (FONTCREATE FONT NIL NIL NIL (QUOTE PRESS)))
(\DSPFONT.LANDPRESS LPRSTREAM FONT)
(\ENTITYEND.PRESS LPRSTREAM)
(replace PRHEADINGFONT of (fetch IMAGEDATA of LPRSTREAM) with FONT)
(\STARTPAGE.LANDPRESS LPRSTREAM)
(RETURN LPRSTREAM])
(\LANDPRESS.INIT
[LAMBDA NIL (* jds " 4-Mar-85 03:13")
(* Initializes the IMAGEOPS vector for LANDPRESS
streams.)
(DECLARE (GLOBALVARS \LANDPRESSIMAGEOPS))
(SETQ \LANDPRESSIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE LANDPRESS)
IMCLOSEFN ←(FUNCTION \CLOSEF.LANDPRESS)
IMXPOSITION ←(FUNCTION \DSPYPOSITION.PRESS)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.LANDPRESS)
IMFONT ←(FUNCTION \DSPFONT.LANDPRESS)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.PRESS)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.PRESS)
IMLINEFEED ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DSPLINEFEED]
IMDRAWLINE ←(FUNCTION \DRAWLINE.PRESS)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.PRESS)
IMDRAWCIRCLE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DRAWCIRCLE]
IMDRAWELLIPSE ←[FUNCTION (LAMBDA (STREAM)
(\UNIMPIMAGEOP STREAM (QUOTE DRAWELLIPSE]
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]
IMBOTTOMMARGIN ←(FUNCTION \DSPBOTTOMMARGIN.PRESS)
IMTOPMARGIN ←(FUNCTION \DSPTOPMARGIN.PRESS)
IMFONTCREATE ←(QUOTE PRESS])
(\LANDPRESS.OUTCHARFN
[LAMBDA (LPRSTREAM CHARCODE) (* edited: "13-Aug-84 14:08")
(SELCHARQ CHARCODE
(EOL (NEWLINE.LANDPRESS LPRSTREAM)
(replace (STREAM CHARPOSITION) of LPRSTREAM with 0))
[LF (\DSPXPOSITION.PRESS LPRSTREAM (PROG1 (DSPXPOSITION LPRSTREAM)
(NEWLINE.LANDPRESS LPRSTREAM]
(↑L (replace (STREAM CHARPOSITION) of LPRSTREAM with 0)
(NEWPAGE.LANDPRESS LPRSTREAM))
(PROG ((PRDATA (fetch IMAGEDATA of LPRSTREAM)))
(add (fetch PRYPOS of PRDATA)
(\FGETWIDTH (ffetch PRWIDTHSCACHE of PRDATA)
CHARCODE))
(\BOUT LPRSTREAM CHARCODE])
(\STARTPAGE.LANDPRESS
[LAMBDA (PRSTREAM) (* jds "23-Jan-85 17:57")
(* 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.LANDPRESS PRSTREAM HFONT) (* Set up heading font)
(SETXY.PRESS PRSTREAM (IPLUS (fetch PRLEFT of PRDATA)
(FONTPROP HFONT (QUOTE ASCENT)))
(fetch PRBOTTOM of PRDATA))
(PRIN3 (fetch PRHEADING of PRDATA)
PRSTREAM) (* Skip an inch before page number)
(SHOW.PRESS PRSTREAM)
(SETY.PRESS PRSTREAM (IPLUS MICASPERINCH (fetch PRYPOS of PRDATA)))
(PRIN3 "Page " PRSTREAM)
(PRIN3 (add (fetch PRPAGENUM of PRDATA)
1)
PRSTREAM)
(NEWLINE.LANDPRESS PRSTREAM) (* Skip 2 lines)
(NEWLINE.LANDPRESS PRSTREAM))
(T (SETXY.PRESS PRSTREAM (IPLUS (fetch PRLEFT of PRDATA)
(FONTPROP CFONT (QUOTE ASCENT)))
(fetch PRBOTTOM of PRDATA] (* Now we set the font to our
(previous) current font)
(\DSPFONT.LANDPRESS PRSTREAM CFONT])
(\CLOSEF.LANDPRESS
[LAMBDA (PRSTREAM) (* jds " 4-Mar-85 02:56")
(* DO the cleanup to close a LANDPRESS file)
(\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 5400) (* Force all fonts to be rotated 90 degrees.)
)
(\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 PRDOCNAME of PRDATA)
(FULLNAME PRSTREAM))
52)
(\BCPLSOUT.PRESS PRSTREAM USERNAME 32)
(\BCPLSOUT.PRESS PRSTREAM (GETFILEINFO PRSTREAM (QUOTE CREATIONDATE))
40)
(\PAGEPAD.PRESS PRSTREAM])
(\DSPFONT.LANDPRESS
[LAMBDA (PRSTREAM FONT) (* jds " 4-Mar-85 03:03")
(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 (ffetch \SFWidths
of FONT)))
[\SETSPACE.LANDPRESS PRSTREAM (FIXR (TIMES (ffetch PRSPACEFACTOR of PRDATA)
(\FGETWIDTH (ffetch PRWIDTHSCACHE of PRDATA)
(CHARCODE SPACE]
[freplace PRLINEFEED of PRDATA with (IDIFFERENCE (CONSTANT (IMINUS MicasPerPoint))
(FONTPROP FONT (QUOTE HEIGHT]
(\FIXLINELENGTH.PRESS PRSTREAM)
(RETURN OLDFONT])
(\SETSPACE.LANDPRESS
[LAMBDA (PRSTREAM S) (* jds "23-Jan-85 17:54")
(* Set the true space width, given the font's nominal
space width and the stream's SPACEFACTOR.)
(PROG (ELSTREAM (PRDATA (fetch IMAGEDATA of PRSTREAM)))
(AND (EQ S (ffetch PRSPACEWIDTH of PRDATA))
(RETURN)) (* If this space-width is the same as it used to be,
save room on the file--suppress the set.)
(SETQ ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM)))
(COND
((ILEQ S 2047) (* The space width is small -
use the short version.)
(\WOUT ELSTREAM (IPLUS (LLSH SetSpaceYShortCode 8)
S)))
(T (* It's a large number; have to use the long version.)
(\BOUT ELSTREAM SetSpaceYCode)
(\WOUT ELSTREAM S)))
(freplace PRSPACEWIDTH of PRDATA with S])
(\DSPYPOSITION.LANDPRESS
[LAMBDA (PRSTREAM XPOSITION) (* jds " 4-Mar-85 03:13")
(PROG1 (IDIFFERENCE (CONSTANT (FIXR (FTIMES 8.5 2540)))
(fetch PRXPOS of (fetch IMAGEDATA of PRSTREAM)))
(COND
(XPOSITION (SHOW.PRESS PRSTREAM)
(SETX.PRESS PRSTREAM (IDIFFERENCE (CONSTANT (FIXR (FTIMES 8.5 2540)))
XPOSITION])
)
(RPAQQ DEFAULTLANDPRESSREGION (1794 1405 18256 25765))
(RPAQ? PRESSLINELEAD 35)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
PRESS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\LANDPRESS.INIT)
(ADDTOVAR IMAGESTREAMTYPES (LANDPRESS (OPENSTREAM OPENLPRSTREAM)))
)
(PUTPROPS LANDPRESS COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (997 17436 (LANDPRESS 1007 . 2619) (MAKELANDPRESS 2621 . 3521) (NEWLINE.LANDPRESS 3523
. 4283) (NEWPAGE.LANDPRESS 4285 . 4473) (OPENLPRSTREAM 4475 . 6735) (\LANDPRESS.INIT 6737 . 8490) (
\LANDPRESS.OUTCHARFN 8492 . 9226) (\STARTPAGE.LANDPRESS 9228 . 10999) (\CLOSEF.LANDPRESS 11001 . 14086
) (\DSPFONT.LANDPRESS 14088 . 15805) (\SETSPACE.LANDPRESS 15807 . 16994) (\DSPYPOSITION.LANDPRESS
16996 . 17434)))))
STOP