(FILECREATED "23-Jan-85 18:16:36" {ERIS}<LISPCORE>LISPUSERS>LANDPRESS.;1 13707
changes to: (FNS OPENLPRSTREAM \STARTPAGE.LANDPRESS \DSPFONT.LANDPRESS \SETSPACE.LANDPRESS)
(VARS LANDPRESSCOMS)
previous date: "23-Jan-85 17:59:05" {IVY}<SYBALSKY>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.OUTCHARFN \STARTPAGE.LANDPRESS \DSPFONT.LANDPRESS
\SETSPACE.LANDPRESS)
(VARS DEFAULTLANDPRESSREGION)
(INITVARS (PRESSLINELEAD 35))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
PRESS))))
(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 "23-Jan-85 17:56")
(* 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 (COND
((BOUNDP (QUOTE \LANDPRESSIMAGEOPS))
\LANDPRESSIMAGEOPS)
(T (SETQ \LANDPRESSIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE LANDPRESS)
IMCLOSEFN ←(FUNCTION \CLOSEF.PRESS)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.PRESS)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.PRESS)
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]
(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 (create FONTDESCRIPTOR using (FONTCREATE FONT NIL NIL NIL (QUOTE PRESS))
ROTATION ← 5400))
(\DSPFONT.LANDPRESS LPRSTREAM FONT)
(\ENTITYEND.PRESS LPRSTREAM)
(replace PRHEADINGFONT of (fetch IMAGEDATA of LPRSTREAM) with FONT)
(\STARTPAGE.LANDPRESS LPRSTREAM)
(RETURN LPRSTREAM])
(\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])
(\DSPFONT.LANDPRESS
[LAMBDA (PRSTREAM FONT) (* jds "23-Jan-85 17:54")
(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])
)
(RPAQQ DEFAULTLANDPRESSREGION (1794 1405 18256 25765))
(RPAQ? PRESSLINELEAD 35)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
PRESS)
)
(PUTPROPS LANDPRESS COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (749 13464 (LANDPRESS 759 . 2371) (MAKELANDPRESS 2373 . 3273) (NEWLINE.LANDPRESS 3275 .
4035) (NEWPAGE.LANDPRESS 4037 . 4225) (OPENLPRSTREAM 4227 . 8045) (\LANDPRESS.OUTCHARFN 8047 . 8781) (
\STARTPAGE.LANDPRESS 8783 . 10554) (\DSPFONT.LANDPRESS 10556 . 12273) (\SETSPACE.LANDPRESS 12275 .
13462)))))
STOP