From 26d6592f38b6737af37141ce8cec0dd5bf83b81f Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Sat, 26 Apr 2025 18:17:39 -0700 Subject: [PATCH 1/2] I tried to put in support for standard color specifications. I think this is pretty close. BLTSHADE, FILLCIRCLE, and FILLPOLYGON with the TEXTURE as TEXTUREP or BITMAPP convert to a gray scale as a function of the number of bits set, I think. It'll take a bunch more refreshing of PostScript knowledge to figure out how to do these with real colors, and actual pixel-by-pixel textures. --- library/POSTSCRIPTSTREAM | 1456 ++++++++++++++++---------------- library/POSTSCRIPTSTREAM.LCOM | Bin 91379 -> 93914 bytes library/POSTSCRIPTSTREAM.TEDIT | 95 ++- 3 files changed, 814 insertions(+), 737 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 44e68a7e9..079bce2fb 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,12 +1,30 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}POSTSCRIPTSTREAM.;15 258118 - - :EDIT-BY rmk - - :CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS) - - :PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}POSTSCRIPTSTREAM.;12) +(FILECREATED "26-Apr-2025 17:44:28" {DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;7 255849 + + :EDIT-BY "mth" + + :CHANGES-TO (FNS POSTSCRIPT.OUTSTR \PSC.COLOR.TO.RGB \DSPCOLOR.PSC \BLTSHADE.PSC + POSTSCRIPT.PUTCOLOR POSTSCRIPT.PUTRGBCOLOR \DRAWARC.PSC \DRAWCIRCLE.PSC + \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC + \FILLCIRCLE.PSC \FILLPOLYGON.PSC \POSTSCRIPT.CHANGECHARSET + POSTSCRIPT.HARDCOPYW POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE + POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE POSTSCRIPT.SHOWACCUM + POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK + \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC \SWITCHFONTS.PSC + \TERPRI.PSC \CHARWIDTH.PSC \DSPBOTTOMMARGIN.PSC \DSPCLIPPINGREGION.PSC + \DSPFONT.PSC \DSPLEFTMARGIN.PSC \DSPLINEFEED.PSC \DSPPUSHSTATE.PSC + \DSPPOPSTATE.PSC \DSPRESET.PSC \DSPRIGHTMARGIN.PSC \DSPROTATE.PSC + \DSPSCALE.PSC \DSPSCALE2.PSC \DSPSPACEFACTOR.PSC \DSPTOPMARGIN.PSC + \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FIXLINELENGTH.PSC + \MOVETO.PSC \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG + \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN + \POSTSCRIPT.ACCENTPAIR OPENPOSTSCRIPTSTREAM) + (VARS POSTSCRIPTSTREAMCOMS) + (RECORDS \POSTSCRIPTDATA) + + :PREVIOUS-DATE "10-Dec-2024 15:16:36" +{DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;1) (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) @@ -17,7 +35,7 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) (INITRECORDS \POSTSCRIPTDATA) - (FNS POSTSCRIPT.INIT) + (FNS POSTSCRIPT.INIT POSTSCRIPT.PUTRGBCOLOR \PSC.COLOR.TO.RGB) (ADDVARS (DEFAULTFILETYPELIST (PS . BINARY) (PSC . BINARY) (PSF . BINARY) @@ -222,6 +240,7 @@ (* ; "Line to line spacing") POSTSCRIPTCOLOR (* ;  "Color (or grey shade) in effect; 0.0=black, 1.0=white.") + (* ; "Now this is an RGB triple") POSTSCRIPTSCALE (* ; "Scale of the stream") POSTSCRIPTOPERATION (* ;  "Default operation (PAINT, REPLACE, ...)") @@ -266,7 +285,7 @@ POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY _ (ARRAY \PS.TEMPARRAYLEN 'BYTE 0 0) - POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) + POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ (ENSURE.RGB 'BLACK)) (RECORD POSTSCRIPTXFORM ( (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") @@ -481,6 +500,34 @@ IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC))) (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255)) (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) + +(POSTSCRIPT.PUTRGBCOLOR + [LAMBDA (STREAM RGB EOL?) (* ; "Edited 26-Apr-2025 17:16 by mth") + (AND RGB (SETQ RGB (\PSC.COLOR.TO.RGB RGB)) + (POSTSCRIPT.PUTCOMMAND STREAM (CAR RGB) + " " + (CADR RGB) + " " + (CADDR RGB) + " setrgbcolor " + (AND EOL? :EOL]) + +(\PSC.COLOR.TO.RGB + [LAMBDA (COLOR NOERRORFLG?) (* ; "Edited 26-Apr-2025 17:06 by mth") + (COND + ((AND (FLOATP COLOR) + (<= 0.0 COLOR 1.0) + (SETQ COLOR (FIX (FTIMES COLOR 255))) + (LIST COLOR COLOR COLOR))) + ((ENSURE.RGB COLOR NOERRORFLG?)) + (T + (* ;; " Shouldn't ever get here.") + + (* ;; " ENSURE.RGB above handled the color name or number, RGB, and HLS cases.") + + (* ;; "Depending on NOERRORFLG?, it will give the error for anything else invalid") + + NIL]) ) (ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY) @@ -1119,12 +1166,12 @@ (DEFINEQ (OPENPOSTSCRIPTSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") - (* ; - "Edited 31-May-93 12:42 by sybalsky:mv:envos") - (* ; "Edited 23-Dec-92 01:17 by jds") + [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") + (* ; + "Edited 31-May-93 12:42 by sybalsky:mv:envos") + (* ; "Edited 23-Dec-92 01:17 by jds") - (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") + (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) @@ -1135,7 +1182,7 @@ (replace (STREAM IMAGEOPS) of STREAM with \POSTSCRIPTIMAGEOPS) (replace (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION BOUT)) - (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") + (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") (printout STREAM "%%!PS-Adobe-2.0" T %# (CL:WHEN BBOX (PRINTOUT STREAM "%%%%BoundingBox: " @@ -1159,20 +1206,20 @@ T %# (COND ((EQ 'LPT (FILENAMEFIELD STREAM 'HOST)) - (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") + (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") (PRINTOUT NIL "%%%%For: " (MKSTRING USERNAME) T))) "%%%%EndComments" T) (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR STREAM X) - (\BOUTEOL STREAM)) + (\BOUTEOL STREAM)) (SETQ PAPER (OR (CDR (CL:ASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE) (LISTGET OPTIONS 'PAPERTYPE) POSTSCRIPT.PAGETYPE)) POSTSCRIPT.PAGEREGIONS :TEST #'STRING-EQUAL)) (ERROR "Unknown PostScript page type" PAPER))) - (* ;; "Set the paper size:") + (* ;; "Set the paper size:") (PRINTOUT STREAM (L-CASE (OR (LISTGET OPTIONS 'PAGETYPE) (LISTGET OPTIONS 'PAPERTYPE) @@ -1191,50 +1238,50 @@ (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with \PS.SCALE0) (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (CAR PAPER))) + IMAGESIZEFACTOR) + (CAR PAPER))) - (* ;; - "Initial clipping region can be specified separately from the page size, default is to page size.") + (* ;; + "Initial clipping region can be specified separately from the page size, default is to page size.") [replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with (SETQ CLIP (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (OR (CADR PAPER) - (CAR PAPER] + IMAGESIZEFACTOR) + (OR (CADR PAPER) + (CAR PAPER] - (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") + (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) (INTERSECTREGIONS REG CLIP)) (CREATEREGION 3600 3600 54000 72000))) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (REGION LEFT) of REG)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (REGION BOTTOM) of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with (fetch (REGION LEFT) + of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with (fetch (REGION BOTTOM) + of REG)) (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with (PLUS (fetch (REGION BOTTOM) of REG) - (fetch (REGION HEIGHT) of REG) - -1)) + (fetch (REGION HEIGHT) of REG) + -1)) (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with (PLUS (fetch (REGION LEFT) of REG) - (fetch (REGION WIDTH) of REG) - -1)) + (fetch (REGION WIDTH) of REG) + -1)) (\DSPFONT.PSC STREAM (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS] - DEFAULTFONT) - NIL NIL NIL STREAM)) + DEFAULTFONT) + NIL NIL NIL STREAM)) (\SWITCHFONTS.PSC STREAM IMAGEDATA) [COND - ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA - with (LISTGET OPTIONS 'HEADING)) + ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA with (LISTGET OPTIONS + 'HEADING)) (replace (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) of IMAGEDATA with (COND - ((LISTGET OPTIONS 'HEADINGFONT) - (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) - NIL NIL NIL STREAM)) - (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] + ((LISTGET OPTIONS 'HEADINGFONT) + (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) + NIL NIL NIL STREAM)) + (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] - (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") + (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") (COND ([COND @@ -1248,7 +1295,7 @@ (T (CL:GETF OPTIONS 'ROTATION] (POSTSCRIPT.SET-FAKE-LANDSCAPE STREAM 90))) - (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") + (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") (\EXTERNALFORMAT STREAM (CREATE EXTERNALFORMAT NAME _ 'POSTSCRIPT @@ -1269,12 +1316,11 @@ (DEFINEQ (POSTSCRIPT.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) - (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (ALLOW.BUTTON.EVENTS) (LET* ((STREAM (OPENPOSTSCRIPTSTREAM FILE (LIST 'DOCUMENT.NAME TITLE 'ROTATION Landscape? - 'IMAGESIZEFACTOR SCALEFACTOR))) + 'IMAGESIZEFACTOR SCALEFACTOR))) (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (SCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) SCALE) @@ -1284,18 +1330,15 @@ ((< (fetch BITMAPWIDTH of BITMAP) (+ (fetch (REGION LEFT) of REGION) (fetch (REGION WIDTH) of REGION))) - (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH - of BITMAP) - (fetch (REGION - LEFT) - of REGION] + (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH of BITMAP) + (fetch (REGION LEFT) of REGION] (COND ((< (fetch BITMAPHEIGHT of BITMAP) (+ (fetch (REGION BOTTOM) of REGION) (fetch (REGION HEIGHT) of REGION))) - (replace (REGION HEIGHT) of REGION - with (- (fetch BITMAPHEIGHT of BITMAP) - (fetch (REGION BOTTOM) of REGION] + (replace (REGION HEIGHT) of REGION with (- (fetch BITMAPHEIGHT of BITMAP) + (fetch (REGION BOTTOM) + of REGION] (T (SETQ REGION (create REGION LEFT _ 0 BOTTOM _ 0 @@ -1429,8 +1472,8 @@ else (CONS SF1 PPL]) (POSTSCRIPT.CLOSESTRING - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) @@ -1440,8 +1483,8 @@ (T NIL]) (POSTSCRIPT.ENDPAGE - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (POSTSCRIPT.SHOWACCUM STREAM) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) @@ -1451,14 +1494,20 @@ (POSTSCRIPT.PUTCOMMAND STREAM "showpage" :EOL))) (* ;; -"Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") + "Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") (replace (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of IMAGEDATA with NIL]) (POSTSCRIPT.OUTSTR - [LAMBDA (STREAM X) (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") + [LAMBDA (STREAM X) (* ; "Edited 26-Apr-2025 17:44 by mth") + (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") (DECLARE (LOCALVARS . T)) (COND + ((NULL X) + + (* ;; "Don't output anything for NIL") + + NIL) ((FIXP X) (* ; "Common case, speed helps") (\PS.BOUTFIXP STREAM X)) [(STRINGP X) (* ; "Other common case") @@ -1614,7 +1663,7 @@ (\MOVEBYTES BMBASE ROWOFFSET PRVBASE 0 BYTESPERROW]) (POSTSCRIPT.PUTCOMMAND - [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") + [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") (LET* ((STREAM (ARG S.STRS 1)) (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) S#S) @@ -1626,19 +1675,19 @@ ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) (\SETXFORM.PSC STREAM IMAGEDATA))) (for STR# from 2 to S.STRS do (COND - ((EQ (SETQ S#S (ARG S.STRS STR#)) - :EOL) - (\BOUTEOL STREAM)) - (T (POSTSCRIPT.OUTSTR STREAM S#S]) + ((EQ (SETQ S#S (ARG S.STRS STR#)) + :EOL) + (\BOUTEOL STREAM)) + (T (POSTSCRIPT.OUTSTR STREAM S#S]) (POSTSCRIPT.SET-FAKE-LANDSCAPE - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (* ;; "Set up for (or disable) fake landscaping") (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OLAND (COND @@ -1662,35 +1711,22 @@ WIDTH _ (fetch (REGION HEIGHT) of P0) HEIGHT _ (fetch (REGION WIDTH) of P0))) [COND - (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) - of C0)) - [replace (REGION BOTTOM) of C with - (- (fetch (REGION WIDTH) - of P0) - (+ (fetch (REGION LEFT) - of C0) - (fetch (REGION WIDTH) - of C0] - (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - ) + (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) of C0)) + [replace (REGION BOTTOM) of C with (- (fetch (REGION WIDTH) of P0) + (+ (fetch (REGION LEFT) of C0) + (fetch (REGION WIDTH) of C0] + (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA)) (SETQ MB (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of - IMAGEDATA - ) + (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) 1)) (SETQ MR (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA)) (SETQ MT (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - ) + (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) 1))) - (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) - of P0) - (+ (fetch (REGION BOTTOM) - of C0) - (fetch (REGION HEIGHT) - of C0] - (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) - of C0)) + (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) of P0) + (+ (fetch (REGION BOTTOM) of C0) + (fetch (REGION HEIGHT) of C0] + (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) of C0)) (SETQ ML (- (fetch (REGION HEIGHT) of P0) (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) 1)) @@ -1699,8 +1735,7 @@ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) 1)) (SETQ MT (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - C) + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with C) (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with P) (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with ML) (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with MB) @@ -1712,16 +1747,16 @@ OLAND]) (POSTSCRIPT.SHOWACCUM - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") - (* ;; - "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") + (* ;; + "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") - (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") + (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") - (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") + (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") - (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") + (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM)) KERN) @@ -1736,69 +1771,67 @@ (T (POSTSCRIPT.OUTSTR STREAM ") S"] (T (POSTSCRIPT.OUTSTR STREAM ") ") (POSTSCRIPT.OUTSTR STREAM (DIFFERENCE (ffetch (\POSTSCRIPTDATA - POSTSCRIPTSPACEWIDTH) - of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH - ) of IMAGEDATA))) + POSTSCRIPTSPACEWIDTH) + of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA + POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA))) (COND (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT " 0 " (CHARCODE SPACE) - " " KERN " 0 " - " 6 -1 roll awidthshow"))) + " " KERN " 0 " " 6 -1 roll awidthshow")) + ) (T (POSTSCRIPT.OUTSTR STREAM (CONSTANT (CONCAT " 0 " (CHARCODE SPACE) - " 4 -1 roll widthshow"] + " 4 -1 roll widthshow"] (\BOUTEOL STREAM) (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL]) (POSTSCRIPT.STARTPAGE - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") - (* ;; "Start up a new page in a Postscript document.") + (* ;; "Start up a new page in a Postscript document.") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) NEW-PAGE) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) - (* ; "shouldnt need this") + (* ; "shouldnt need this") (SETQ NEW-PAGE (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGENUM) of IMAGEDATA))) - (* ; "Page number goes up by 1") + (* ; "Page number goes up by 1") - (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") + (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Page: " NEW-PAGE " " NEW-PAGE :EOL "%%%%BeginPageSetup" :EOL "/savepage save def" :EOL (FQUOTIENT 1 \PS.SCALE0) " imagesizefactor mul dup scale" :EOL "%%%%EndPageSetup" :EOL) (\SETXFORM.PSC STREAM IMAGEDATA T) - (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") + (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with T) - (* ; "nothing printed yet...") + (* ; "nothing printed yet...") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA) - (* ;; "Here we handle headings.") + (* ;; "Here we handle headings.") (LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) - of IMAGEDATA] + of IMAGEDATA] (\DSPRESET.PSC STREAM) - (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) - of IMAGEDATA)) + (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA)) (RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0)) - 0 STREAM) (* ; "Skip an inch before page number") + 0 STREAM) (* ; "Skip an inch before page number") (POSTSCRIPT.OUTSTR STREAM "Page ") (POSTSCRIPT.OUTSTR STREAM NEW-PAGE) - (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") + (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") (\TERPRI.PSC STREAM) (\DSPFONT.PSC STREAM FONT))) (T (\DSPRESET.PSC STREAM]) (\POSTSCRIPTTAB - [LAMBDA (POSTSCRIPTDATA) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of POSTSCRIPTDATA] + [LAMBDA (POSTSCRIPTDATA) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) + of POSTSCRIPTDATA] (IDIFFERENCE TABSPACE (IREMAINDER (IDIFFERENCE (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of POSTSCRIPTDATA) (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) @@ -1806,8 +1839,8 @@ TABSPACE]) (\PS.BOUTFIXP - [LAMBDA (STREAM N) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (STREAM N) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (* ;; "BOUT the decimal representation of N to STREAM using temp storage from the imagedata. Done this way for speed.") @@ -1821,19 +1854,18 @@ (BOUT STREAM (IPLUS N (CHARCODE 0] [(LESSP N 1000000000) (LET ([BASE (fetch (ARRAYP BASE) of (fetch (\POSTSCRIPTDATA POSTSCRIPTTEMPARRAY) - of (fetch (STREAM IMAGEDATA) - of STREAM] + of (fetch (STREAM IMAGEDATA) of STREAM] (i (SUB1 \PS.TEMPARRAYLEN))) [for old i by -1 do (\PUTBASEBYTE BASE i (IPLUS (IREMAINDER N 10) - (CHARCODE 0))) + (CHARCODE 0))) repeatwhile (NEQ 0 (SETQ N (IQUOTIENT N 10] (\BOUTS STREAM BASE i (IDIFFERENCE \PS.TEMPARRAYLEN i] (T (* ; "Just in case we get a bignum") (for c in (CHCON N) do (BOUT STREAM (\CHAR8CODE c]) (\PS.SCALEHACK - [LAMBDA (STREAM SCALEFACTOR) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + [LAMBDA (STREAM SCALEFACTOR) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OLDSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA)) FACTOR) @@ -1842,18 +1874,16 @@ (NOT (EQP OLDSCALE SCALEFACTOR))) (POSTSCRIPT.SHOWACCUM STREAM) (SETQ FACTOR (/ OLDSCALE SCALEFACTOR)) - [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) + [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) do (change (fetch (REGION LEFT) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION BOTTOM) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION WIDTH) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION HEIGHT) of REG) - (FIXR (CL:* DATUM FACTOR] + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION BOTTOM) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION WIDTH) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION HEIGHT) of REG) + (FIXR (CL:* DATUM FACTOR] (change (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) (FIXR (CL:* DATUM FACTOR))) (change (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) @@ -1870,8 +1900,7 @@ (FIXR (CL:* DATUM FACTOR))) (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) (FIXR (CL:* DATUM FACTOR))) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with - SCALEFACTOR) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with SCALEFACTOR) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T))) OLDSCALE]) @@ -1887,12 +1916,12 @@ (\SCALEDBITBLT.PSC [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM - SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") - (* ; "Edited 8-May-2018 15:05 by rmk:") - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") + (* ; "Edited 8-May-2018 15:05 by rmk:") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") + (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") (OR (NUMBERP SCALE) (SETQ SCALE 1)) @@ -1933,8 +1962,8 @@ ((AND (EQ SOURCELEFT 0) (EQ SOURCEBOTTOM 0) (EQP WIDTH BITMAPWIDTH) - (EQP HEIGHT BITMAPHEIGHT)) (* ; - "Avoid copy if sending entire bitmap") + (EQP HEIGHT BITMAPHEIGHT)) (* ; + "Avoid copy if sending entire bitmap") (SETQ TEMPBM SOURCEBITMAP)) (T (SETQ TEMPBM (BITMAPCREATE WIDTH HEIGHT 1)) (BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM TEMPBM 0 0 WIDTH HEIGHT SOURCETYPE @@ -1947,8 +1976,8 @@ ((EQ OPERATION 'PAINT) " true") (T - (* ;; - "RMK: For REPLACE, was %"false%", but then white was black.") + (* ;; + "RMK: For REPLACE, was %"false%", but then white was black.") " true")) " thebitimage" :EOL) @@ -1959,8 +1988,8 @@ (T NIL]) (\SETPOS.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) " " (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) @@ -1968,28 +1997,82 @@ (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) (\SETXFORM.PSC -(LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") (* ;; "Write transforms into the PS file to make what it prints match what we think it should print.") (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) (COND ((NOT NORESTORE) (POSTSCRIPT.OUTSTR STREAM "grestore "))) (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) (* ;; "Scaling") (COND ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) 1)) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) " dup scale" :EOL))) (* ;; "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) (* ;; "Any rotation that is in effect.") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) " rotate " :EOL) (* ;; "Any translations that are in effect.") (COND ((NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA)))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) " " (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) " translate" :EOL))) (* ;; "Clipping region:") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) " " (fetch (REGION WIDTH) of CLIP) " " (fetch (REGION LEFT) of CLIP) " " (fetch (REGION BOTTOM) of CLIP) " CLP" :EOL) (* ;; "And force recaching of location and font.") (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) -) + [LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") + + (* ;; + "Write transforms into the PS file to make what it prints match what we think it should print.") + + (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) + (COND + ((NOT NORESTORE) + (POSTSCRIPT.OUTSTR STREAM "grestore "))) + (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) + + (* ;; "Scaling") + + (COND + ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) + 1)) + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) + " dup scale" :EOL))) + + (* ;; + "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") + + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) + + (* ;; "Any rotation that is in effect.") + + (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) + " rotate " :EOL) + + (* ;; "Any translations that are in effect.") + + (COND + ([NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) + (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA] + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + " " + (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + " translate" :EOL))) + + (* ;; "Clipping region:") + + (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) + " " + (fetch (REGION WIDTH) of CLIP) + " " + (fetch (REGION LEFT) of CLIP) + " " + (fetch (REGION BOTTOM) of CLIP) + " CLP" :EOL) + + (* ;; "And force recaching of location and font.") + + (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T]) (\STRINGWIDTH.PSC - [LAMBDA (STREAM STR RDTBL) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM STR RDTBL) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) (\STRINGWIDTH.GENERIC STR (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) RDTBL (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA]) (\SWITCHFONTS.PSC - [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") - (* ; "Edited 11-May-93 02:11 by jds") + [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") + (* ; "Edited 11-May-93 02:11 by jds") - (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") + (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") (LET* [(FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of POSTSCRIPTDATA)) - (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - OTHERDEVICEFONTPROPS - ) of FONT) - 'PSCFONT] + (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS + ) of FONT) + 'PSCFONT] [COND [(LISTP FONTID) [COND @@ -1998,11 +2081,10 @@ ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) *POSTSCRIPT-UNACCENTED-FONTS*)) (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") - (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of - FONTID) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) " /" (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) "-Acnt") @@ -2012,8 +2094,7 @@ (COND ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) *POSTSCRIPT-UNACCENTED-FONTS*) - (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH NIL) + (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA WITH NIL) (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) " findfont [" (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) @@ -2027,11 +2108,9 @@ (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) 100) " 0 0] makefont setfont" :EOL)) - (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH T) - (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) - of FONTID) - "-Acnt") + (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA WITH T) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) + "-Acnt") " findfont [" (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) @@ -2045,56 +2124,46 @@ 100) " 0 0] makefont setfont" :EOL] (T [COND - ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of - POSTSCRIPTDATA - ))) + ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of POSTSCRIPTDATA))) ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*)) (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") (POSTSCRIPT.PUTCOMMAND STREAM "/" FONTID " /" (CONCAT FONTID "-Acnt") " encodefont" :EOL) - (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF - POSTSCRIPTDATA + (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF POSTSCRIPTDATA ] (COND ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*) - (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with NIL) + (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA with NIL) (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) + of FONT) + 100) " /" FONTID " F" :EOL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with T) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA with T) (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) + of FONT) + 100) " /" (CONCAT FONTID "-Acnt") " F" :EOL] - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with - NIL]) + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with NIL]) (\TERPRI.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (NEWY (PLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) (ffetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of IMAGEDATA] (COND - ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] + ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] (DSPNEWPAGE STREAM)) (T (replace (STREAM CHARPOSITION) of STREAM with 0) - (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) - of IMAGEDATA) + (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) NEWY))) NIL]) ) @@ -2115,8 +2184,9 @@ (\BLTSHADE.PSC [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (* ; "Edited 26-Apr-2025 17:43 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (* ;; "Maybe we should do something with OPERATION") @@ -2124,12 +2194,10 @@ (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) TEXTUREBM TEXTUREWIDTH LEFT BOTTOM WIDTH HEIGHT) [COND - [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch ( - \POSTSCRIPTDATA - + [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch (\POSTSCRIPTDATA + POSTSCRIPTCLIPPINGREGION - ) of - IMAGEDATA] + ) of IMAGEDATA] (T (SETQ RGN (INTERSECTREGIONS RGN (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA] (COND @@ -2140,16 +2208,12 @@ [COND ((FIXP TEXTURE) (SETQ TEXTURE (SELECT TEXTURE ((BLACKSHADE -1) - 0.0) - (WHITESHADE 1.0) + 'BLACK) + (WHITESHADE 'WHITE) TEXTURE] - [COND - ((AND (FLOATP TEXTURE) - (<= 0.0 TEXTURE 1.0)) - (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " - TEXTURE " R" :EOL)) - ((OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) + (COND + ((OR (NULL TEXTURE) + (TEXTUREP TEXTURE)) (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) (SETQ TEXTUREWIDTH 16) (BLTSHADE TEXTURE TEXTUREBM)) @@ -2157,7 +2221,15 @@ (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) (fetch BITMAPHEIGHT of TEXTUREBM))) (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE] + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) + (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " + (CAR TEXTURE) + " " + (CADR TEXTURE) + " " + (CADDR TEXTURE) + " R" :EOL))) (COND (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) @@ -2185,15 +2257,12 @@ (T NIL]) (\CHARWIDTH.PSC - [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") (COND ((EQ CHARCODE (CHARCODE SPACE)) - (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) - of STREAM))) - ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM - IMAGEDATA - ) - of STREAM)) + (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) of STREAM))) + ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM IMAGEDATA) + of STREAM)) CHARCODE]) (\CREATECHARSET.PSC @@ -2224,8 +2293,9 @@ (\DRAWARC.PSC [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (* ; "Edited 26-Apr-2025 17:16 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) WIDTH COLOR) [COND @@ -2240,8 +2310,7 @@ [Using ROUND BRUSH]" T))) (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") + (T (* ; "If FUNCTIONAL BRUSH big trouble!") (printout T T "[In \DRAWARC.PSC: Functional BRUSH not supported.] [Using ROUND 1 point BRUSH]" T) @@ -2250,29 +2319,26 @@ ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) + " ")) (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " CENTERX + " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) " arc stroke" :EOL "grestore" :EOL))) (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:16 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) WIDTH COLOR) [COND @@ -2287,8 +2353,7 @@ [Using ROUND BRUSH]" T))) (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") + (T (* ; "If FUNCTIONAL BRUSH big trouble!") (printout T T "[In \DRAWCIRCLE.PSC: Functional BRUSH not supported.] [Using (ROUND 1) BRUSH]" T) @@ -2297,27 +2362,25 @@ ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) + " ")) (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " CENTERX + " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWCURVE.PSC - [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:17 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) WIDTH SHAPE COLOR PSPLINE XA YA DXA DYA N PREVX PREVY PREV-DX3 PREV-DY3) [COND @@ -2340,20 +2403,16 @@ ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") + " ") - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") ) (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) (SETQ PSPLINE (PARAMETRICSPLINE KNOTS CLOSED NIL)) @@ -2363,9 +2422,9 @@ (SETQ DXA (pop PSPLINE)) (SETQ DYA (pop PSPLINE)) (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") WIDTH " setlinewidth " (SETQ PREVX (ELT XA 1)) " " (SETQ PREVY (ELT YA 1)) @@ -2374,28 +2433,27 @@ 3.0)) (SETQ PREV-DY3 (FQUOTIENT (ELT DYA 1) 3.0)) - (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND - STREAM - (FPLUS PREVX PREV-DX3) - " " - (FPLUS PREVY PREV-DY3) - " " - (FDIFFERENCE (SETQ PREVX (ELT XA C)) - (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) - 3.0))) - " " - (FDIFFERENCE (SETQ PREVY (ELT YA C)) - (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) - 3.0))) - " " PREVX " " PREVY " curveto" :EOL)) + (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND STREAM (FPLUS PREVX PREV-DX3) + " " + (FPLUS PREVY PREV-DY3) + " " + (FDIFFERENCE (SETQ PREVX (ELT XA C)) + (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) + 3.0))) + " " + (FDIFFERENCE (SETQ PREVY (ELT YA C)) + (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) + 3.0))) + " " PREVX " " PREVY " curveto" :EOL)) (POSTSCRIPT.PUTCOMMAND STREAM "stroke" :EOL "grestore" :EOL))) (\MOVETO.PSC STREAM PREVX PREVY)) NIL]) (\DRAWELLIPSE.PSC [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (* ; "Edited 26-Apr-2025 17:18 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) WIDTH COLOR) [COND @@ -2410,8 +2468,7 @@ [Using ROUND BRUSH]" T))) (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH, big trouble!") + (T (* ; "If FUNCTIONAL BRUSH, big trouble!") (printout T T "[In \DRAWELLIPSE.PSC: Functional BRUSH not supported.] [Using (ROUND 1) BRUSH]" T) @@ -2420,30 +2477,27 @@ ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") + " ") - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") ) (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " CENTERX + " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION " 0 360 ellipse stroke" :EOL "grestore" :EOL))) (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWLINE.PSC - [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) (* ; "Edited 26-Apr-2025 17:30 by mth") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (* ;; "DRAWLINE method for postscript streams.") @@ -2463,43 +2517,43 @@ (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) ((NOT (OR (FLOATP COLOR) - (LISTP DASHING))) (* ; "Simple case, no dash or gray") + (LISTP DASHING))) (* ; "Simple case, no dash or color") (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) - (T (* ; - "COLOR is interpreted as gray factor") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " - (OR (FLOATP COLOR) - "0") - " [") - (for D in (LISTP DASHING) do - - (* ;; - "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") - - (POSTSCRIPT.PUTCOMMAND STREAM - (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR)) + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " (CAR COLOR) + " " + (CADR COLOR) + " " + (CADDR COLOR) + " [") + (for D in (LISTP DASHING) do + (* ;; + "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") + + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) (\DRAWPOINT.PSC - [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") + [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") (* ;; "draw a point on the stream ") (if (BITMAPP BRUSH) then (LET ((WIDTH (fetch BITMAPWIDTH of BRUSH)) - (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) - (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) - (- Y (IQUOTIENT HEIGHT 2)) - WIDTH HEIGHT OPERATION)) + (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) + (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) + (- Y (IQUOTIENT HEIGHT 2)) + WIDTH HEIGHT OPERATION)) else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) (\DRAWPOLYGON.PSC - [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING)(* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:32 by mth") + (* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") (LET ((LASTPOINT (CAR (LAST POINTS))) (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) WIDTH SHAPE COLOR) @@ -2523,35 +2577,31 @@ ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) + ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") + " ") - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") ) (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") WIDTH " setlinewidth " (fetch (POSITION XCOORD) of (CAR POINTS)) " " (fetch (POSITION YCOORD) of (CAR POINTS)) " M" :EOL) - (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM - (fetch (POSITION XCOORD) of P) - " " - (fetch (POSITION YCOORD) of P) - " lineto" :EOL)) + (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) + of P) + " " + (fetch (POSITION YCOORD) of P) + " lineto" :EOL)) (COND (CLOSED (POSTSCRIPT.PUTCOMMAND STREAM " closepath"))) (POSTSCRIPT.PUTCOMMAND STREAM " stroke" :EOL "grestore" :EOL))) @@ -2559,17 +2609,18 @@ (fetch (POSITION YCOORD) of LASTPOINT]) (\DSPBOTTOMMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) of STREAM)) (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) - of (fetch (STREAM IMAGEDATA) of STREAM) with YPOSITION))))]) + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM) with + YPOSITION + ))))]) (\DSPCLIPPINGREGION.PSC - [LAMBDA (STREAM REGION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM REGION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OLDCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (COND @@ -2582,33 +2633,33 @@ (EQP (fetch (REGION HEIGHT) of OLDCLIP) (fetch (REGION HEIGHT) of REGION] (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - REGION) + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with REGION) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) (\FIXLINELENGTH.PSC STREAM IMAGEDATA))) OLDCLIP]) (\DSPCOLOR.PSC - [LAMBDA (STREAM COLOR) (* ; "Edited 14-Jan-93 17:14 by jds") + [LAMBDA (STREAM COLOR) (* ; "Edited 26-Apr-2025 17:03 by mth") + (* ; "Edited 14-Jan-93 17:14 by jds") + + (* ;; " Code below adapted from 7-Oct-1989 version by DJVB") (* ;; - "Postscript %"color%" setter -- really sets gray shade for now. 0.0 = black, 1.0 = white.") + " All postscript printers accept color RGB info, though most just pick a gray based on values") - (POSTSCRIPT.SHOWACCUM STREAM) - (PROG1 (FETCH (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM)) - (COND - ((AND (NUMBERP COLOR) - (<= 0 COLOR 1)) - (REPLACE (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM) WITH COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL COLOR " setgray ")) - (COLOR (\ILLEGAL.ARG COLOR))))]) + (LET* ((PSDATA (fetch IMAGEDATA of STREAM)) + (CURRENT (fetch (\POSTSCRIPTDATA POSTSCRIPTCOLOR) of PSDATA)) + RGB) + (if COLOR + then (SETQ RGB (\PSC.COLOR.TO.RGB COLOR)) + (replace (\POSTSCRIPTDATA POSTSCRIPTCOLOR) of PSDATA with RGB) + (POSTSCRIPT.PUTRGBCOLOR STREAM RGB)) + CURRENT]) (\DSPFONT.PSC - [LAMBDA (STREAM FONT) (* ; - "Edited 26-May-93 01:06 by sybalsky:mv:envos") - (* ; "Edited 11-May-93 02:11 by jds") + [LAMBDA (STREAM FONT) (* ; + "Edited 26-May-93 01:06 by sybalsky:mv:envos") + (* ; "Edited 11-May-93 02:11 by jds") (* ; "Edited 19-Jan-93 17:17 by jds") (* ;; "Change fonts on the PostScript stream STREAM to be FONT.") @@ -2626,8 +2677,8 @@ (* ;; "OK, it's a good font.") - (POSTSCRIPT.SHOWACCUM STREAM) (* ; - " Write out any accumulated characters.") + (POSTSCRIPT.SHOWACCUM STREAM) (* ; + " Write out any accumulated characters.") (* ;; "Change the font in the Lisp stream:") @@ -2636,116 +2687,108 @@ (* ;; "and now update all font-dependent fields in the imagedata, EXCEPT POSTSCRIPTSPACEWIDTH and POSTSCRIPTNATURALSPACEWIDTH. These latter 2 must stay as-is up thru the actual writing of characters by SHOWACCUM, so") (\POSTSCRIPT.CHANGECHARSET IMAGEDATA 0) - (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of - NEWFONT))) + (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of NEWFONT))) [replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) - of IMAGEDATA) - (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA with (\FGETWIDTH (fetch - (\POSTSCRIPTDATA + with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA) + (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA with (\FGETWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) - of IMAGEDATA) - (CHARCODE SPACE] + of IMAGEDATA) + (CHARCODE SPACE] (\FIXLINELENGTH.PSC STREAM IMAGEDATA) - [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - - OTHERDEVICEFONTPROPS - ) of - NEWFONT - ) - 'PSCFONT] + [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR + OTHERDEVICEFONTPROPS) + of NEWFONT) + 'PSCFONT] (COND ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) *POSTSCRIPT-UNACCENTED-FONTS*) (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF IMAGEDATA WITH NIL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with - T))) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with T))) (* ;; "Remember to actually write a change command") - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with - T))) + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) OLDFONT]) (\DSPLEFTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with XPOSITION) + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with + XPOSITION + ) (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) (\DSPLINEFEED.PSC - [LAMBDA (STREAM LINELEADING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) - of STREAM)) + [LAMBDA (STREAM LINELEADING) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) of STREAM)) (COND - (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) - of (fetch (STREAM IMAGEDATA) of STREAM) with LINELEADING)) - ))]) + (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) + of STREAM) + with LINELEADING))))]) (\DSPPUSHSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (push (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA) - (create POSTSCRIPTXFORM - PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA)) - PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of - IMAGEDATA)) - PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - ) - PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) - PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) - of IMAGEDATA]) + (create POSTSCRIPTXFORM + PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA) + ) + PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) + PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA]) (\DSPPOPSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (XFORM (pop (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXCLIP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXPAGE) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXBOTTOM) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXTOP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLEFT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXRIGHT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLAND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXXFORMPEND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with - (fetch ( + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with (fetch ( POSTSCRIPTXFORM - PSXTRANX) + PSXCLIP) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXPAGE) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXBOTTOM) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXTOP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with - (fetch ( - POSTSCRIPTXFORM - PSXTRANY) - of XFORM]) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXLEFT) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXRIGHT) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXLAND) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXXFORMPEND) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXTRANX) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with (fetch (POSTSCRIPTXFORM + PSXTRANY) + of XFORM]) (\DSPRESET.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (replace (STREAM CHARPOSITION) of STREAM with 0) (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) @@ -2754,30 +2797,30 @@ 'ASCENT]) (\DSPRIGHTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with XPOSITION) + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with + XPOSITION + ) (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) (\DSPROTATE.PSC - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (* ;; "rotate the postscript stream by ROTATION") (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OROT (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA)) LAND C0 P0 C P ML MB MR MT) (COND - ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) - of IMAGEDATA))) + ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA))) (POSTSCRIPT.SHOWACCUM STREAM) (replace (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA with ROTATION) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) @@ -2785,8 +2828,8 @@ OROT]) (\DSPSCALE.PSC - [LAMBDA (STREAM SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) NSCALE) @@ -2800,15 +2843,15 @@ (SETQ NSCALE (QUOTIENT SCALE OSCALE)) (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") (POSTSCRIPT.PUTCOMMAND STREAM " " NSCALE " " NSCALE " scale" :EOL) (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with SCALE))) OSCALE]) (\DSPSCALE2.PSC - [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (* ;; "SETS X AND Y SCALE ") @@ -2822,14 +2865,14 @@ (\UPDATE.PSC STREAM IMAGEDATA) (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") (POSTSCRIPT.PUTCOMMAND STREAM " " X-SCALE " " Y-SCALE " scale" :EOL))) T]) (\DSPSPACEFACTOR.PSC - [LAMBDA (STREAM FACTOR) (* ; - "Edited 26-May-93 01:18 by sybalsky:mv:envos") + [LAMBDA (STREAM FACTOR) (* ; + "Edited 26-May-93 01:18 by sybalsky:mv:envos") (DECLARE (LOCALVARS . T)) (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OLDFACTOR (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA))) @@ -2839,25 +2882,22 @@ (POSTSCRIPT.SHOWACCUM STREAM) (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA with FACTOR) (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA] + with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA] OLDFACTOR]) (\DSPTOPMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) of STREAM)) (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch - (STREAM IMAGEDATA) - of STREAM) - with YPOSITION))))]) + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM) with YPOSITION) + )))]) (\DSPTRANSLATE.PSC - [LAMBDA (STREAM TX TY) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM TX TY) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (MDX (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) TX)) @@ -2867,17 +2907,12 @@ ((NOT (AND (ZEROP MDX) (ZEROP MDY))) (POSTSCRIPT.SHOWACCUM STREAM) - (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) do (CL:INCF (fetch (REGION - LEFT) - of REG) - MDX) - (CL:INCF (fetch (REGION - BOTTOM) - of REG) - MDY)) + (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) + do (CL:INCF (fetch (REGION LEFT) of REG) + MDX) + (CL:INCF (fetch (REGION BOTTOM) of REG) + MDY)) (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) MDX) (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) @@ -2895,19 +2930,18 @@ (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T]) (\DSPXPOSITION.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) OLDX) (PROG1 (SETQ OLDX (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) [COND ((AND XPOSITION (NOT (EQUAL XPOSITION OLDX))) - (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA])]) + (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA])]) (\DSPYPOSITION.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) OLDY) (PROG1 (SETQ OLDY (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA)) @@ -2917,53 +2951,48 @@ YPOSITION))))]) (\FILLCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") + [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 26-Apr-2025 17:40 by mth") + (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") (LET (TEXTUREBM TEXTUREWIDTH) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (if (FIXP TEXTURE) + [if (FIXP TEXTURE) then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + then (SETQ TEXTURE 'WHITE) + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 'BLACK] + (COND + ((OR (NULL TEXTURE) + (TEXTUREP TEXTURE)) + (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM)) + ((BITMAPP TEXTURE) + (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) (if TEXTUREBM then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" :EOL) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " POSTSCRIPT.TEXTURE.SCALE + " mul setpattern eofill" :EOL "grestore" :EOL) else (POSTSCRIPT.PUTCOMMAND STREAM " eofill" :EOL "grestore" :EOL)) (\MOVETO.PSC STREAM CENTERX CENTERY]) (\FILLPOLYGON.PSC - [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) - (* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) (* ; "Edited 26-Apr-2025 17:40 by mth") + (* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") (DECLARE (SPECVARS FILL.WRULE)) (* ;; "OPERATION is ignored here") @@ -2972,86 +3001,76 @@ TEXTUREBM TEXTUREWIDTH) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") (if (NOT (OR (ZEROP WINDNUMBER) - (EQL WINDNUMBER 1))) + (EQL WINDNUMBER 1))) then (SETQ WINDNUMBER FILL.WRULE)) - (if (FIXP TEXTURE) + [if (FIXP TEXTURE) then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + then (SETQ TEXTURE 'WHITE) + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 'BLACK] + (COND + ((OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM)) + ((BITMAPP TEXTURE) + (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) " " (fetch (POSITION YCOORD) of (CAR KNOTS)) " M" :EOL) - (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch - (POSITION XCOORD) - of K) - " " - (fetch (POSITION YCOORD) of K) - " lineto" :EOL)) + (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of K) + " " + (fetch (POSITION YCOORD) of K) + " lineto" :EOL)) (POSTSCRIPT.PUTCOMMAND STREAM " closepath" :EOL) (if TEXTUREBM then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern")) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " POSTSCRIPT.TEXTURE.SCALE + " mul setpattern")) (POSTSCRIPT.PUTCOMMAND STREAM (if (ZEROP WINDNUMBER) - then " fill" - else " eofill") + then " fill" + else " eofill") :EOL "grestore" :EOL) (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) (fetch (POSITION YCOORD) of LASTPOINT]) (\FIXLINELENGTH.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (* ;; "Called by margin, font or rotation change to update the LINELENGTH field in the stream.") (LET [(TMP (MIN MAX.SMALLP (FIX (QUOTIENT (DIFFERENCE (fetch (\POSTSCRIPTDATA - POSTSCRIPTRIGHTMARGIN) + POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTLEFTMARGIN) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA)) - (fetch FONTAVGCHARWIDTH of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] + (fetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] (replace (STREAM LINELENGTH) of STREAM with (COND - ((GREATERP TMP 1) - TMP) - (T 10]) + ((GREATERP TMP 1) + TMP) + (T 10]) (\MOVETO.PSC - [LAMBDA (STREAM X Y) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM X Y) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) (COND ([NOT (AND (EQP X (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) @@ -3074,10 +3093,10 @@ (DEFINEQ (\POSTSCRIPT.CHANGECHARSET - [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") + [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") (* ;; -"Called when the character set information cached in a display stream doesn't correspond to CHARSET") + "Called when the character set information cached in a display stream doesn't correspond to CHARSET") (PROG* ((FONT (ffetch POSTSCRIPTFONT of PSDATA)) (CSINFO (\GETCHARSETINFO CHARSET FONT))) @@ -3085,20 +3104,19 @@ (* ;; "since the call to \getcharsetinfo has NOSLUG? = NIL, we know that we will get a reasonable character set back") (UNINTERRUPTABLY - (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) - of CSINFO)) + (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) of CSINFO)) (freplace POSTSCRIPTNSCHARSET of PSDATA with CHARSET))]) (\POSTSCRIPT.OUTCHARFN - [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") + [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") -(* ;;; "Output a character to be printed.") +(* ;;; "Output a character to be printed.") -(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") +(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") -(* ;;; "This is called a lot, so the code is unrolled for efficiency.") +(* ;;; "This is called a lot, so the code is unrolled for efficiency.") (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE) (LOCALVARS . T)) @@ -3109,26 +3127,22 @@ (CL:UNLESS (EQ (\CHARSET CHAR) (ffetch POSTSCRIPTNSCHARSET of IMAGEDATA)) - (* ;; "Switch character set so that we get the right char width.") + (* ;; "Switch character set so that we get the right char width.") (\POSTSCRIPT.CHANGECHARSET IMAGEDATA (\CHARSET CHAR))) [SETQ CHARWID (SELCHARQ CHAR - (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of - IMAGEDATA - )) - (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of - IMAGEDATA - ) + (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA)) + (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of IMAGEDATA) (\CHAR8CODE CHAR] - (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") + (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") [COND [[OR (NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA)) (AND (ILEQ CHAR 254) (NOT (CL:AREF \POSTSCRIPT.CHARTYPE CHAR] - (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") + (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") [COND ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) @@ -3139,8 +3153,7 @@ (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) (\UPDATE.PSC STREAM IMAGEDATA) (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with - T)) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T)) (COND [(ILESSP CHAR (CHARCODE " ")) (BOUT STREAM (CHARCODE \)) @@ -3164,8 +3177,8 @@ (BOUT STREAM CHAR)) (BOUT STREAM CHAR] [(SETQ MAPPING (GETHASH CHAR *POSTSCRIPT-NS-HASH*)) - (* ; - "Special character that's taken care of by the NS mapping.") + (* ; + "Special character that's taken care of by the NS mapping.") [COND ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) @@ -3174,48 +3187,46 @@ CHARWID] (SELECTQ (CAR MAPPING) (NIL - (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") + (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING))) (SYMBOL - (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") + (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) 'SYMBOL)) - (ACCENT (* ; "Special accent mapping we did") + (ACCENT (* ; "Special accent mapping we did") (\POSTSCRIPT.ACCENTFN STREAM (CADR MAPPING))) - (ACCENTPAIR (* ; - "Given base char & accent, overlap them.") + (ACCENTPAIR (* ; + "Given base char & accent, overlap them.") (\POSTSCRIPT.ACCENTPAIR STREAM (CADR MAPPING) (CADDR MAPPING) (CADDDR MAPPING))) - (DINGBAT (* ; "A Zapf dingbat") + (DINGBAT (* ; "A Zapf dingbat") (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) 'ZAPFDINGBATS)) (APPLY* (POSTSCRIPT.SHOWACCUM STREAM) (\UPDATE.PSC STREAM IMAGEDATA) - (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") + (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") [freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA - with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF - IMAGEDATA - ) - (APPLY* (CADDR MAPPING) - STREAM - (CADR MAPPING)))]) - (FUNCTION (* ; "Done as special PS code.") + with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) + (APPLY* (CADDR MAPPING) + STREAM + (CADR MAPPING)))]) + (FUNCTION (* ; "Done as special PS code.") (POSTSCRIPT.SHOWACCUM STREAM) (\UPDATE.PSC STREAM IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM (CADR MAPPING))) (\ILLEGAL.ARG (CAR MAPPING] - (T (* ; "Special char") + (T (* ; "Special char") (SELCHARQ CHAR ((EOL LF) (\TERPRI.PSC STREAM) - (* ;; - "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") + (* ;; + "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) (FF (DSPNEWPAGE STREAM) @@ -3225,12 +3236,12 @@ ((IGREATERP NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA + ) (\POSTSCRIPTTAB IMAGEDATA] (\MOVETO.PSC STREAM NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA))) - ("357,140" (* ; " Ballot box, checked") + of IMAGEDATA))) + ("357,140" (* ; " Ballot box, checked") [COND ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) @@ -3241,20 +3252,17 @@ CHARWID] (LET ((OLDFONT (\DSPFONT.PSC STREAM))) (POSTSCRIPT.SHOWACCUM STREAM) - (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch - (FONTDESCRIPTOR - FONTSIZE) - of OLDFONT) - (fetch (FONTDESCRIPTOR - FONTFACE) - of OLDFONT))) + (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch (FONTDESCRIPTOR + FONTSIZE) + of OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) + of OLDFONT))) (\UPDATE.PSC STREAM IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " bboxchk ") (\DSPFONT.PSC STREAM OLDFONT))) (PROGN [COND ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) (\TERPRI.PSC STREAM) (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) @@ -3262,7 +3270,7 @@ (COND ((IGEQ CHAR 255) - (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") + (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") (\POSTSCRIPT.PRINTSLUG STREAM CHAR)) (T (SETQ CHAR (\CHAR8CODE CHAR)) @@ -3271,8 +3279,8 @@ of IMAGEDATA)) (\UPDATE.PSC STREAM IMAGEDATA) (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) - of IMAGEDATA with T))) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA + with T))) (BOUT STREAM (CHARCODE \)) (SELCHARQ CHAR ((%( %) \) @@ -3287,44 +3295,40 @@ CHAR]) (\POSTSCRIPT.PRINTSLUG - [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") + [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") -(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") +(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") (DECLARE (LOCALVARS . T)) (LET ((IMAGEDATA (FETCH (STREAM IMAGEDATA) OF STREAM))) - (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF - IMAGEDATA - ) + (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) OF IMAGEDATA) (\CHAR8CODE CHAR)) - (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA - POSTSCRIPTFONT) - OF IMAGEDATA)) + (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA POSTSCRIPTFONT) + OF IMAGEDATA)) 'PAINT) (\MOVETO.PSC STREAM (IPLUS (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) - (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) - OF IMAGEDATA) - (\CHAR8CODE CHAR))) + (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) + OF IMAGEDATA) + (\CHAR8CODE CHAR))) (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA]) (\POSTSCRIPT.SPECIALOUTCHARFN - [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") + [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") -(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") +(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") (DECLARE (LOCALVARS . T)) (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) (OLDFONT (AND FAMILY (\DSPFONT.PSC STREAM] (CL:WHEN OLDFONT - (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of - OLDFONT) - (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) + (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) (\UPDATE.PSC STREAM IMAGEDATA) (BOUT STREAM (CHARCODE %()) @@ -3355,19 +3359,19 @@ CHAR]) (\UPDATE.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") (* ;; "Make any outstanding font, scale, location updates, prepatory to something that might depend heavily on it. (e.g. before starting to output characters, or making a scale change)") (* ; - "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") + "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") (COND ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) (\SETXFORM.PSC STREAM IMAGEDATA))) (COND ((ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA) (* ; - "If font was changed then switch before printing") + "If font was changed then switch before printing") (\SWITCHFONTS.PSC STREAM IMAGEDATA))) (COND ((ffetch (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA) @@ -3375,12 +3379,12 @@ (\SETPOS.PSC STREAM IMAGEDATA]) (\POSTSCRIPT.ACCENTFN - [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") - (* ; "Edited 3-Feb-93 01:05 by jds") + [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") + (* ; "Edited 3-Feb-93 01:05 by jds") -(* ;;; "Output an accented character to be printed. .") +(* ;;; "Output an accented character to be printed. .") -(* ;;;; "Need to inc CHARPOSITION of STREAM") +(* ;;;; "Need to inc CHARPOSITION of STREAM") (DECLARE (LOCALVARS . T)) (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) @@ -3391,12 +3395,12 @@ (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T))) (BOUT STREAM (CHARCODE "\")) (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) + -3) do (BOUT STREAM CH)) CHAR]) (\POSTSCRIPT.ACCENTPAIR - [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; - "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") + [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; + "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") (* ; "Edited 3-Feb-93 01:29 by jds") (* ;;; "Output an accented character to be printed. .") @@ -3411,31 +3415,29 @@ (BOUT STREAM (CHARCODE %()) (BOUT STREAM (CHARCODE "\")) (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) + -3) do (BOUT STREAM CH)) (BOUT STREAM (CHARCODE %))) (BOUT STREAM (CHARCODE %()) (for ACCENT inside ACCENTS do (BOUT STREAM (CHARCODE "\")) - (for CH - instring (SUBSTRING (CONCAT "000" - (OCTALSTRING - ACCENT)) - -3) - do (BOUT STREAM CH))) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT + )) + -3) do (BOUT STREAM CH))) (POSTSCRIPT.PUTCOMMAND STREAM ") (") - (for ACCENT inside UNDER-ACCENTS - do (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT)) - -3) do (BOUT STREAM CH))) + (for ACCENT inside UNDER-ACCENTS do (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING + ACCENT)) + -3) + do (BOUT STREAM CH))) (BOUT STREAM (CHARCODE %))) (COND (NIL (OR (IEQP ACCENT (CHARCODE "0,313")) (IEQP ACCENT (CHARCODE "0,316"))) (* ; - "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") + "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") (POSTSCRIPT.PUTCOMMAND STREAM " 0 ")) ((ILESSP CHAR (CHARCODE a)) (* ; - "upper case, so adjust offset for accent") + "upper case, so adjust offset for accent") (POSTSCRIPT.PUTCOMMAND STREAM " " (/ (fetch \SFAscent of FONT) - 3.0) + 3.0) " ")) (T (POSTSCRIPT.PUTCOMMAND STREAM " 0 "))) (POSTSCRIPT.PUTCOMMAND STREAM " " (FONTPROP FONT 'SIZE) @@ -4124,12 +4126,12 @@ "/DR {transform round exch round exch itransform} bdef" "/L {gsave newpath setlinewidth 0 setlinecap" " M lineto currentpoint stroke grestore M} bdef" - "/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" + "/L1 {gsave newpath 0 setdash setrgbcolor setlinewidth 0 setlinecap" " M lineto currentpoint stroke grestore M} bdef" "/F {findfont exch scalefont setfont} bdef" "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" " neg 0 rlineto closepath clip newpath} bdef" - "/R {gsave setgray newpath M dup 0 rlineto exch 0 exch" + "/R {gsave setrgbcolor newpath M dup 0 rlineto exch 0 exch" " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" " /startangle exch def" " /orientation exch def" " /minorrad exch def" @@ -4383,38 +4385,38 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 . -32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) ( -PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) ( -PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) ( -POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640 -74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 ( -POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) ( -POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE -81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) ( -POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND -94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) ( -POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042) -(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737) -(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) ( -\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 . -126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 . -133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 . -142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 . -147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) ( -\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881) - (\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 . -160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956 - . 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 . -167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC -169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) ( -\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 . -180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 ( -\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) ( -\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC -199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) ( -205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 . -206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 . -255003))))) + (FILEMAP (NIL (23896 32009 (POSTSCRIPT.INIT 23906 . 30998) (POSTSCRIPT.PUTRGBCOLOR 31000 . 31401) ( +\PSC.COLOR.TO.RGB 31403 . 32007)) (32995 67779 (PSCFONT.READFONT 33005 . 34913) (PSCFONT.SPELLFILE +34915 . 35493) (PSCFONT.COERCEFILE 35495 . 37067) (PSCFONTFROMCACHE.SPELLFILE 37069 . 38054) ( +PSCFONTFROMCACHE.COERCEFILE 38056 . 39708) (PSCFONT.WRITEFONT 39710 . 40725) (READ-AFM-FILE 40727 . +46598) (CONVERT-AFM-FILES 46600 . 47812) (POSTSCRIPT.GETFONTID 47814 . 49209) (POSTSCRIPT.FONTCREATE +49211 . 61610) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 61612 . 64009) (POSTSCRIPT.FONTSAVAILABLE 64011 + . 67777)) (68334 77619 (OPENPOSTSCRIPTSTREAM 68344 . 77285) (CLOSEPOSTSCRIPTSTREAM 77287 . 77617)) ( +77664 83714 (POSTSCRIPT.HARDCOPYW 77674 . 80781) (POSTSCRIPT.TEDIT 80783 . 81263) (POSTSCRIPT.TEXT +81265 . 81556) (POSTSCRIPTFILEP 81558 . 82665) (MAKEEPSFILE 82667 . 83712)) (83715 127289 ( +POSTSCRIPT.BITMAPSCALE 83725 . 86181) (POSTSCRIPT.CLOSESTRING 86183 . 86736) (POSTSCRIPT.ENDPAGE 86738 + . 87629) (POSTSCRIPT.OUTSTR 87631 . 88848) (POSTSCRIPT.PUTBITMAPBYTES 88850 . 97321) ( +POSTSCRIPT.PUTCOMMAND 97323 . 98312) (POSTSCRIPT.SET-FAKE-LANDSCAPE 98314 . 102834) ( +POSTSCRIPT.SHOWACCUM 102836 . 104991) (POSTSCRIPT.STARTPAGE 104993 . 107525) (\POSTSCRIPTTAB 107527 . +108324) (\PS.BOUTFIXP 108326 . 109606) (\PS.SCALEHACK 109608 . 112251) (\PS.SCALEREGION 112253 . +112813) (\SCALEDBITBLT.PSC 112815 . 117125) (\SETPOS.PSC 117127 . 117608) (\SETXFORM.PSC 117610 . +120194) (\STRINGWIDTH.PSC 120196 . 120669) (\SWITCHFONTS.PSC 120671 . 126163) (\TERPRI.PSC 126165 . +127287)) (127324 180617 (\BITBLT.PSC 127334 . 127887) (\BLTSHADE.PSC 127889 . 132280) (\CHARWIDTH.PSC +132282 . 132789) (\CREATECHARSET.PSC 132791 . 134489) (\DRAWARC.PSC 134491 . 136847) (\DRAWCIRCLE.PSC +136849 . 139078) (\DRAWCURVE.PSC 139080 . 142902) (\DRAWELLIPSE.PSC 142904 . 145246) (\DRAWLINE.PSC +145248 . 147500) (\DRAWPOINT.PSC 147502 . 148078) (\DRAWPOLYGON.PSC 148080 . 151187) ( +\DSPBOTTOMMARGIN.PSC 151189 . 151876) (\DSPCLIPPINGREGION.PSC 151878 . 153253) (\DSPCOLOR.PSC 153255 + . 154095) (\DSPFONT.PSC 154097 . 157616) (\DSPLEFTMARGIN.PSC 157618 . 158304) (\DSPLINEFEED.PSC +158306 . 158896) (\DSPPUSHSTATE.PSC 158898 . 160358) (\DSPPOPSTATE.PSC 160360 . 163845) (\DSPRESET.PSC + 163847 . 164512) (\DSPRIGHTMARGIN.PSC 164514 . 165203) (\DSPROTATE.PSC 165205 . 166204) ( +\DSPSCALE.PSC 166206 . 167158) (\DSPSCALE2.PSC 167160 . 168000) (\DSPSPACEFACTOR.PSC 168002 . 168923) +(\DSPTOPMARGIN.PSC 168925 . 169496) (\DSPTRANSLATE.PSC 169498 . 171529) (\DSPXPOSITION.PSC 171531 . +172095) (\DSPYPOSITION.PSC 172097 . 172688) (\FILLCIRCLE.PSC 172690 . 174999) (\FILLPOLYGON.PSC 175001 + . 178325) (\FIXLINELENGTH.PSC 178327 . 179646) (\MOVETO.PSC 179648 . 180418) (\NEWPAGE.PSC 180420 . +180615)) (180673 202696 (\POSTSCRIPT.CHANGECHARSET 180683 . 181420) (\POSTSCRIPT.OUTCHARFN 181422 . +193550) (\POSTSCRIPT.PRINTSLUG 193552 . 195276) (\POSTSCRIPT.SPECIALOUTCHARFN 195278 . 197629) ( +\UPDATE.PSC 197631 . 198877) (\POSTSCRIPT.ACCENTFN 198879 . 199821) (\POSTSCRIPT.ACCENTPAIR 199823 . +202694)) (202794 204439 (\PSC.SPACEDISP 202804 . 203083) (\PSC.SPACEWID 203085 . 203704) (\PSC.SYMBOLS + 203706 . 204437)) (204548 207539 (\POSTSCRIPT.NSHASH 204558 . 207537)) (252022 252736 (POSTSCRIPTSEND + 252032 . 252734))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index b3c4a7e9db47575a4ec80189076341265f1a6bfa..8747828a0df6adc4d1082ce017d9665c5ac7e5bb 100644 GIT binary patch delta 9890 zcmc&)3v^V~xt^Ku93UhFOh^DXBVZyXoaa1JfjOB+X2>Kn&P;e2m*g=*%!>k|eP9%; zt+mUg?5p7QDx$4@+*?gDXcbFQTQ3FMYq@=h*vD;`SE&M(dS7eZu5!PBpEHx0M7p}} zx@%onoY`leea_kE|G)p+-~VquJ~8#ouckh@A)>hJjqN+?6-m*V>}k}rM#bl1wXW`= zf$hEhnI1MY$Xv|%xnQbg&vn~|1~O{~I(O|_6CK=@+0oy-bNiZsOizF2Gi&%-d-VoS z9djv4!2|V1-P5ReTx>@s|3GKv_U$`%E^lOscq*L=B%_IRL!v#MY;Fp~WAP;GNTdP{ zqS=s+H=vvGpR8WMS49`_)gR2}o7!jdkq=b<y{319Z%H9Y>|qEaXBY)A!+ zSSVryTKJbftmiL$=$hl~NQaV%WV8X#WxV{{65e!f<-Cqy(%2A+#iEH+NL+F9;d2Z4 z)90?_-#@3|$^U+C8LvJsqt$X==6lZTXpNm;#@{-xqP6s71z&t&4&QlURb@xvha{tI z=~S$}nK}8vQ;Yd8E-dB0yD)D!VMLRxcaS+<;r3XJ6&k6bp~1y^I(Na=pI|&)cGWp+ z!_inMkPI2=P!NMAyUgoif6+rzaxSX#FsGvHUd_iEL&0dezG)M44eZ+HVvT`_(bgPF z)u-dEHr$rt_F%=P$-d|arV^%e$ebNbv2-e81ceEm6Fh3Vv(Px>UgrLDgZzW@45qyJ z?P}rNw)RRmwgNrBJ#Yn|_Teu62>0mE@%$J;SgBN=XE{OJp8@olfZwSWLIRRDsI_~zT|_~-45 z>uQssKs*^t;rqsK4;pEsjx{Edq4m*td#WDiA->pN<@&4Qu_pVT{Zq4t$0t)5WsO0v zvo^{U7K+E#vM7@oMOu_e3bBb#?XgGyR6snm^(r)Rt;bhKPXboNdt54tnzx?IfD@&rqV_-oiLh1%q_BGx~?;BcVpyh^H!fekifLYj{A_Ztb+6{Z!*bU(FEhEAX&L~6z?PY&O8HJj z&2_@Y)@6L9*;3tlZlJ1rbDes#!eaFSBNbvQZWlmcs^p`W8mUw~fD?^QQkz%uOhG<)mDX?fq>-tzUl}1}-h}o(d zmB~Jp;bw#s@Zc!`3-1W7)L~FFjF?wb3nRK=oDjUKR^W1S>UV=RWwOMQ@w6eP=<#{k zzKe^U9^%}_W+R- zN4bk^B;KpT6*&m`Bwqg03f`5Sca5e`zFqamEZT}-NkuoqEP*scgsSm7!j(SN#}fGd zWO@^fpaN+WQ{qJN`N%~uMSbY{b^{RbX{<3FA}_<-eCSV=C5l(&!{G%>6c~K`F^U_Z zntzO{@{x}#-3mT_B64J}Cl3*?#0YDUSb7c_vfIPuKQCA%yYpa?b>L6XFOz{A+|fqP zYKm_J$Q0HTBVF_D=5|Aum`9N$3DKi7*K+&`4fdomyKdd?VjAEGL6N!H#Z(`ft9l1I zw`O+sel~M+XZJ2at*Xoek)gG z+9)@sM0!p-%5M4SYvSTvKP-87q-EX3eWSMbV=X`Vq3tDq zwExn-n*7<)clriiva#7|^z^9ykH*#>>*LpNth(xGBz7^|)%tKt1UKw$iM)2izb=1M zr0?{`k>B#KY>W)6vgr<01~)_kLP9;*?W~*JQ9eS@Gwo{Bc~UvBR&!!#T!A| z;8vOr%>aw0if|6c;zl|Fjzj1ZX)xJ~1t1t&kA`ev2}9w%&g0eDKWut+y8Q+|+8L>S zBr1GxZ?wg@T2 z?)e0DdMB^jww`}^+fN-{Eqhb%8znQ$RTnQ%2L1@JEg!sY9w`MMlYxBm4*Z9nusGKfL=z90zXOisR33Bh5bZ_Q6_bZ6P70g}@?^%LtiP`~$%YwUIq| z`=e79I&1Nr6WB^vGkg7>#*(Q}FkV?u)6;kU1~0h#u01%~_tGnS_l9vC+4}^J@w-=; zQ~S)_S3B%~*%n%`kHOwm@x z-?;b0JOn^TYkYkONf$|b&8zc=)>qBN+7GEK(kiA&8sBn!k;6xqD*3A2)g`K=@VlO= zx)B0yvO-g^I5f31Mbk(VAmk7Z(R8bku*3<0AeTSD@EBTj75Xm?;R6kp;CFnYJ2jx$XM5`yJb8u z*F?l^h(yx}WRSbyUZ!#RXa$eow`c)CqajFKTX$r3f>bl$UAM;XysyTgYy9#1Dj|7Y z?B?FV9$X*lzjary$fHU20KE;8lW7XkG>KacAS0!#f_bP1dG%ms*AVOOAKIDO-bu-s zid7g%v~_{bAw%goOvTz+coRKP)!l5^x~$_>CbU&e%iW`z(pps^Xw9b(%cDuBY-e|8 ze}*0da&&Fo*||Hz1~a$OM9``DC{&Up&&^pYWCgn5_RyQCK_e>AfWi_T5YzZYApiW! zdrO?P3O@xS4%|P_ir4$sIBHf*vDs$$P1cagmpZ~dYT3R`BXuRu@8CB+Ud`9+n|tkV zqEkyAHE9cr!YRK1uYk9RlVj_8MUZSh;9u9vr3cp8@8PfRYvM;Akjv#FXk+SxS%)Hv zA4%fZ^C}lGWr5Y2TeBoQklnWSl6h|DS-#)z?1kT89?WXj}JU}?Uhad z9anAynvhiWbnXO(WS==k*4_NY2UULQ;DQ-gqv(M*@cJjO;;SF3<69qE0>ZlYp}T9Y zfJdekcqEwj$o9NP-YoLStAE)ex9^MCzX*?H${@T8h(>Yq(c=rbw0ogL_VEN?Sn2lU zjqZkI6KR4Bg}(I(*6_bGJ|1J*9R9S754A^BBCB2)e>EAO;5r`83YK#UEEV?_xd23E zn%r`Q;>npDS;s_^n`2~f!h3(?&Y7G7$29ri!`JdVo~(w+UwHVey^J4xq|(0IGVe@& z=8@UgzE)^r`{79@ZZScB!vTLwFE8J}-2SbsXa61cvSKpVW&Ys$g?!}rLRAA(hd{>~ zLSFoWmg!eTLL+_wDe(*SB7S9^qGSc6B%MMNi(eVJL&8WJts&@>0BR-CHV~zk%e$)_ zvYXuKfXYO`sIm<8e7S%D6eb1?^LhB8C#v|nk6yjTS*t_j2uEp{fY|`|i3VkPqM;z6 zO+myb!S9-a{0XudbJ2M8Z`EOVR+nJ$anEW#oaQ1*LjvVu-M8-84ax-- zZ`LgPE2#8Wg{ZQ(-UL(3KhuUGnipi(P#6;wA&02EUxEzSz)yujy* z?&JQ0HB0|*==1nNPcD{o^a+h3;`q@g_c-jcdDWq-8r}(Ey$T6AhxO{mM&RSIEBt|= z(G&_dmo}Hp5m!cS+2+!zCC}@;_mDLEbIqlqx2tsQ(|qvIm5ZB8P36{HYAH4}tk#@z z{>GswkOTH~C?ZH5=2A8v>-way;#;2bK+w_(GC|SOD#AyeT1lazK<eJsD0WbpvFx4>p0+#_44Mgf&Tcw*WN6H7%c!P ziUFg?t4dVR6J#qSD`9q_UB|L-9;+NEkU#@CRI$cGkU;=khO$IPFtHRVLl~1HmcG6U zoTX|xhC;=`1Sr1LqN*Hc$*4bAoCT_|I181I$G@(TBUD<^$2m*I_6*3wk^!nnQwsDU zl`LG$l!x$KPMV=uLL3AK3&X>^Wa(lG0_OlOw9;Aq-JSfJ$0{6HmO)9=AS7^=80l*G zjaaW(R8W}VudIqdfJ=RXk}iJ3X9Yy~n_bX+C>7pZ!4o6PP0jcIH!JK|^#1!>L3}G} zyHt^<%^#6@h`KJ4Z&8s(;>!Z<$z%xisstvPNQv?g6|Bwug`$$RRzeluaT#glp=B>^ zJ7SDg8zQ!jn4RlTn?+jnDN3iJNJ&wfyo}4?#7WUa>9;76nBUX&5C39EIw)i5DnDGo zH$VG|=;uqG`yv`p2q>nQJ!hWVGRYkLGb5*9jh4}m%%`m#n?<=S;CkrU3cj~*KEE}4 zVouIbqBzM)@o^mQeTi;>djIiDH%*>;-w`&9IwqjO z3`vo&)KjH`ng}73NkkJRT(E;^!h;|N(S(!(ZqO830;`&6qGCrCcIri)4OAhT9yCz| zMJK(C-bHdY!RS?UWGv_jMz4~6QnvEtGh{skJ#w||jHCT#U4Y;Iz5C7Xyf3`R?iU|K z=?ELEF~9P^jt!KtFhgC409nWE15@n0@0GfcNH<322L~@*`skTp&%mXR_8${{T{HFv z1+vDf@=5!P{ber&BO)Ie*&H-;b|ZLrE&t$^#7|2mI;YS)9H4av2!Akg;^= zH87T<(ds%EgqzR76;w;M9Iq)+@PW9-7d=ru3}U_vc4ZII{Uo}A=*j2hNI!}*Zzy(TkqF%tDimdEhwGwvoWr$JevLfk68Lx|FhHkFx z?eC`y7pzr4vXY7nzB;Zz3ZsJByIcJ0&h&yk{u4lnfF1{Bz9f??7GVL* zqf!Q9ieO2Zcdl5(+}MW*Z|1QdN>np~iV@(_z$7LpJsuN+Dn2#`!TkCRfSW+YQfYz` zOKTpK2s8_naBmKjRH-+SC<9(rQv?yp_1JpJRguPbJ2g^BSED>cAk<)}0uXB8PytaB zp(s@tCl<64Y$pR!6>yt~M$1^|s zf_W?c*F?7E=g$dw@QVhsul}vCC#L*zoa8tTwg*?Q$vB_DWOw||>I{q|;l>Fuf#%!Ds`XZh54*~RP%zV4lx>Br*p z`cB_8k8e3sU;eJYzfMe|ztgygy^}ln6K9s$Z|2`Wv-Xqko@3oT@^;1OrCGf1oxft- zpNDwGFFg*_s7dx>_l|zc+;A;z|0QUL!;J_>=WI6>P-&+F`*VEcmsbqa9&w=sbi_k$ zk3#Hj=n$~E4r>QQM_i}co6H>xreXcY&Po6q)*6b2@j%*$rlZOw9)9Johx( zpW{bQ&$xw>?4n5!-gBeGBxuRWby$;7v9~im39O*GNvN1`;UsALM7$e2KEzvSc<|SIO0naByok0YX*-FRy|s|! zJ#DMHSZ8;4X3*S{bBj8J3l1>_wHs@wxssp|Z^F!6t_X0bC77cq%cW|Af{L#QSBlO$ z{P!)C?{nA`Oq)ue`W=j>609+p-TIs6>2;S=43mhNKl@$-0`!;f)$PA-s(mJ(`#!e* z_76|BujYH+N7A6aGqU!0xCe}7irU)pWI if`6-FMRxP=D^fFZ|J!5#r?0bL$e(?ud$s++tN#bHd2=cN delta 8648 zcmbtZdvsLQxzCvpk&uzWB$5EaW-ywRCd_%vE7dk9Gm~VJNhZup5EYb=LPUf!+c6C%LE=6OCQmy%_HII`Gbfrgj{j`5zLs>QJ?c2DfyLUC~ z#!Pi>kqFBiSyff#WS#9BvC_9p$rt1m(F5gYJ-|ZQ%@ns!mVK-`6bvUSYcFF1>v~vz zb)Z3SsSm{~6H)%jwDaZa)>vq1INBDk4C;vxb1HIWOW!s0$SRY))hcq-Q;Q@ewI?t>MfxQlZs?!Z*_VUABF8A#!aV`KQ<^CiG)7DEsdcpREV>*l znAzDgmMZOBJ9htQW70lcn6!7m!^Gf_K7h4`$ zmI%dK^hjMa)~qL(&+TG7nw*#PsVZv@wX`uGdIciY^`S%^^J+d;7i~!dVj+4zk6&ZU zwU`Y`<{-Dv&5ZG}P<=Ss!rUHyEK)S6scd;`yeb~h zBO&XKD$~-{Wo3(*TUO4z@4{5(ea-7*c$3yxm}y>_;o2fI&ErZpx>c)DOW(#j8XZ-C zhui9@`g~TaPhpYDfF2Jq6~jZZSTx2|)lZA+@pv?Vibj?AWzDtGNM&7HOCUk7r1-Eg zwb8Z&Q@n1gqLy5MQOT#Terns{^)qILwC8* zQ^q4;p4PSm_qQx6KrNoY<~K8+m-n}nIy@R{jm8u4KrGx!*5ePh%$cFNSS*^*#iRHX zAOCvAyaJ!>XL`Je`DB$1Etx9K)qL2!V5m-SizJxWpIOcr?)AwmqPGNLmevsS^3Bo0 zm0s1$8bW$7+)__QW?scNsZOR!KNXIG&b%&<)dywZZqj{^+b=*8XC9T`azmjc^CdSI z4!W?9lX|-S1eEOA-LQ^@8Rg8$HNxqnAsU%za+^zL;bt8NI(#`cCXh&wy}jOyEv{9S#zOg-BSEyChSjTXi1wMVJaxAIuU|(RoTziU0I^5FvG;^8MDGD z6SFFQ&%~^Xrdh^U6oudOf3rNY-+Km@WUt3W43qJQ0);YQV&X=2dxjimOT}ffTTZuW zX;{gsLPJ`}xV6z`{0=<7&jk~^U^LC+X3jGFg?c;VT^l#`JDH|=LD!vKSEHz)xVU>= z`|7R@-Pd z!)1|^sVkfBZ)!mATbmkQf4QbnjKF~5&vm|LRl^{>fiR1TLlI~Q2*U6fO$w~HyzcT) zEZRyg$1)%20obYq6V-*6wK5oym6hqSn0{Ghw5|?B!ektJtBLwC8JH8R;Am$J_AOAd zdwSG#-JFac`l=*sVHnF9)JwC`@)h=S#gF3}iRuYFrC(t&;u>(3%IbolrEql~6I$pB z^X}^SWU9pZ-8~KQk(zLZ-`YAFHvQA^Vt6pB8h&e-ksF(9Rny&W3pW|=thwj?6~o(e z%4O9@ta_oW;@FGVl@-}4VS9}>zuCm?$sgu}k!!=_pyvGi zkL&+rlf9|O2Hwd%+ujn6&~ETe*PH@|*Iaw?xmXg;M8?rF{;*ZQyLP1wXF_%J*4K(s zRoCAq87Jh;8(dQ`>VF1b!te0StMOZMi;CaKExqOTa=hpSn-Jk*;~6%>$(r#GT;rtk zl=|Y92d9+U%Y{9&7}T)SeYaKTV#-5z{0+Zv{^Cab2JfV$cHUWs-|;)Q;djej7aEVW z=dO!v(qH-UU)D&wc-cLRejwD!9S|a-aC6P7oV?tTfT+}rr>biVIWwM;NBPJ1%(+OY>uQVxT=POn($U#7of=NAvQdo4vE_<(d~Y1W}4#av)Q9%M`5d>=%Nfyv} zzH^JLz|SXISCE13qjs5K#H+Bv5vaY_XyOT+xY(JmDXTfDU z+11^>ofy@Z+_bS<2yadG5Fo2ucJR4^9xnXTAWr}wxI#a_g3lf#Tn!|+OnPi&t8MRvE6@$zoKXN5YjH6kXkZT8awB^fEM`4BtaEK|V;9u^e4pKC0tXdhfe6 z7re&D_7w5M_sujQe&W6#+oUr7qwS^AdVYBOY~Hth#-h){dASdU1ytb{4%Y|>3or}B zjyC4y{<@}7H1HkU8>QR$XG0rifGjd_s%-hPl>g_;teaDc6bn4;|g?yzH!p{)dTIwi@$^`-ay-K>4z`@Q>q>{kua?b!EP-t+5)4k*3Mz4!2$@0CajpE+Eb z3k78ufX=gs9)KNF{>#udR-@t}H#6A)=xXdcOl2BCwG7}T16)D|aAS`$3;-ENheU-T zvdn;kZfv`04lIdnpNDM+NGET*(MNV;=Suj$ZJYl+J5NXB`*z-kT|YW98@uj&_%Ee1 zX6EGN)d(Mbz%}!TJ%i*MC@GxI*ZND^!%Y8f<

WdLA1U4@$w(r%iRzQ!h{+oG78{S zQBbk}hIJvk;t<3!a5V_Uz&KP7|KsE8AS~@h{E%U34czXuP8oRvC+pZWa1B_K7}}sz z4Qhd`u3+5Vog4+#Rd^L~B@z`k5Oj$vwg;r@T!1$x(#N?4Er=sV41H~P zr=Uv3O2En9ur(JfQcNMc;d{$5NR$pso2ghdD5T8 z(dH+gmKIK8%}+CtlJo8vNclF_yqL>Rxo7&az@oqh9eGFj7m3q6r3$34VcAKzbaFtGsPTC_=R!9skX4g(CVYaQ$9FDjqz#jS(G@HrlV32%Oops7Ud01kyU0-( zPKH!6?V~K%5Lc7^5P$N+JBv$&_eTdiGd&EFGN?ksezWs>Nm|XXdv2a&aMH+g#fu67 zp9dSwcb4+bKv#r#C}Qx?_;cVPUi$nY2UK$g4Ixei|3Dog%kfkRSC7oLc{ITue!7_3 zVq|fUwByp3B{ukDFbN+YUJME$Rbvna;(r5H$W@rkVNnQjh!%z5BmZ(bJ3u&5%P15;l_=0Tcjhk|V;w zrWrcg`EySc+7ve!!in??*g=KkCjQBG`E)GsA7u&*)5>I0iyrvhBduvv{(WQ>+{zWH zYC}#vm@1S|fA+UQylRD=vV?(XBpMUay*lX2FAp1K=3ZM%U`&sY<=GXFOFtn$<%`_S8UwF03yijZw!uedHTmz-1Jn9HoN7kw~as zk5uWgdZf7s^P@34uT17&is;G^+YCZ!GW@Z_R$>J_l^ugYWm>NQ%ZhEYc8P%e=?lkb zH(q`5Kg8~E`Rqde%u5^5#CE%kro`@*8T-e_cOQX9mHC3*MZD^zBL4NuZyFoB`<3Yw zC(1s)Z%ZNnWY1A!_?}k>G5q4!t}?0*zjk}ZN_yR&C$DIrkl@Q<-=z?}$_4-4SearrUF|2<7RTyR&ouAmx29ZGnl9=uy zDTAU{6p`tIVi!fExj+q~h`bnBK@^eOq}Y{)K@?LOf{F?iWfWxub||_;E7ETa8BR3P zVzd@@sp7t&EnE{c39S??1+ir;=~pY6RE()LVDr(Q*Fwy;W(v!^qpBMV)9F zII!-l3MTbT$>Cogs8}k%G+Y$yJ$-s?d$4oe>9L_v(YEUByxfOsf}$+qf#Iuz0%(r~ zGs4=Jl8)WM1|zJkGs4=M;K(I>#ldR6}Ubm03sVuWBUW84zD^9+mZ~S*w&_~ zbdMx$BgKa4xK@VFFk(hCuB9ADIYX1D8vAF=4nPt@AaWdVYh8XyExIv$X z)bUIeq&JaDK~hA(O_d3exe6pSe5K9n5iV2zvb0H|B!`t%L1x4>q=i0w<(WVq<(jjy zDzJMReh}#rg5>`_;-;jE`1D3e6-$e&Ubg`@@|Y%AC>3eATg1FZ0l|b(fQc;l5rvrW zqXfB;T%owzDngs2i()w8&&YI}DHLHTk#1Qe@-0GyTL~5w3G>O|BL(jgs8a=|CW8*5 z9w*g69YP=hCyar}C;U*N_)OH{LtC~Q5ZRBk8W71CU{SbvQUeH>fH;cAX}Yw>#)nl+ zpb#Mjp%6Cy78D-%(%KkfX~_-D_PD|-A`mC^RWvAfcv_`bgv^P4`OBR$Kve!jf8=c7I0tQ7u% zoL3{f;EQ>SuN;l^e7L;nWNKE+{ml`|zBflG`);u8ah-Cu@M1=i7yv%<)p>>Bu&ms; z>{9v9zUV4JJec9SNvk453#Yy1&k^ZS-u&mwZ9O0H;o~Lzo#SQGdOp1B+^FMZYCeDT z#2kLk@yeOUYLXRV*<`zZ^08ggPkH3{1=5v#{qdiC=fJauKPudHdImrL#6Rit&9(f% z39k(S9VIh82upCqhd|@gY%6^^@F37dV}XYbBYlQ+d)#>6;z2ihWxcQ)XE5utfg4O} zHJD!mG_Y8_trj{5ABC8PGmTFc0emdhknoQN5_-hC1zs1+Y48@Jpu!tlv*9}#Kl;_Q zwRAkPo`Ft;)k%E1paWnvn9rbscPE}f1xC$hP$3&KpFzb@6iX}cU*M+mKn2z}Vv$P~ zUuA`QpQl)TiKoRNlDkGh^%wv_emU#Q3jp$uuWmdCq7V;B-wEk64S)EqQc~|8akkq# zI=Xs|Z(klW|L7449H&pj)I<*&O z4^+ilkv9&8ZkI%$Et=-og-C9`TWF~f9T2?QYDI!lm4MMW=I#I`0Ppd zkkcV8mhy*|IHW>ecFM^cPA$Zpo>NtP>!~V~-ah5#d#j6WET3=lm8JaSh4Crmv4%bk UNppw#>!kNY^~J_|>E4U}AEUuC{r~^~ diff --git a/library/POSTSCRIPTSTREAM.TEDIT b/library/POSTSCRIPTSTREAM.TEDIT index c135019b3..1b1cd053c 100644 --- a/library/POSTSCRIPTSTREAM.TEDIT +++ b/library/POSTSCRIPTSTREAM.TEDIT @@ -1,11 +1,86 @@ -envos POSTSCRIPTSTREAM 2 4 1 POSTSCRIPTSTREAM 1 4 By: Matt Heffron (mheffron@orion.cf.uci.edu) INTRODUCTION The PostScript package defines a set of imageops for printers which understand the PostScript page description language by Adobe. At Beckman we have successfully used TEdit, Sketch, LISTFILES, and HARDCOPYW to an Apple LaserWriter and an AST TurboLaser PS. The PostScript imagestream driver installs itself when it is loaded. All symbols in the PostScript driver are located in the INTERLISP: package. VARIABLES POSTSCRIPT.FONT.ALIST [InitVariable] POSTSCRIPT.FONT.ALIST is an ALIST mapping Xerox Lisp font names into the root names of PostScript font files. It is also used for font family coercions. The default value should be acceptable for any of the fonts which are built into the Apple Laserwriter. POSTSCRIPTFONTDIRECTORIES [InitVariable] POSTSCRIPTFONTDIRECTORIES is the list of directories where the PostScript .PSCFONT font files can be found. The default value is: ("{DSK}/usr/local/lde/fonts/postscript/") on a Sun or IBM workstation and ("{DSK}FONTS>PSC>") for other cases . POSTSCRIPT.DEFAULT.PAGEREGION [InitVariable] POSTSCRIPT.DEFAULT.PAGEREGION indicates the area of the page to use for text file listings (i.e. LISTFILES). It is in units of 100'ths of points. The default value is: (4800 4800 52800 70800), which gives left and bottom margins of 0.75 inch and top and right margins of 0.5 inch on 8.5 x 11 paper. POSTSCRIPT.PAGEREGIONS [InitVariable] POSTSCRIPT.PAGEREGIONS is an ALIST mapping pagetypes into paper size and actual imageable area on the page. By default, it knows about LETTER, LEGAL, and NOTE pagetypes, and the corresponding sizes and imageable areas for the Apple Laserwriter. Others can be defined by the user by adding the appropriate entries onto this ALIST. POSTSCRIPT.PAGETYPE [InitVariable] POSTSCRIPT.PAGETYPE is used by OPENIMAGESTREAM to lookup the paper size and actual imageable area of the page in POSTSCRIPT.PAGEREGIONS to determine the initial margins. This value can be overridden with the PAGETYPE or PAPERTYPE options in the OPENIMAGESTREAM call. The name of the type of page selected is NOT passed through to the PostScript output. \POSTSCRIPT.MAX.WILD.FONTSIZE [InitVariable] \POSTSCRIPT.MAX.WILD.FONTSIZE indicates the maximum point size that should be returned from FONTSAVAILABLE when the SIZE argument is wild (i.e. *). All integer pointsizes from 1 to \POSTSCRIPT.MAX.WILD.FONTSIZE will be indicated as available. The default value is: 72. POSTSCRIPT.PREFER.LANDSCAPE [InitVariable] POSTSCRIPT.PREFER.LANDSCAPE indicates if the OPENIMAGESTREAM method should default the orientation of output files to LANDSCAPE. It can have one of three values: NIL, T, or ASK. NIL means prefer portrait orientation output, T means prefer landscape, and ASK says to bring up a menu to ask the preferred orientation if it wasn't explicitly indicated in the OPENIMAGESTREAM call (with the ROTATION option). The default value is: NIL. An item (PS Orientation) is added to the Background Menu to let you change the value of this variable. POSTSCRIPT.TEXTFILE.LANDSCAPE [InitVariable] POSTSCRIPT.TEXTFILE.LANDSCAPE indicates if the printing of TEXT files (e.g. LISTFILES, ...) should force the orientation of output files to LANDSCAPE. When it is non-NIL the orientation of output files is forced to LANDSCAPE. (There is no ASK option here.) The default value is: NIL. POSTSCRIPT.BITMAP.SCALE [InitVariable] POSTSCRIPT.BITMAP.SCALE specifies an independent scale factor for display of bitmap images (e.g. window hardcopies). Values less than 1 will reduce the image size. (I.e. a value of 0.5 will give a half size bitmap image.) The position of the scaled bitmap will still have the SAME lower-left corner (i.e. the scaled bitmap is not centered in the region of the full size bitmap image). The default value is: 1. HINT Setting POSTSCRIPT.BITMAP.SCALE to 0.96, instead of 1, will give cleaner BITMAP images on a 300 dpi printer. (This corrects for the 72 ppi imagestream vs. the 75 dpi printer, using 4x4 device dots per bitmap pixel.) Also, values of 0.24, 0.48 and 0.72, instead of 0.25, 0.5 and 0.75, will also give cleaner images for reduced size output. In general, use integer multiples of 0.24 for a 300 dpi printer. POSTSCRIPT.TEXTURE.SCALE [InitVariable] POSTSCRIPT.TEXTURE.SCALE specifies an independent scale for the display of bitmap textures. The value represents the number of device space units per texture unit (bitmap bit). The default value is 4, which represents each bit of the texture as a 4x4 block, so that textures are approximately the same resolution as on the screen (for 300 dpi output devices, such as the Apple Laserwriter). The PostScript package extends the allowed representations of a texture, beyond 16-bit FIXP and 16x16 bitmap, to ANY square bitmap. (If the bitmap is not square, its longer edge is truncated from the top or right to make it square.) Use this feature with caution, as large bitmap textures, or sizes other than multiples of 16 bits square, require large amounts of storage in the PostScript interpreter (in the printer controller), and can cause limitcheck errors when actually printing. Anywhere that a texture or color can be used on an imagestream or in the specification of a BRUSH, you can instead give a FLOATP between 0.0 and 1.0 (inclusive) to represent a PostScript halftone gray shade. (0.0 is black and 1.0 is white. Specifically, the value sets the brightness of the shade.) The value you specify will not be range checked, and will be passed directly through to the PostScript setgray operator. (E.g. you can pass 0.33 as the color to DRAWLINE to get a dark gray line with approximately 67% of the pixels in the line black.) POSTSCRIPT.IMAGESIZEFACTOR [InitVariable] POSTSCRIPT.IMAGESIZEFACTOR specifies an independent factor to change the overall size of the printed image. This re-sizing affects the entire printed output (specifically, it superimposes its effects upon those of POSTSCRIPT.BITMAP.SCALE and POSTSCRIPT.TEXTURE.SCALE). Values greater than 1 enlarge the printed image, and values less than 1 reduce it. An invalid POSTSCRIPT.IMAGESIZEFACTOR (i.e. not a positive, non-zero number) will use a value of 1. The BITMAPSCALE function for the POSTSCRIPT printer type does NOT consider the POSTSCRIPT.IMAGESIZEFACTOR when determining the scale factor for a bitmap. MISCELLANEOUS The SCALE of a PostScript imagestream is 100. This is to allow enough resolution in the width information for fonts to enable TEdit to correctly fill and justify text. The first time any PostScript imagestream is created (even if only to hardcopy a bitmap or window) the DEFAULTFONT is instantiated (unless a FONTS option was given to the OPENIMAGESTREAM, in which case the initial font for the imagestream will be set to that font, or to the CAR if a list). The PostScript imagestream method for FILLPOLYGON uses the global variable FILL.WRULE as the default value for the WINDINGNUMBER argument. (This is the same variable which is used by the DISPLAY imagestream method for FILLPOLYGON.) The PostScript imagestream method for OPENIMAGESTREAM (and, therefore, SEND.FILE.TO.PRINTER), supports an IMAGESIZEFACTOR option to change the size of the printed image. The IMAGESIZEFACTOR re-sizing is combined with the POSTSCRIPT.IMAGESIZEFACTOR to produce an overall re-sizing of the printed image. A HEADING option is also supported to give a running header on each page of output. The value of the HEADING option is printed at the top left of the page, followed by "Page " and the appropriate page number. They are printed in the DEFAULTFONT (unless a FONTS option was given to the OPENIMAGESTREAM, in which case it will be that font, or to the CAR if a list). The PostScript package is contained in the files: POSTSCRIPTSTREAM.LCOM & PS-SEND.LCOM, with the source in the files: POSTSCRIPTSTREAM & PS-SEND. The module PS-SEND.LCOM is required and will be loaded automatically when POSTSCRIPTSTREAM.LCOM is loaded. It contains the function which is called by SEND.FILE.TO.PRINTER to actually transmit the file to the printer. It is, by its nature, quite site specific, so it is in a separate file to make modifying it for any site relatively simple. System record declarations required to compile POSTSCRIPTSTREAM can be found in EXPORTS.ALL. I'm pretty sure that the output generated by the PostScript imageops fully conforms to the Adobe Systems Document Structuring Conventions, Version 2.0, January 31, 1987. Including Other PostScript Operations If you wish to insert your own specific PostScript operations into a PostScript imagestream, you can do so with the following functions: (POSTSCRIPT.OUTSTR STREAM STRING) [Function] POSTSCRIPT.OUTSTR outputs a string or value to the imagestream. STREAM must be an open PostScript imagestream. STRING is the value to output (STRINGP and LITATOM are most efficient, but any value can be output (its PRIN1 pname is used)). (POSTSCRIPT.PUTCOMMAND STREAM STRING1 ... STRINGn) [NoSpread Function] POSTSCRIPT.PUTCOMMAND is more general for sequences of commands and values. It calls POSTSCRIPT.OUTSTR repeatedly to output each of the STRINGi arguments to STREAM. (\POSTSCRIPT.OUTCHARFN STREAM CHAR) [Function] \POSTSCRIPT.OUTCHARFN is used to output the characters forming the text of a PostScript string (e.g. the argument to a show or charpath operator). STREAM is the open PostScript imagestream to output to, and CHAR is the CHARCODE of the character to output. The / (slash), ( and ) (parenthesis) characters will be quoted with /, and characters with ASCII values less than 32 (space) or greater than 126 (tilde) will be output as /nnn (in octal). \POSTSCRIPT.OUTCHARFN will output the ( character to open the string, if necessary. Use POSTSCRIPT.CLOSESTRING (below) to close the string. (POSTSCRIPT.CLOSESTRING STREAM) [Function] POSTSCRIPT.CLOSESTRING closes a PostScript string (e.g. the argument to a show or charpath operator). STREAM is the open PostScript imagestream. It is important to use POSTSCRIPT.CLOSESTRING to output the ) character to close the string, because it also clears the stream state flag that indicates that a string is in progress (otherwise, the next POSTSCRIPT.PUTCOMMAND would output the commands to close the string and show it). Warning Do not attempt to create a PostScript font larger than about 600 points, as much of Interlisp's font information is stored in SMALLP integers, and too large a font would overflow the font's height, or the width for any of the wider characters. (I know that 600 points is a ridiculously large limit (about 8.3 inches), but I thought I'd better mention it, or someone might try it!) Changes from the Initial Medley Release This second Medley release of the PostScript imagestream driver includes some performance enhancements when writing bitmaps to the output, some SUN-specific code (from Will Snow of envos), implementation of the SCALEDBITBLT, DSPROTATE, and DSPTRANSLATE operations, and a lot of performance enhancements (many thanks to Tom Lipkis of Savoir). Changes from the Lyric Release The Medley release of this PostScript imagestream driver changed the default value of POSTSCRIPT.TEXTFILE.LANDSCAPE from T to NIL. It also added the support for the HEADING option. Known Problems/Limitations The output generated for a PostScript imagestream is rather brute force. It isn't particularly careful to generate the smallest output file for a given sequence of operations. Specifically, it often generates extra end-of-lines between PostScript operator sequences (this has no effect on the printed output, only on the file size). Using BITMAPs or Functions as BRUSH arguments to the curve drawing functions is not supported, nor is using a non-ROUND BRUSH with DRAWCIRCLE or DRAWELLIPSE. The implementation of DSPROTATE accepts ROTATION argument values of 0 and 90 (any non-NIL, non-zero value is converted to 90). A value of 0 converts the page orientation to Portrait, and 90 converts the page orientation to Landscape. These conversions perform the translations necessary to keep the clipping region on the page. (This may or may not be the right thing to do, but since DSPROTATE is undocumented in what it should do, this is what the PostScript driver does). There is no support for NS character sets other than 0, and there is no translation of the character code values from NS encoding to PostScript encoding. There is no support for color. \POSTSCRIPT.OUTCHARFN is pretty wimpy in its handling of TAB characters. It just moves to the next multiple of (eight times the average character width of the current font) from the current left margin. I haven't yet documented how to build the .PSCFONT files from .AFM files for new fonts that become available.(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (162 48 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (162 48 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))))) 5 ,66,5 , ,,8,8H PAGEHEADING RUNNINGHEAD CLASSICCLASSICMODERN - HELVETICA +envos POSTSCRIPTSTREAM +2 + +4 + +1 + +POSTSCRIPTSTREAM +1 + +4 + +By: Matt Heffron (then: mheffron@orion.cf.uci.edu, now: heffron@alumni.caltech.edu) +INTRODUCTION +The PostScript package defines a set of imageops for printers which understand the PostScript page description language by Adobe. At Beckman we have successfully used TEdit, Sketch, LISTFILES, and HARDCOPYW to an Apple LaserWriter and an AST TurboLaser PS. The PostScript imagestream driver installs itself when it is loaded. All symbols in the PostScript driver are located in the INTERLISP: package. +VARIABLES +POSTSCRIPT.FONT.ALIST [InitVariable] +POSTSCRIPT.FONT.ALIST is an ALIST mapping Xerox Lisp font names into the root names of PostScript font files. It is also used for font family coercions. The default value should be acceptable for any of the fonts which are built into the Apple Laserwriter. +POSTSCRIPTFONTDIRECTORIES [InitVariable] +POSTSCRIPTFONTDIRECTORIES is the list of directories where the PostScript .PSCFONT font files can be found. The default value is: ("{DSK}/usr/local/lde/fonts/postscript/") on a Sun or IBM workstation and ("{DSK}FONTS>PSC>") for other cases . +POSTSCRIPT.DEFAULT.PAGEREGION [InitVariable] +POSTSCRIPT.DEFAULT.PAGEREGION indicates the area of the page to use for text file listings (i.e. LISTFILES). It is in units of 100'ths of points. The default value is: (4800 4800 52800 70800), which gives left and bottom margins of 0.75 inch and top and right margins of 0.5 inch on 8.5 x 11 paper. +POSTSCRIPT.PAGEREGIONS [InitVariable] +POSTSCRIPT.PAGEREGIONS is an ALIST mapping pagetypes into paper size and actual imageable area on the page. By default, it knows about LETTER, LEGAL, and NOTE pagetypes, and the corresponding sizes and imageable areas for the Apple Laserwriter. Others can be defined by the user by adding the appropriate entries onto this ALIST. +POSTSCRIPT.PAGETYPE [InitVariable] +POSTSCRIPT.PAGETYPE is used by OPENIMAGESTREAM to lookup the paper size and actual imageable area of the page in POSTSCRIPT.PAGEREGIONS to determine the initial margins. This value can be overridden with the PAGETYPE or PAPERTYPE options in the OPENIMAGESTREAM call. The name of the type of page selected is NOT passed through to the PostScript output. +\POSTSCRIPT.MAX.WILD.FONTSIZE [InitVariable] +\POSTSCRIPT.MAX.WILD.FONTSIZE indicates the maximum point size that should be returned from FONTSAVAILABLE when the SIZE argument is wild (i.e. *). All integer pointsizes from 1 to \POSTSCRIPT.MAX.WILD.FONTSIZE will be indicated as available. The default value is: 72. +POSTSCRIPT.PREFER.LANDSCAPE [InitVariable] +POSTSCRIPT.PREFER.LANDSCAPE indicates if the OPENIMAGESTREAM method should default the orientation of output files to LANDSCAPE. It can have one of three values: NIL, T, or ASK. NIL means prefer portrait orientation output, T means prefer landscape, and ASK says to bring up a menu to ask the preferred orientation if it wasn't explicitly indicated in the OPENIMAGESTREAM call (with the ROTATION option). The default value is: NIL. An item (PS Orientation) is added to the Background Menu to let you change the value of this variable. +POSTSCRIPT.TEXTFILE.LANDSCAPE [InitVariable] +POSTSCRIPT.TEXTFILE.LANDSCAPE indicates if the printing of TEXT files (e.g. LISTFILES, ...) should force the orientation of output files to LANDSCAPE. When it is non-NIL the orientation of output files is forced to LANDSCAPE. (There is no ASK option here.) The default value is: NIL. +POSTSCRIPT.BITMAP.SCALE [InitVariable] +POSTSCRIPT.BITMAP.SCALE specifies an independent scale factor for display of bitmap images (e.g. window hardcopies). Values less than 1 will reduce the image size. (I.e. a value of 0.5 will give a half size bitmap image.) The position of the scaled bitmap will still have the SAME lower-left corner (i.e. the scaled bitmap is not centered in the region of the full size bitmap image). The default value is: 1. +HINT +Setting POSTSCRIPT.BITMAP.SCALE to 0.96, instead of 1, will give cleaner BITMAP images on a 300 dpi printer. (This corrects for the 72 ppi imagestream vs. the 75 dpi printer, using 4x4 device dots per bitmap pixel.) Also, values of 0.24, 0.48 and 0.72, instead of 0.25, 0.5 and 0.75, will also give cleaner images for reduced size output. In general, use integer multiples of 0.24 for a 300 dpi printer. +POSTSCRIPT.TEXTURE.SCALE [InitVariable] +POSTSCRIPT.TEXTURE.SCALE specifies an independent scale for the display of bitmap textures. The value represents the number of device space units per texture unit (bitmap bit). The default value is 4, which represents each bit of the texture as a 4x4 block, so that textures are approximately the same resolution as on the screen (for 300 dpi output devices, such as the Apple Laserwriter). +The PostScript package extends the allowed representations of a texture, beyond 16-bit FIXP and 16x16 bitmap, to ANY square bitmap. (If the bitmap is not square, its longer edge is truncated from the top or right to make it square.) Use this feature with caution, as large bitmap textures, or sizes other than multiples of 16 bits square, require large amounts of storage in the PostScript interpreter (in the printer controller), and can cause limitcheck errors when actually printing. +Anywhere that a texture or color can be used on an imagestream or in the specification of a BRUSH, you can instead give either: a COLOR name, an RGB triple, an HLS triple, or a FLOATP between 0.0 and 1.0 (inclusive) to represent a PostScript halftone gray shade. (For the name, RGB or HLS values, see the file COLOR.TEDIT in the library directory.) (For the single FLOATP value, it will be converted to the corresponding RGB form. 0.0 is black and 1.0 is white. Specifically, the value sets the brightness of the shade.) All forms of the value you specify will be checked for validity. E.g. you can pass 0.33 as the color to DRAWLINE to get a dark gray line. This will be converted to the RGB triple (84 84 84). +POSTSCRIPT.IMAGESIZEFACTOR [InitVariable] +POSTSCRIPT.IMAGESIZEFACTOR specifies an independent factor to change the overall size of the printed image. This re-sizing affects the entire printed output (specifically, it superimposes its effects upon those of POSTSCRIPT.BITMAP.SCALE and POSTSCRIPT.TEXTURE.SCALE). Values greater than 1 enlarge the printed image, and values less than 1 reduce it. An invalid POSTSCRIPT.IMAGESIZEFACTOR (i.e. not a positive, non-zero number) will use a value of 1. The BITMAPSCALE function for the POSTSCRIPT printer type does NOT consider the POSTSCRIPT.IMAGESIZEFACTOR when determining the scale factor for a bitmap. +MISCELLANEOUS +The SCALE of a PostScript imagestream is 100. This is to allow enough resolution in the width information for fonts to enable TEdit to correctly fill and justify text. +The first time any PostScript imagestream is created (even if only to hardcopy a bitmap or window) the DEFAULTFONT is instantiated (unless a FONTS option was given to the OPENIMAGESTREAM, in which case the initial font for the imagestream will be set to that font, or to the CAR if a list). +The PostScript imagestream method for FILLPOLYGON uses the global variable FILL.WRULE as the default value for the WINDINGNUMBER argument. (This is the same variable which is used by the DISPLAY imagestream method for FILLPOLYGON.) +The PostScript imagestream method for OPENIMAGESTREAM (and, therefore, SEND.FILE.TO.PRINTER), supports an IMAGESIZEFACTOR option to change the size of the printed image. The IMAGESIZEFACTOR re-sizing is combined with the POSTSCRIPT.IMAGESIZEFACTOR to produce an overall re-sizing of the printed image. A HEADING option is also supported to give a running header on each page of output. The value of the HEADING option is printed at the top left of the page, followed by "Page " and the appropriate page number. They are printed in the DEFAULTFONT (unless a FONTS option was given to the OPENIMAGESTREAM, in which case it will be that font, or to the CAR if a list). +The PostScript package is contained in the files: POSTSCRIPTSTREAM.LCOM & PS-SEND.LCOM, with the source in the files: POSTSCRIPTSTREAM & PS-SEND. The module PS-SEND.LCOM is required and will be loaded automatically when POSTSCRIPTSTREAM.LCOM is loaded. It contains the function which is called by SEND.FILE.TO.PRINTER to actually transmit the file to the printer. It is, by its nature, quite site specific, so it is in a separate file to make modifying it for any site relatively simple. System record declarations required to compile POSTSCRIPTSTREAM can be found in EXPORTS.ALL. +I'm pretty sure that the output generated by the PostScript imageops fully conforms to the Adobe Systems Document Structuring Conventions, Version 2.0, January 31, 1987. +Including Other PostScript Operations +If you wish to insert your own specific PostScript operations into a PostScript imagestream, you can do so with the following functions: +(POSTSCRIPT.OUTSTR STREAM STRING) [Function] +POSTSCRIPT.OUTSTR outputs a string or value to the imagestream. STREAM must be an open PostScript imagestream. STRING is the value to output (STRINGP and LITATOM are most efficient, but any value can be output (its PRIN1 pname is used)). +(POSTSCRIPT.PUTCOMMAND STREAM STRING1 ... STRINGn) [NoSpread Function] +POSTSCRIPT.PUTCOMMAND is more general for sequences of commands and values. It calls POSTSCRIPT.OUTSTR repeatedly to output each of the STRINGi arguments to STREAM. +(\POSTSCRIPT.OUTCHARFN STREAM CHAR) [Function] +\POSTSCRIPT.OUTCHARFN is used to output the characters forming the text of a PostScript string (e.g. the argument to a show or charpath operator). STREAM is the open PostScript imagestream to output to, and CHAR is the CHARCODE of the character to output. The / (slash), ( and ) (parenthesis) characters will be quoted with /, and characters with ASCII values less than 32 (space) or greater than 126 (tilde) will be output as /nnn (in octal). \POSTSCRIPT.OUTCHARFN will output the ( character to open the string, if necessary. Use POSTSCRIPT.CLOSESTRING (below) to close the string. +(POSTSCRIPT.CLOSESTRING STREAM) [Function] +POSTSCRIPT.CLOSESTRING closes a PostScript string (e.g. the argument to a show or charpath operator). STREAM is the open PostScript imagestream. It is important to use POSTSCRIPT.CLOSESTRING to output the ) character to close the string, because it also clears the stream state flag that indicates that a string is in progress (otherwise, the next POSTSCRIPT.PUTCOMMAND would output the commands to close the string and show it). +Warning +Do not attempt to create a PostScript font larger than about 600 points, as much of Interlisp's font information is stored in SMALLP integers, and too large a font would overflow the font's height, or the width for any of the wider characters. (I know that 600 points is a ridiculously large limit (about 8.3 inches), but I thought I'd better mention it, or someone might try it!) +Changes from the Initial Medley Release +This second Medley release of the PostScript imagestream driver includes some performance enhancements when writing bitmaps to the output, some SUN-specific code (from Will Snow of envos), implementation of the SCALEDBITBLT, DSPROTATE, and DSPTRANSLATE operations, and a lot of performance enhancements (many thanks to Tom Lipkis of Savoir). +Changes from the Lyric Release +The Medley release of this PostScript imagestream driver changed the default value of POSTSCRIPT.TEXTFILE.LANDSCAPE from T to NIL. It also added the support for the HEADING option. +Known Problems/Limitations +The output generated for a PostScript imagestream is rather brute force. It isn't particularly careful to generate the smallest output file for a given sequence of operations. Specifically, it often generates extra end-of-lines between PostScript operator sequences (this has no effect on the printed output, only on the file size). +Using BITMAPs or Functions as BRUSH arguments to the curve drawing functions is not supported, nor is using a non-ROUND BRUSH with DRAWCIRCLE or DRAWELLIPSE. +The implementation of DSPROTATE accepts ROTATION argument values of 0 and 90 (any non-NIL, non-zero value is converted to 90). A value of 0 converts the page orientation to Portrait, and 90 converts the page orientation to Landscape. These conversions perform the translations necessary to keep the clipping region on the page. (This may or may not be the right thing to do, but since DSPROTATE is undocumented in what it should do, this is what the PostScript driver does). +There is no support for NS character sets other than 0, and there is no translation of the character code values from NS encoding to PostScript encoding. +There is minimal support for color. +\POSTSCRIPT.OUTCHARFN is pretty wimpy in its handling of TAB characters. It just moves to the next multiple of (eight times the average character width of the current font) from the current left margin. +I haven't yet documented how to build the .PSCFONT files from .AFM files for new fonts that become available.(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (162 48 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (162 48 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (72 732 540 36) NIL) (TEXT NIL NIL (72 72 468 648) NIL))))))) +1$1 $7 $7 $166$1$1$18$18$J$ PAGEHEADING RUNNINGHEAD +MODERN +GACHA MODERN -MODERN -MODERN MODERN -MODERN    HRULE.GETFNMODERN - HRULE.GETFNMODERN - HRULE.GETFNMODERN - HRULE.GETFNMODERN  HRULE.GETFNMODERN .  --Lc*e#K&  A*y    62 --f4f gb~(VOm2Wz \ No newline at end of file +MODERN + HELVETICA +MODERN +MODERN MODERNCLASSICCLASSIC +  +  + HRULE.GETFN HRULE.GETFN HRULE.GETFN   HRULE.GETFN HRULE.GETFN  +-Lce#K&  A*y    62 +-f4f gb~(VO$mDATE:iֳ33(z \ No newline at end of file From 6c7dcad0596acc44d79859361d2e29148d41e824 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 28 Apr 2025 00:20:37 -0700 Subject: [PATCH 2/2] A *lot* better. I still haven't tested with BITMAPP or TEXTUREP textures. --- library/POSTSCRIPTSTREAM | 259 ++++++++++++++++++---------------- library/POSTSCRIPTSTREAM.LCOM | Bin 93914 -> 94435 bytes 2 files changed, 134 insertions(+), 125 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 079bce2fb..44bdaf819 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Apr-2025 17:44:28" {DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;7 255849 +(FILECREATED "28-Apr-2025 00:17:24" {DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;14 257549 :EDIT-BY "mth" - :CHANGES-TO (FNS POSTSCRIPT.OUTSTR \PSC.COLOR.TO.RGB \DSPCOLOR.PSC \BLTSHADE.PSC - POSTSCRIPT.PUTCOLOR POSTSCRIPT.PUTRGBCOLOR \DRAWARC.PSC \DRAWCIRCLE.PSC - \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC - \FILLCIRCLE.PSC \FILLPOLYGON.PSC \POSTSCRIPT.CHANGECHARSET + :CHANGES-TO (FNS \DRAWLINE.PSC POSTSCRIPT.PUTRGBCOLOR \PSC.COLOR.TO.RGB \BLTSHADE.PSC + \DRAWARC.PSC \DRAWCIRCLE.PSC \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWPOLYGON.PSC + \FILLCIRCLE.PSC \FILLPOLYGON.PSC POSTSCRIPT.COLORSTRING POSTSCRIPT.OUTSTR + \DSPCOLOR.PSC POSTSCRIPT.PUTCOLOR \DRAWPOINT.PSC \POSTSCRIPT.CHANGECHARSET POSTSCRIPT.HARDCOPYW POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK @@ -502,32 +502,47 @@ (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) (POSTSCRIPT.PUTRGBCOLOR - [LAMBDA (STREAM RGB EOL?) (* ; "Edited 26-Apr-2025 17:16 by mth") - (AND RGB (SETQ RGB (\PSC.COLOR.TO.RGB RGB)) - (POSTSCRIPT.PUTCOMMAND STREAM (CAR RGB) - " " - (CADR RGB) - " " - (CADDR RGB) - " setrgbcolor " - (AND EOL? :EOL]) + [LAMBDA (STREAM COLOR EOL?) (* ; "Edited 28-Apr-2025 00:02 by mth") + (* ; "Edited 26-Apr-2025 17:16 by mth") + (AND COLOR (CL:MULTIPLE-VALUE-BIND (RGB GRAY COLORSTR) + (\PSC.COLOR.TO.RGB COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLORSTR (OR (AND GRAY " setgray ") + " setrgbcolor ") + (AND EOL? :EOL]) (\PSC.COLOR.TO.RGB - [LAMBDA (COLOR NOERRORFLG?) (* ; "Edited 26-Apr-2025 17:06 by mth") - (COND - ((AND (FLOATP COLOR) - (<= 0.0 COLOR 1.0) - (SETQ COLOR (FIX (FTIMES COLOR 255))) - (LIST COLOR COLOR COLOR))) - ((ENSURE.RGB COLOR NOERRORFLG?)) - (T - (* ;; " Shouldn't ever get here.") + [LAMBDA (COLOR NOERRORFLG?) (* ; "Edited 28-Apr-2025 00:10 by mth") + (* ; "Edited 26-Apr-2025 17:06 by mth") + (LET (RGB STR) + (COND + [(AND (FLOATP COLOR) + (<= 0.0 COLOR 1.0) + (SETQ RGB (FIX (FTIMES COLOR 255))) + (SETQ RGB (LIST RGB RGB RGB)) + (SETQ STR (CL:FORMAT NIL "~F "] + [(SETQ RGB (ENSURE.RGB COLOR NOERRORFLG?)) + (SETQ STR (IF (AND (EQ (CAR RGB) + (CADR RGB)) + (EQ (CAR RGB) + (CADDR RGB))) + THEN + (* ;; "They're all equal, this is gray.") + + (CL:FORMAT NIL "~F " (SETQ COLOR (FQUOTIENT (CAR RGB) + 255.0))) + ELSE (SETQ COLOR NIL) (* ; "Means NOT gray") + (CL:FORMAT NIL "~D ~D ~D " (CAR RGB) + (CADR RGB) + (CADDR RGB] + (T + (* ;; " Shouldn't ever get here.") - (* ;; " ENSURE.RGB above handled the color name or number, RGB, and HLS cases.") + (* ;; " ENSURE.RGB above handled the color name or number, RGB, and HLS cases.") - (* ;; "Depending on NOERRORFLG?, it will give the error for anything else invalid") + (* ;; "Depending on NOERRORFLG?, it will give the error for anything else invalid") - NIL]) + NIL)) + (CL:VALUES RGB COLOR STR]) ) (ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY) @@ -2184,7 +2199,7 @@ (\BLTSHADE.PSC [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) - (* ; "Edited 26-Apr-2025 17:43 by mth") + (* ; "Edited 28-Apr-2025 00:05 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") @@ -2211,9 +2226,8 @@ 'BLACK) (WHITESHADE 'WHITE) TEXTURE] - (COND - ((OR (NULL TEXTURE) - (TEXTUREP TEXTURE)) + [COND + ((TEXTUREP TEXTURE) (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) (SETQ TEXTUREWIDTH 16) (BLTSHADE TEXTURE TEXTUREBM)) @@ -2222,14 +2236,15 @@ (fetch BITMAPHEIGHT of TEXTUREBM))) (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) - (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " - (CAR TEXTURE) - " " - (CADR TEXTURE) - " " - (CADDR TEXTURE) - " R" :EOL))) + (T (CL:MULTIPLE-VALUE-BIND (COLOR GRAY COLORSTR) + (\PSC.COLOR.TO.RGB (OR TEXTURE (\DSPCOLOR.PSC STREAM NIL))) + + (* ;; "Default to the current stream color") + + (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " + COLORSTR (OR (AND GRAY "RG") + "R") + :EOL] (COND (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) @@ -2293,6 +2308,7 @@ (\DRAWARC.PSC [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) + (* ; "Edited 27-Apr-2025 23:49 by mth") (* ; "Edited 26-Apr-2025 17:16 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") @@ -2318,9 +2334,7 @@ (COND ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") @@ -2336,7 +2350,8 @@ (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:16 by mth") + [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) (* ; "Edited 27-Apr-2025 23:50 by mth") + (* ; "Edited 26-Apr-2025 17:16 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) @@ -2361,9 +2376,7 @@ (COND ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") @@ -2378,7 +2391,8 @@ (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWCURVE.PSC - [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:17 by mth") + [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 27-Apr-2025 23:50 by mth") + (* ; "Edited 26-Apr-2025 17:17 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) @@ -2402,9 +2416,7 @@ (COND ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") @@ -2451,6 +2463,7 @@ (\DRAWELLIPSE.PSC [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) + (* ; "Edited 27-Apr-2025 23:51 by mth") (* ; "Edited 26-Apr-2025 17:18 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") @@ -2476,9 +2489,7 @@ (COND ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") @@ -2495,7 +2506,7 @@ (\MOVETO.PSC STREAM CENTERX CENTERY]) (\DRAWLINE.PSC - [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) (* ; "Edited 26-Apr-2025 17:30 by mth") + [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) (* ; "Edited 28-Apr-2025 00:11 by mth") (* ;  "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") @@ -2510,29 +2521,28 @@ (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] [COND ((NOT (ZEROP WIDTH)) - (COND - ((LESSP X2 X1) - - (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") - - (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) - ((NOT (OR (FLOATP COLOR) - (LISTP DASHING))) (* ; "Simple case, no dash or color") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR)) - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " (CAR COLOR) - " " - (CADR COLOR) - " " - (CADDR COLOR) - " [") - (for D in (LISTP DASHING) do - (* ;; + (CL:MULTIPLE-VALUE-BIND (RGB GRAY COLORSTR) + (\PSC.COLOR.TO.RGB COLOR T) + (COND + ((LESSP X2 X1) + + (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") + + (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) + ((NOT (OR COLOR (LISTP DASHING))) (* ; "Simple case, no dash or color") + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) + (T (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " ") + (POSTSCRIPT.PUTCOMMAND STREAM COLORSTR " [") + (POSTSCRIPT.PUTCOMMAND STREAM) + (for D in (LISTP DASHING) do + (* ;;  "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") - (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "]" (OR (AND GRAY " L1G") + " L1") + :EOL] (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) @@ -2551,7 +2561,8 @@ else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) (\DRAWPOLYGON.PSC - [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 26-Apr-2025 17:32 by mth") + [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 27-Apr-2025 23:51 by mth") + (* ; "Edited 26-Apr-2025 17:32 by mth") (* ;  "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") (LET ((LASTPOINT (CAR (LAST POINTS))) @@ -2576,9 +2587,7 @@ (COND ((NOT (ZEROP WIDTH)) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((SETQ COLOR (\PSC.COLOR.TO.RGB COLOR T)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T) (COND ((LISTP DASHING) (POSTSCRIPT.OUTSTR STREAM " [") @@ -2951,7 +2960,7 @@ YPOSITION))))]) (\FILLCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 26-Apr-2025 17:40 by mth") + [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 27-Apr-2025 23:58 by mth") (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") (LET (TEXTUREBM TEXTUREWIDTH) (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") @@ -2962,8 +2971,7 @@ (EQL TEXTURE -1)) then (SETQ TEXTURE 'BLACK] (COND - ((OR (NULL TEXTURE) - (TEXTUREP TEXTURE)) + ((TEXTUREP TEXTURE) (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) (SETQ TEXTUREWIDTH 16) (BLTSHADE TEXTURE TEXTUREBM)) @@ -2972,15 +2980,14 @@ (fetch BITMAPHEIGHT of TEXTUREBM))) (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (TEXTURE (POSTSCRIPT.PUTRGBCOLOR STREAM TEXTURE T))) (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) (if TEXTUREBM then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch BITMAPRASTERWIDTH - of TEXTUREBM) - 1) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LLSH (fetch BITMAPRASTERWIDTH + of TEXTUREBM) + 1) " 0 " (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) 100.0)) @@ -2990,7 +2997,7 @@ (\MOVETO.PSC STREAM CENTERX CENTERY]) (\FILLPOLYGON.PSC - [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) (* ; "Edited 26-Apr-2025 17:40 by mth") + [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) (* ; "Edited 27-Apr-2025 23:59 by mth") (* ;  "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") (DECLARE (SPECVARS FILL.WRULE)) @@ -3010,8 +3017,7 @@ (EQL TEXTURE -1)) then (SETQ TEXTURE 'BLACK] (COND - ((OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) + ((TEXTUREP TEXTURE) (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) (SETQ TEXTUREWIDTH 16) (BLTSHADE TEXTURE TEXTUREBM)) @@ -3020,8 +3026,7 @@ (fetch BITMAPHEIGHT of TEXTUREBM))) (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - ((SETQ TEXTURE (\PSC.COLOR.TO.RGB TEXTURE)) - (POSTSCRIPT.PUTRGBCOLOR STREAM COLOR T))) + (TEXTURE (POSTSCRIPT.PUTRGBCOLOR STREAM TEXTURE T))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) " " (fetch (POSITION YCOORD) of (CAR KNOTS)) @@ -4128,10 +4133,14 @@ " M lineto currentpoint stroke grestore M} bdef" "/L1 {gsave newpath 0 setdash setrgbcolor setlinewidth 0 setlinecap" " M lineto currentpoint stroke grestore M} bdef" + "/L1G {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" + " M lineto currentpoint stroke grestore M} bdef" "/F {findfont exch scalefont setfont} bdef" "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" " neg 0 rlineto closepath clip newpath} bdef" "/R {gsave setrgbcolor newpath M dup 0 rlineto exch 0 exch" + " rlineto neg 0 rlineto closepath eofill grestore} bdef" + "/RG {gsave setgray newpath M dup 0 rlineto exch 0 exch" " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" " /startangle exch def" " /orientation exch def" " /minorrad exch def" @@ -4385,38 +4394,38 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (23896 32009 (POSTSCRIPT.INIT 23906 . 30998) (POSTSCRIPT.PUTRGBCOLOR 31000 . 31401) ( -\PSC.COLOR.TO.RGB 31403 . 32007)) (32995 67779 (PSCFONT.READFONT 33005 . 34913) (PSCFONT.SPELLFILE -34915 . 35493) (PSCFONT.COERCEFILE 35495 . 37067) (PSCFONTFROMCACHE.SPELLFILE 37069 . 38054) ( -PSCFONTFROMCACHE.COERCEFILE 38056 . 39708) (PSCFONT.WRITEFONT 39710 . 40725) (READ-AFM-FILE 40727 . -46598) (CONVERT-AFM-FILES 46600 . 47812) (POSTSCRIPT.GETFONTID 47814 . 49209) (POSTSCRIPT.FONTCREATE -49211 . 61610) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 61612 . 64009) (POSTSCRIPT.FONTSAVAILABLE 64011 - . 67777)) (68334 77619 (OPENPOSTSCRIPTSTREAM 68344 . 77285) (CLOSEPOSTSCRIPTSTREAM 77287 . 77617)) ( -77664 83714 (POSTSCRIPT.HARDCOPYW 77674 . 80781) (POSTSCRIPT.TEDIT 80783 . 81263) (POSTSCRIPT.TEXT -81265 . 81556) (POSTSCRIPTFILEP 81558 . 82665) (MAKEEPSFILE 82667 . 83712)) (83715 127289 ( -POSTSCRIPT.BITMAPSCALE 83725 . 86181) (POSTSCRIPT.CLOSESTRING 86183 . 86736) (POSTSCRIPT.ENDPAGE 86738 - . 87629) (POSTSCRIPT.OUTSTR 87631 . 88848) (POSTSCRIPT.PUTBITMAPBYTES 88850 . 97321) ( -POSTSCRIPT.PUTCOMMAND 97323 . 98312) (POSTSCRIPT.SET-FAKE-LANDSCAPE 98314 . 102834) ( -POSTSCRIPT.SHOWACCUM 102836 . 104991) (POSTSCRIPT.STARTPAGE 104993 . 107525) (\POSTSCRIPTTAB 107527 . -108324) (\PS.BOUTFIXP 108326 . 109606) (\PS.SCALEHACK 109608 . 112251) (\PS.SCALEREGION 112253 . -112813) (\SCALEDBITBLT.PSC 112815 . 117125) (\SETPOS.PSC 117127 . 117608) (\SETXFORM.PSC 117610 . -120194) (\STRINGWIDTH.PSC 120196 . 120669) (\SWITCHFONTS.PSC 120671 . 126163) (\TERPRI.PSC 126165 . -127287)) (127324 180617 (\BITBLT.PSC 127334 . 127887) (\BLTSHADE.PSC 127889 . 132280) (\CHARWIDTH.PSC -132282 . 132789) (\CREATECHARSET.PSC 132791 . 134489) (\DRAWARC.PSC 134491 . 136847) (\DRAWCIRCLE.PSC -136849 . 139078) (\DRAWCURVE.PSC 139080 . 142902) (\DRAWELLIPSE.PSC 142904 . 145246) (\DRAWLINE.PSC -145248 . 147500) (\DRAWPOINT.PSC 147502 . 148078) (\DRAWPOLYGON.PSC 148080 . 151187) ( -\DSPBOTTOMMARGIN.PSC 151189 . 151876) (\DSPCLIPPINGREGION.PSC 151878 . 153253) (\DSPCOLOR.PSC 153255 - . 154095) (\DSPFONT.PSC 154097 . 157616) (\DSPLEFTMARGIN.PSC 157618 . 158304) (\DSPLINEFEED.PSC -158306 . 158896) (\DSPPUSHSTATE.PSC 158898 . 160358) (\DSPPOPSTATE.PSC 160360 . 163845) (\DSPRESET.PSC - 163847 . 164512) (\DSPRIGHTMARGIN.PSC 164514 . 165203) (\DSPROTATE.PSC 165205 . 166204) ( -\DSPSCALE.PSC 166206 . 167158) (\DSPSCALE2.PSC 167160 . 168000) (\DSPSPACEFACTOR.PSC 168002 . 168923) -(\DSPTOPMARGIN.PSC 168925 . 169496) (\DSPTRANSLATE.PSC 169498 . 171529) (\DSPXPOSITION.PSC 171531 . -172095) (\DSPYPOSITION.PSC 172097 . 172688) (\FILLCIRCLE.PSC 172690 . 174999) (\FILLPOLYGON.PSC 175001 - . 178325) (\FIXLINELENGTH.PSC 178327 . 179646) (\MOVETO.PSC 179648 . 180418) (\NEWPAGE.PSC 180420 . -180615)) (180673 202696 (\POSTSCRIPT.CHANGECHARSET 180683 . 181420) (\POSTSCRIPT.OUTCHARFN 181422 . -193550) (\POSTSCRIPT.PRINTSLUG 193552 . 195276) (\POSTSCRIPT.SPECIALOUTCHARFN 195278 . 197629) ( -\UPDATE.PSC 197631 . 198877) (\POSTSCRIPT.ACCENTFN 198879 . 199821) (\POSTSCRIPT.ACCENTPAIR 199823 . -202694)) (202794 204439 (\PSC.SPACEDISP 202804 . 203083) (\PSC.SPACEWID 203085 . 203704) (\PSC.SYMBOLS - 203706 . 204437)) (204548 207539 (\POSTSCRIPT.NSHASH 204558 . 207537)) (252022 252736 (POSTSCRIPTSEND - 252032 . 252734))))) + (FILEMAP (NIL (23920 33221 (POSTSCRIPT.INIT 23930 . 31022) (POSTSCRIPT.PUTRGBCOLOR 31024 . 31600) ( +\PSC.COLOR.TO.RGB 31602 . 33219)) (34207 68991 (PSCFONT.READFONT 34217 . 36125) (PSCFONT.SPELLFILE +36127 . 36705) (PSCFONT.COERCEFILE 36707 . 38279) (PSCFONTFROMCACHE.SPELLFILE 38281 . 39266) ( +PSCFONTFROMCACHE.COERCEFILE 39268 . 40920) (PSCFONT.WRITEFONT 40922 . 41937) (READ-AFM-FILE 41939 . +47810) (CONVERT-AFM-FILES 47812 . 49024) (POSTSCRIPT.GETFONTID 49026 . 50421) (POSTSCRIPT.FONTCREATE +50423 . 62822) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62824 . 65221) (POSTSCRIPT.FONTSAVAILABLE 65223 + . 68989)) (69546 78831 (OPENPOSTSCRIPTSTREAM 69556 . 78497) (CLOSEPOSTSCRIPTSTREAM 78499 . 78829)) ( +78876 84926 (POSTSCRIPT.HARDCOPYW 78886 . 81993) (POSTSCRIPT.TEDIT 81995 . 82475) (POSTSCRIPT.TEXT +82477 . 82768) (POSTSCRIPTFILEP 82770 . 83877) (MAKEEPSFILE 83879 . 84924)) (84927 128501 ( +POSTSCRIPT.BITMAPSCALE 84937 . 87393) (POSTSCRIPT.CLOSESTRING 87395 . 87948) (POSTSCRIPT.ENDPAGE 87950 + . 88841) (POSTSCRIPT.OUTSTR 88843 . 90060) (POSTSCRIPT.PUTBITMAPBYTES 90062 . 98533) ( +POSTSCRIPT.PUTCOMMAND 98535 . 99524) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99526 . 104046) ( +POSTSCRIPT.SHOWACCUM 104048 . 106203) (POSTSCRIPT.STARTPAGE 106205 . 108737) (\POSTSCRIPTTAB 108739 . +109536) (\PS.BOUTFIXP 109538 . 110818) (\PS.SCALEHACK 110820 . 113463) (\PS.SCALEREGION 113465 . +114025) (\SCALEDBITBLT.PSC 114027 . 118337) (\SETPOS.PSC 118339 . 118820) (\SETXFORM.PSC 118822 . +121406) (\STRINGWIDTH.PSC 121408 . 121881) (\SWITCHFONTS.PSC 121883 . 127375) (\TERPRI.PSC 127377 . +128499)) (128536 182026 (\BITBLT.PSC 128546 . 129099) (\BLTSHADE.PSC 129101 . 133566) (\CHARWIDTH.PSC +133568 . 134075) (\CREATECHARSET.PSC 134077 . 135775) (\DRAWARC.PSC 135777 . 138155) (\DRAWCIRCLE.PSC +138157 . 140408) (\DRAWCURVE.PSC 140410 . 144254) (\DRAWELLIPSE.PSC 144256 . 146620) (\DRAWLINE.PSC +146622 . 149058) (\DRAWPOINT.PSC 149060 . 149636) (\DRAWPOLYGON.PSC 149638 . 152767) ( +\DSPBOTTOMMARGIN.PSC 152769 . 153456) (\DSPCLIPPINGREGION.PSC 153458 . 154833) (\DSPCOLOR.PSC 154835 + . 155675) (\DSPFONT.PSC 155677 . 159196) (\DSPLEFTMARGIN.PSC 159198 . 159884) (\DSPLINEFEED.PSC +159886 . 160476) (\DSPPUSHSTATE.PSC 160478 . 161938) (\DSPPOPSTATE.PSC 161940 . 165425) (\DSPRESET.PSC + 165427 . 166092) (\DSPRIGHTMARGIN.PSC 166094 . 166783) (\DSPROTATE.PSC 166785 . 167784) ( +\DSPSCALE.PSC 167786 . 168738) (\DSPSCALE2.PSC 168740 . 169580) (\DSPSPACEFACTOR.PSC 169582 . 170503) +(\DSPTOPMARGIN.PSC 170505 . 171076) (\DSPTRANSLATE.PSC 171078 . 173109) (\DSPXPOSITION.PSC 173111 . +173675) (\DSPYPOSITION.PSC 173677 . 174268) (\FILLCIRCLE.PSC 174270 . 176495) (\FILLPOLYGON.PSC 176497 + . 179734) (\FIXLINELENGTH.PSC 179736 . 181055) (\MOVETO.PSC 181057 . 181827) (\NEWPAGE.PSC 181829 . +182024)) (182082 204105 (\POSTSCRIPT.CHANGECHARSET 182092 . 182829) (\POSTSCRIPT.OUTCHARFN 182831 . +194959) (\POSTSCRIPT.PRINTSLUG 194961 . 196685) (\POSTSCRIPT.SPECIALOUTCHARFN 196687 . 199038) ( +\UPDATE.PSC 199040 . 200286) (\POSTSCRIPT.ACCENTFN 200288 . 201230) (\POSTSCRIPT.ACCENTPAIR 201232 . +204103)) (204203 205848 (\PSC.SPACEDISP 204213 . 204492) (\PSC.SPACEWID 204494 . 205113) (\PSC.SYMBOLS + 205115 . 205846)) (205957 208948 (\POSTSCRIPT.NSHASH 205967 . 208946)) (253722 254436 (POSTSCRIPTSEND + 253732 . 254434))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index 8747828a0df6adc4d1082ce017d9665c5ac7e5bb..be23d163e707f8b0d4d74ad985bcee1106993c94 100644 GIT binary patch delta 5087 zcmb_gZE#f88Q!y-kY**4g%CDNgu|*3kdJ%L{n)#pWjEO+S@N;#CMZ%I8b~CONN@>u ztkz6t{GraMgwqcAMOFL)9Sgf!1=`6tTBls#HH?aJnR`|_Edc0oRyH)m_AH>Z5^Wi%*0 zuWksc59G3$o<7lCwOG6|Yrbgy+ibCctPtPaae;``ED|^FX%yWx^Tqq5S&Y|EeCH=M zE5sH4x#Gi`g}C~T9vAwpkQ<8pW2{MscX>D$LZA2Ju1dQbB@C!oeuhR;31a z$bcA>nQNJ~R=3oaOZ$RX&mPZFgL*5bIjYn4eDWF?oF+9}*I+T4Z*Rq@Ne_?H4Cd0= zuJtgO^C&EhV#n!Z_j2l6SMBo!k^{w9tq*_HPbgW{K~8q~w~*5t{p9C~uFfBi%E{YD z8|BdYT+L27&Xzy*z82FG{l~+#I^EiRRad6BPkej9f)ysCYw_9T!4_)hG)ngljum!p z-!VEeTELYab6h(M{Wpu-7A&ln>&BAQy5;)CeG8h$@AmtA{tzXJf$BifnpA5@d|A3I zF`&#ZOVN>k{pI@KZZ0-;3=9lKB9YAx4XK%+T-i0H&O}mKn+J+X(%~oPo{M&1ltzcR)M1Z-U|Jz5x97-OcJM#RjJNj6m4%TQpv5+RH!WW=eMeb4&=e_g%!^F8ayS#jyT zSFBLUE=ES`2X?9LpBkw@o!F>CHhIGLeBx!f^yCHA%@yV5`qqvFJlh~MCHlIY@*r<(#gkBf;X!xtiCF7hZhEb+sM zhMWP{v^wV8rmdZ=nLdyL<(f`mb|-UfD1yE;;)q$7Ehqyxr_XXrygSi0-_$IHX==nh z!?q5RVY0B(Fx^L}fecIFQ=RLM!8xb-bgnDemZqG=Xr?E(3CM|gU!ly3drvdd783`u zYfKF=*jX6dJ2qMvjN*g1q&Msvk!7@}e{5{9u$vB!UN<~4f=Qc+IihhqX5yafhIbF( zvC)xzW5c7n;V>*4DAiVLL28%=9GZ0Mar|NgI;5vCGQ4|mY?SU88QnXG_YYwTF^ZNa zP_glt^B!386;lt%E8W&Nc+;_15T0)7jWN$@$;H8A#yyXT_hVu5lJ4EnKQbt%4JIav z^HwsOM)SA?l%x4}7#a-x<#9{CTN?7K7;U4(e)NT(TqM>#(L{#D+fPKq=o543`%W1O}^cou?G?AU<7`-|zMla5c(MJz-lKqHLtJw8mbS~JfvQE)`W%c=)CfVO_ z$K?<;?Q%#^mTsJYwsM?o*<>psmAc676xgxTGEknT8!8m|T~Dov8`x4staQ0Ujq1qB zw1}boIgxQA$7~fLc+ZQFGtUfDynT3qxb?6_n0WYTOX+uq*N~=~kk410m?gRDH7#_u zu5CcCFD(l^e}fyh+La1Rr!v={J8*)Wtc)RfdS(o7dANm?N{>DK0}=vpR|e43#JM|~ z{8mhSen(jHQySD{fFR_k$4zIn4QJHR#ibuFQKM$b=+CvC$9T-SjUf#$J=#E=oR}&n zqJC^X0&YoY`s4Cz3&hSND=s(Uwi9LpFHz7mEH?u>YEpSPh_Uy|P02i{OV?>WyQwDy z>N3R}N33xpjuM{Ai(%u^gRg<^7o|J)6>b8rfK3dSa0~~<241G4xfz=4#|P!L9&^yE z18g#vx(+f?6WqChBQ78pS^0}3cfqh+Eg?DVd&2``L&}MaKDNYfnxdt+xH>4oB|3|X zmtyfV@StcBm4nbn>37hSxg;U6{_%g1h3C=AdzI<-y*e}99<5w1*pp_xHZ9>`7I4Y` z%q(tkKsUHKI*(cK)rzce!0gOZk?8+{POdyEbvfwdb|g0isb;!T(@`NDp0Ws;u0fPa zVWQ>Ob^awaV*jz|W#`i1=d{Pqe{8>ScuG}-lGPdVi;RCOIo;(ar^HLg!qv~TUs%$` zC&x5$lW2Z=aZ8;;9`X zQVmrdLk%rM5O~0otSo2@w1EKE(2$>Ol8Fm2+g4O(#AOXF0urYkJSe!&(;=oVUaFqA zO3IK8ThjS#4mw!Y=+>!&M=IHu1bDfVL}ut>>oZHo(JrF2iviYB2*N`5Q?1}yjNk}~ zcn0~QfXdLil*6qWg>89*B0n91dbqOZWm!FD|H8yB*x{XZ=Sh@kZt1T zXBQEN@QTmQrx$EQvNn3j`er8T&piv06HPyTb1wLzlH*XnGFAayQ&NqnZW`duiNSBH zg9EWd=pFPCu39M5!BY`1V_1B7oUeoMbJdjB9BdEvrpHkXrx}N%7;@rr6hzT?PuN+x z&nb%1rTi|pSY4BwuFyQ(meFvu5W*dk3P^_Eqa1AJ1~%KyqNllxa%SQl=$MQ<)GNuEYmL!PJ!(Z58=b zrYt!};DcXbsxu$rlB01sZ^)0SZy_x?8l!WhQ+`W*%Fs&_uk=*UT29IKDxdi4YpE8M z<6^jcB6xA6{$#2{mFDq$$~g}tQpFB&?U}XJccu;{QsS{QE6I>Jd*%}IiCFn|M1)?? z)+t#=ox<0_UF(oFJi#11r>!AP3f}H`t(eR2PjX0Er@PrPDc>V)9FcO~5Ak8R6^T@NvYkPmxw4&2X>~;2 zeFz#>T>QqRoj_|P+HkUomSwuquv1Xv^2GPwBt5q|B>ntx9#eXEhN$N_F(^?lPmg$w zM46ON3a(h;3}MZ1(5%o*l0zJDGg}f4u5IQhYk(}eb8r7mgLL&iH_5=i1^K$ zL!>AYZ#B-&x4JlJ1rGY(0uEXaC0fPNxBk8e^y2azHBfn#On`Hd!vrx~jv*Zlsf+_D z^ws%J*BsV`jFH;XlH?oq>k=GIV)2p4s<=^sit@S1JI3M2RfYv)Tzq`CuK`7&l5KdJ zMz@@-Z_=?uFYAz54kSE6mSn3uVEri^K;pPKK$UsPho_s65 z;d8VV_$NwBC*J*{Fe?~cgC=xv%?5H&mHgkDgCC|z^9y@6kaeU1bNP09ivt&&K;--j K8{5hLW&Z}7KN_b1 delta 5061 zcmcgvZERcB8TPf4ez<9xv`OQ96i!W7l5I`zIrm)KH-ptq>?CfTICUIgp-iN)+h%p^ zl7u40rmQ~@(xj~)hlvzgx{i)*rJa(v1p%56W1E-?g%*CGLA4KlAhBPA0b?K9o^$TC z>yT)ZrfG`e^WO7u&$;h;-sgSZcYj~`n`@Ov?pPDp6ge=yiRsKFG}ys;2eXdu?bm{{ z&wrz0k-?DI?!9$ska(GChQ#5@n<4|r!SrBPDn5{IPY$IA(IX>cy>h zH;D5etwGPBk+s6}@uc|C(poY7ag%6w*P!>^rJF?UGE3ax`9yd>Z9&hziZ6<%KW&3` z`ki|5Rz-uT)#}8bmv2N*lXrc+pX!^U*-`nyoKUla20Dzu(Fe8^4tsB_x-(7~i6s+T zNSsh24<08v!6(HceQm@QaJgKbNM?>LhvC}kzR(tqXnAQz+{M;0Ixj5UEeBRElfN~t zR#VhI>e~`p=$kfgD>q38c7;WZAn}ul?Bw|Foum0&ejHCMgda3I@r!pFny2K^`jfF# zDw*m|^vI*?MEMpcsj2DW z@^HlKoR3>1);~Cuipl$G^Y+IRI1OWjw(EpaqPOd9Uffo9vS2hmH0+@vUijHWu379n z{H90yV1=-bY|)+;_aC|S3y*}Ad*&K*HJQCDH>M3~I^NZRq0kG2ak_zZasFF^hC=>x`#?Q}~?| zn0=9fF2Eoi188(o1Tdinrp_B>A#u0ps^>vVT`J*$qG4L1`f^i((~z@-7$IkjSpj=C zV+KjZ1`?637-5(g?;jXSBQQ%#Xb`)r4RH_v|Ka3n9^}NodptWanIF&ku^|^z4>wPl z=p~u4gX(`YJC+;UzZ*TAOFZow+n>RTeD2=KvHX73O$pU;&0fNp1R>x?IA!?t&F zR??7D(3+;*a;xz4_dakpZ>(^+mW7u{X#HBRUGMJB7&XVfGSlX{I4=HlqOI+>@k-C} zxWe_ZS=W`Yf})Bl1@ITPjwy5xPm8MKecFR!`1p7&j#Ca!-~xzqGbV|^!*pFl&ig_D zM>>`oNFk^LjG*nuH2`46P6Yo#ex;O(Z$0j-r#iL(&gXHhpg)PN!=*?@!3P%&>KK&k z;_XK_cLm{z>zJ_}GcrC(CML)8dx0Wm%F9E`B^YGuxXy4~$1E{&YI6&?!G9N^0nW;d zOaKtnvL{e8aO^~#IQLjUW8$x;TE&VJmzvkY&r8bu94-0zfb#Qe^ZfkczwvX&$!*$0 z@N=hl`J{h!(46nhHJ}%Ljc6$OI{07sy1PYpT#Z|^eGYIc zgBl^}YDY+{_`~UMYO9eY z%Ta7nLsG0e2nRpmlk^z_M{)$IYQdGVH7vt!0UGs;x2Tp%7WUn2*~?hSo<=R8Jd%p^ z#nP#G*Wf@R-Vd4$sml|Gt~NGOgD!eCrVN7ys^j)Q8wSJ@hh}}^@R`rwV(LNrLOAwS zH^V_v$}sdI0h>WGxP2&+0_}1}QputID2~9zM`r?4rVc{6euLb?V=+#6KwjtQz2gT# zj9^UDCNOT=;llAU1H>jtU*0aqhVt16*->Huxw7Bj0k1uP+@mJIm0(8%p5>Rs2}3b0 z;!Kk8ePbD$^zbD>lQ>ma=LYZp@rQo5sf$%l`WNCxu`%M41qz8L*J{lh{sZS-D~F5g zwFPil$a%MjfghW-);z$lkS?zr9Pt03Jty*5plHmeJw1VFx_*(&lp$w_Vm6l>J1~*` zpYop=KHKk*-<7j>c_@jB(WiE~tK8z!Q~vh1W5_A7VorHA()Hoo+HhAi(i!XSsqU#+ zsYYg9g`Vn4&qY(1=k%%vda70L&g!{)M8~-sH}_QATB)bn(MT{HYbE#qLaC?5Gt-dK zYBen!kBRS|T<_~uX|Aiz-5af|=-pG-x(D)QXLyWxVBT!D! zROEIUthV|>GU^_VrIG^>vPd5y|8o5@n+R!8ynlY<6m%K5EJ1-~sb=vCovClD+lp)0>Rf}iWC6?*HY@I!7WdDzESsCuz3Rn8YD>G+SgE-0w z5`ioQCWL0lZsAIqiUOvcitHxHOH&LY{JiIGRadHAwLoDVsR*Na_q>`S~zVn#9Z z;G31hC9rLSS|wTop*XZ=>EeyK(3H&N*Mq@80f^GWN&g0w{w>pa3{urkZ2gD(QxXfU z5}A^vxN<*XO2Ex0DKC1ZB2ywkzF~Ca03O8o!YVflh{p=+-IRf|ZoCnBGXT)9lBV2CZbdD3d)OFg(sW=|Ky;@v*{i7Cm!=YWmL9pdO z;o`-?MvoCvOti{?drLSmn9#4Tb4xV`a=WBxYV{P6_z)xYh0cMsUFc1j~A)^?zoMKhZD^V=!1G$!|dO%VvD_nZ>