From 28dc362c86d50044736ba7167f48003acabd8523 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 13 Oct 2025 13:47:12 -0700 Subject: [PATCH 1/3] Update KEYBOARDCONFIGS Get F6/F10 to show/transmit characters --- library/virtualkeyboards/KEYBOARDCONFIGS | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/library/virtualkeyboards/KEYBOARDCONFIGS b/library/virtualkeyboards/KEYBOARDCONFIGS index aae4e82f..e572a178 100644 --- a/library/virtualkeyboards/KEYBOARDCONFIGS +++ b/library/virtualkeyboards/KEYBOARDCONFIGS @@ -1,17 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Jul-2023 13:18:46" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;3 59739 +(FILECREATED "13-Oct-2025 13:44:47" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;5 59521 :EDIT-BY rmk - :CHANGES-TO (VARS KEYBOARDCONFIGSCOMS) + :PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;4) - :PREVIOUS-DATE " 7-Feb-97 12:13:28" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;1) - - -(* ; " -Copyright (c) 1996-1997 by Xerox Corporation. -") (PRETTYCOMPRINT KEYBOARDCONFIGSCOMS) @@ -63,11 +57,11 @@ Copyright (c) 1996-1997 by Xerox Corporation. (F3 (F3 ITALIC)) (F4 (F4 UCASE)) (F5 (F5 STRIKE)) - (F6 (F6 UNDER)) + (F6 (F6 "­")) (F7 (F7 SUBSCR)) (F8 (F8 SMALL)) (F9 (F9 MARGIN)) - (F10 (F10 LOOKS)) + (F10 (F10 "¬")) (F11 (F11 "")) (F12 (F12 "")) (LOCK ("CAPS" "LOCK")) @@ -280,11 +274,11 @@ Copyright (c) 1996-1997 by Xerox Corporation. (F3 (ITALIC NOTITALIC NLS)) (F4 (UCASE LCASE NLS)) (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) - (F6 (UNDERLINE NOTUNDERLINE NLS)) + (F6 ("­" "­" NLS)) (F7 (SUBSCRIPT SUPERSCRIPT NLS)) (F8 (SMALLER LARGER NLS)) (F9 (MARGINS NOTMARGINS NLS)) - (F10 (LOOKS NOTLOOKS NLS)) + (F10 ("¬" "¬" NLS)) (F11 (F11 NOTF11 NLS)) (F12 (F12 NOTF12 NLS))) ((%` 45 B) @@ -1270,11 +1264,11 @@ Copyright (c) 1996-1997 by Xerox Corporation. (F3 (ITALIC NOTITALIC NLS)) (F4 (UCASE LCASE NLS)) (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) - (F6 (UNDERLINE NOTUNDERLINE NLS)) + (F6 ("­" "­" NLS)) (F7 (SUBSCRIPT SUPERSCRIPT NLS)) (F8 (SMALLER LARGER NLS)) (F9 (MARGINS NOTMARGINS NLS)) - (F10 (LOOKS NOTLOOKS NLS)) + (F10 ("¬" "¬" NLS)) (F11 (F11 NOTF11 NLS)) (F12 (F12 NOTF12 NLS))) ((%' 28 B) @@ -1803,7 +1797,6 @@ Copyright (c) 1996-1997 by Xerox Corporation. 23130 (CLASSIC 10) NIL)) -(PUTPROPS KEYBOARDCONFIGS COPYRIGHT ("Xerox Corporation" 1996 1997)) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP From fda911ebb829936f9d1a6cc6dce01c633b26543f Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 13 Oct 2025 17:43:41 -0700 Subject: [PATCH 2/3] Fix \FONTFACE glitch --- library/POSTSCRIPTSTREAM | 466 +++++++++++++++++----------------- library/POSTSCRIPTSTREAM.LCOM | Bin 93204 -> 93174 bytes 2 files changed, 239 insertions(+), 227 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 925b8b1a..204736af 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "10-Sep-2025 14:51:53" {WMEDLEY}POSTSCRIPTSTREAM.;42 258973 +(FILECREATED "13-Oct-2025 17:39:50" {WMEDLEY}POSTSCRIPTSTREAM.;54 260212 :EDIT-BY rmk - :CHANGES-TO (FNS POSTSCRIPTFILEP POSTSCRIPT.INIT) + :CHANGES-TO (FNS POSTSCRIPT.FONTCREATE) - :PREVIOUS-DATE " 8-Sep-2025 09:51:34" {WMEDLEY}POSTSCRIPTSTREAM.;39) + :PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}POSTSCRIPTSTREAM.;53) (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) @@ -179,7 +179,7 @@ (TITAN . COURIER)) [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT] + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE] (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) @@ -889,203 +889,206 @@ FONTID]) (POSTSCRIPT.FONTCREATE - [LAMBDA (FONTSPEC) (* ; "Edited 7-Sep-2025 23:44 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 13-Oct-2025 17:39 by rmk") + (* ; "Edited 7-Sep-2025 23:44 by rmk") (* ; "Edited 30-Aug-2025 23:24 by rmk") (* ; "Edited 21-Aug-2025 18:21 by rmk") (* ; "Edited 15-Jun-2025 23:40 by rmk") (* ; "Edited 29-Oct-93 16:39 by rmk:") (* ; "Edited 3-Feb-93 17:22 by jds") - (LET* (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD - FACECHANGED FAMILY SIZE FACE ROTATION DEVICE (WEIGHT (CAR FACE)) - (SLOPE (CADR FACE)) - (EXPANSION (CADDR FACE))) - (SPREADFONTSPEC FONTSPEC) + (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD + FACECHANGED FAMILY SIZE FACE ROTATION DEVICE WEIGHT SLOPE EXPANSION) + (SPREADFONTSPEC FONTSPEC) + (SETQ WEIGHT (CAR FACE)) + (SETQ SLOPE (CADR FACE)) + (SETQ EXPANSION (CADDR FACE)) - (* ;; + (* ;;  "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") - [COND - [(EQ SIZE 1) + [COND + [(EQ SIZE 1) - (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") + (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") - (COND - ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + (COND + ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - (* ;; "Check in-core cache for exact match first") + (* ;; "Check in-core cache for exact match first") - (SETQ FACECHANGED NIL)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + (SETQ FACECHANGED NIL)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - (* ;; "Check file for exact match next") + (* ;; "Check file for exact match next") - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED NIL)) - ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION - ROTATION DEVICE)) + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED NIL)) + ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION + DEVICE)) - (* ;; "Then check cache for coerced match") + (* ;; "Then check cache for coerced match") - (SETQ FACECHANGED T)) - ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION - DEVICE)) + (SETQ FACECHANGED T)) + ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION + DEVICE)) - (* ;; "Check file for coerced match") + (* ;; "Check file for coerced match") - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED T))) - (COND - (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED T))) + (COND + (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) 0.1))) - (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (COND - (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD - with (POSTSCRIPT.GETFONTID (fetch (PSCFONT FID) - of PSCFD) - WEIGHT SLOPE EXPANSION] - ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) - (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) - 'PSCFONT)) + (COND + (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD + with (POSTSCRIPT.GETFONTID (fetch (PSCFONT FID) + of PSCFD) + WEIGHT SLOPE EXPANSION] + ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) + (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) + 'PSCFONT)) - (* ;; "Scale the ASCENT and DESCENT") + (* ;; "Scale the ASCENT and DESCENT") - (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) + (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) 0.1))) - (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (SETQ SCALEFONTP T)) - (T - (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") + (SETQ SCALEFONTP T)) + (T + (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") - (COND - ([SETQ PSCFD (COND - ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION - DEVICE)) - (PSCFONT.READFONT FULLNAME] - (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) - (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) - (SETQ SCALEFONTP NIL] - (COND - (PSCFD - (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") + (COND + ([SETQ PSCFD (COND + ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE + )) + (PSCFONT.READFONT FULLNAME] + (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) + (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) + (SETQ SCALEFONTP NIL] + (COND + (PSCFD + (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") - (SETQ FD - (create FONTDESCRIPTOR - OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) - FONTSCALE _ 100 - FONTDEVICE _ DEVICE - FONTFAMILY _ FAMILY - FONTSIZE _ SIZE - FONTFACE _ FACE - ROTATION _ 0 - \SFHeight _ (IPLUS ASCENT DESCENT) - \SFAscent _ ASCENT - \SFDescent _ DESCENT - FONTTOMCCSFN _ (MCCSMAPFN FONTSPEC))) - (FONTPROP FD 'CHARENCODING) - (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\INSURECHARSETINFO FD 0))) - (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) - [COND - [SCALEFONTP (for CH from 0 to 255 - do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE - (ELT FIXPWIDTHS CH) - 0.1] - (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH (ELT FIXPWIDTHS CH] - (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) + (SETQ FD + (create FONTDESCRIPTOR + OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) + FONTSCALE _ 100 + FONTDEVICE _ DEVICE + FONTFAMILY _ FAMILY + FONTSIZE _ SIZE + FONTFACE _ FACE + ROTATION _ 0 + \SFHeight _ (IPLUS ASCENT DESCENT) + \SFAscent _ ASCENT + \SFDescent _ DESCENT + FONTTOMCCSFN _ (MCCSMAPFN FONTSPEC))) + (FONTPROP FD 'CHARENCODING) + (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\INSURECHARSETINFO FD 0))) + (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) + [COND + [SCALEFONTP (for CH from 0 to 255 + do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE (ELT FIXPWIDTHS + CH) + 0.1] + (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH (ELT FIXPWIDTHS CH] + (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) - (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") + (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") - (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH - ))) - [LET [(TMP (COND - (FULLNAME (FONTSPECFROMFILENAME FULLNAME DEVICE)) - (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] + (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH) + )) + [LET [(TMP (COND + (FULLNAME (FONTSPECFROMFILENAME FULLNAME DEVICE)) + (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] - (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") + (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") - (COND - ((AND TMP (NEQ FAMILY (CAR TMP))) - (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) - SIZE - (COPY FACE) - 0 DEVICE] - [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE - )) - (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION - DEVICE))) + (COND + ((AND TMP (NEQ FAMILY (CAR TMP))) + (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) + SIZE + (COPY FACE) + 0 DEVICE] + [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE) + ) + (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION + DEVICE))) - (* ;; + (* ;;  "Now run thru the mapping table, filling in the new font from whatever source is specified:") - [MAPHASH *POSTSCRIPT-NS-HASH* - (FUNCTION (LAMBDA (MAPPING CODE) - (DESTRUCTURING-BIND - (KIND CODE2 BASECHAR) - MAPPING + [MAPHASH *POSTSCRIPT-NS-HASH* + (FUNCTION (LAMBDA (MAPPING CODE) + (DESTRUCTURING-BIND + (KIND CODE2 BASECHAR) + MAPPING - (* ;; - "Depending on what kind of item it is, process it:") + (* ;; "Depending on what kind of item it is, process it:") - (SELECTQ KIND - (NIL - (* ;; + (SELECTQ KIND + (NIL + (* ;;  "Translating an NS character to a PSC char in CS 0.") - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - (\CHAR8CODE CODE2)))) - (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH - FD CODE (ELT SYMWIDTHS - (\CHAR8CODE - CODE2]) - (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH - FD CODE - (ELT DINGWIDTHS - (\CHAR8CODE CODE2]) - (FUNCTION - (* ;; + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + (\CHAR8CODE + CODE2)))) + (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH + FD CODE (ELT SYMWIDTHS + (\CHAR8CODE + CODE2]) + (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH + FD CODE (ELT DINGWIDTHS + (\CHAR8CODE + CODE2]) + (FUNCTION + (* ;;  "This is fake and only works for the fractions. Need a better case.") - [\FSETCHARWIDTH - FD CODE - (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) - (FIXR (FTIMES 1.3 - (\FGETWIDTH - PSCWIDTHSBLOCK - (CHARCODE 1]) - (ACCENT (* ; + [\FSETCHARWIDTH + FD CODE + (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) + (FIXR (FTIMES 1.3 + (\FGETWIDTH + PSCWIDTHSBLOCK + (CHARCODE 1]) + (ACCENT (* ;  "CODE2 is the rendering character but width comes from width of basechar") - (\FSETCHARWIDTH FD CODE (\FGETWIDTH + (\FSETCHARWIDTH FD CODE (\FGETWIDTH PSCWIDTHSBLOCK - BASECHAR))) - (ACCENTPAIR + BASECHAR))) + (ACCENTPAIR (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent") - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - CODE2))) - (PROGN + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + CODE2))) + (PROGN (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else") - NIL] + NIL] - (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") + (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") - (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) - (CL:WHEN (EQ (CAR MAPPING) - 'APPLY*) - (\FSETCHARWIDTH - FD CODE (APPLY* (CADDDR - MAPPING) - FD - (CADR MAPPING) - )))] - FD) - (T NIL]) + (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) + (CL:WHEN (EQ (CAR MAPPING) + 'APPLY*) + (\FSETCHARWIDTH + FD CODE (APPLY* (CADDDR + MAPPING + ) + FD + (CADR MAPPING)) + ))] + FD) + (T NIL]) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS [LAMBDA (TYPE FD ROTATION DEVICE) (* ; "Edited 5-Oct-93 18:21 by rmk:") @@ -1183,16 +1186,22 @@ (DEFINEQ (OPENPOSTSCRIPTSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") + [LAMBDA (FILE OPTIONS) (* ; "Edited 19-Sep-2025 16:02 by rmk") + (* ; "Edited 14-Sep-2025 12:50 by rmk") + (* ; "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.") - (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) - 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) - (SEQUENTIAL T] + (LET [[STREAM (CL:IF (\GETSTREAM FILE 'OUTPUT T) + FILE + [OPENSTREAM (CL:IF (EQ 'LPT (FILENAMEFIELD FILE 'HOST)) + FILE + (PACKFILENAME 'BODY FILE 'EXTENSION 'PS)) + 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) + (SEQUENTIAL T])] (IMAGEDATA (create \POSTSCRIPTDATA)) PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX] (replace (STREAM IMAGEDATA) of STREAM with IMAGEDATA) @@ -1382,37 +1391,38 @@ (FULLNAME STREAM]) (POSTSCRIPT.TEDIT - [LAMBDA (FILE PFILE) (* ; "Edited 18-Sep-91 18:16 by jds") + [LAMBDA (FILE IMAGESTREAM) (* ; "Edited 13-Sep-2025 20:21 by rmk") + (* ; "Edited 12-Sep-2025 13:40 by rmk") + (* ; "Edited 18-Sep-91 18:16 by jds") - (* ;; "Make a PS file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.") + (* ;; "IMAGESTREAM must be a postscript stream ") - [COND - ((STRINGP FILE) - (SETQ FILE (MKATOM FILE] - (SETQ FILE (OPENTEXTSTREAM FILE)) - (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT) - (CLOSEF? FILE) - PFILE]) + (TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM]) (POSTSCRIPT.TEXT - [LAMBDA (FILE PSCFILE FONTS HEADING TABS) (* ; "Edited 23-Apr-89 11:31 by TAL") - (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS - `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE]) + [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 17-Sep-2025 23:21 by rmk") + (* ; "Edited 23-Apr-89 11:31 by TAL") + (TEXTTOIMAGEFILE FILE IMAGEFILE IMAGETYPE `(,@OPTIONS REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) (POSTSCRIPTFILEP - [LAMBDA (FILE) (* ; "Edited 10-Sep-2025 14:51 by rmk") + [LAMBDA (FILE) (* ; "Edited 9-Oct-2025 21:16 by rmk") + (* ; "Edited 18-Sep-2025 09:35 by rmk") + (* ; "Edited 13-Sep-2025 23:23 by rmk") + (* ; "Edited 10-Sep-2025 14:51 by rmk") (* ; "Edited 21-Nov-2023 17:04 by rmk") (* ; "Edited 5-Mar-93 21:40 by rmk:") (* ; "Edited 14-Jan-93 10:56 by jds") - (OR (CL:MEMBER (FILENAMEFIELD FILE 'EXTENSION) - (EXTENSIONS.FOR.PRINTFILETYPE 'POSTSCRIPT) + (OR (MEMBER (U-CASE (FILENAMEFIELD FILE 'EXTENSION)) + (EXTENSIONS.FOR.IMAGEFILETYPE 'POSTSCRIPT) :TEST (FUNCTION STRING-EQUAL)) (RESETLST [LET (STRM) [if (SETQ STRM (\GETSTREAM FILE 'INPUT T)) - then (RESETSAVE (GETFILEPTR STRM) - `(SETFILEPTR ,STRM OLDVALUE)) + then [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM] (SETFILEPTR STRM 0) else (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF OLDVALUE] @@ -1422,24 +1432,26 @@ (CHARCODE !])]) (MAKEEPSFILE - [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Apr-94 14:48 by rmk:") + [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 16-Sep-2025 00:29 by rmk") + (* ; "Edited 7-Apr-94 14:48 by rmk:") - (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") + (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") - (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT)) - (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) - IMAGEOBJ STREAM)) - (BOUNDINGBOX (LIST 0 0 (FETCH XSIZE OF IMAGEBOX) - (FETCH YSIZE OF IMAGEBOX] - [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT - `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) - ,(FETCH YSIZE OF IMAGEBOX] - (MOVETO (FETCH XKERN OF IMAGEBOX) - (FETCH YDESC OF IMAGEBOX) - STREAM) - (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) - IMAGEOBJ STREAM) - (CLOSEF STREAM]) + (* ;; "This opens a scratch stream to get the postscript imagebox of the object, then opens the true stream with that object.") + + (LET ([IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) + IMAGEOBJ + (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT] + STREAM) + [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT + `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) + ,(FETCH YSIZE OF IMAGEBOX] + (MOVETO (FETCH XKERN OF IMAGEBOX) + (FETCH YDESC OF IMAGEBOX) + STREAM) + (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) + IMAGEOBJ STREAM) + (CLOSEF STREAM]) ) (DEFINEQ @@ -4362,7 +4374,7 @@ (ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE)))) (ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) @@ -4412,39 +4424,39 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (23396 33604 (POSTSCRIPT.INIT 23406 . 30210) (POSTSCRIPT.PUTRGBCOLOR 30212 . 31234) ( -\PSC.COLOR.TO.RGB 31236 . 33602)) (34590 69697 (PSCFONT.READFONT 34600 . 36508) (PSCFONT.SPELLFILE -36510 . 37323) (PSCFONT.COERCEFILE 37325 . 38897) (PSCFONTFROMCACHE.SPELLFILE 38899 . 39884) ( -PSCFONTFROMCACHE.COERCEFILE 39886 . 41538) (PSCFONT.WRITEFONT 41540 . 42555) (READ-AFM-FILE 42557 . -48428) (CONVERT-AFM-FILES 48430 . 49642) (POSTSCRIPT.GETFONTID 49644 . 51039) (POSTSCRIPT.FONTCREATE -51041 . 63724) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63726 . 66123) (POSTSCRIPT.FONTSAVAILABLE 66125 - . 68308) (POSTSCRIPT.FONTEXISTS? 68310 . 69695)) (69698 78983 (OPENPOSTSCRIPTSTREAM 69708 . 78649) ( -CLOSEPOSTSCRIPTSTREAM 78651 . 78981)) (79028 85162 (POSTSCRIPT.HARDCOPYW 79038 . 82145) ( -POSTSCRIPT.TEDIT 82147 . 82631) (POSTSCRIPT.TEXT 82633 . 82924) (POSTSCRIPTFILEP 82926 . 84113) ( -MAKEEPSFILE 84115 . 85160)) (85163 128737 (POSTSCRIPT.BITMAPSCALE 85173 . 87629) ( -POSTSCRIPT.CLOSESTRING 87631 . 88184) (POSTSCRIPT.ENDPAGE 88186 . 89077) (POSTSCRIPT.OUTSTR 89079 . -90296) (POSTSCRIPT.PUTBITMAPBYTES 90298 . 98769) (POSTSCRIPT.PUTCOMMAND 98771 . 99760) ( -POSTSCRIPT.SET-FAKE-LANDSCAPE 99762 . 104282) (POSTSCRIPT.SHOWACCUM 104284 . 106439) ( -POSTSCRIPT.STARTPAGE 106441 . 108973) (\POSTSCRIPTTAB 108975 . 109772) (\PS.BOUTFIXP 109774 . 111054) -(\PS.SCALEHACK 111056 . 113699) (\PS.SCALEREGION 113701 . 114261) (\SCALEDBITBLT.PSC 114263 . 118573) -(\SETPOS.PSC 118575 . 119056) (\SETXFORM.PSC 119058 . 121642) (\STRINGWIDTH.PSC 121644 . 122117) ( -\SWITCHFONTS.PSC 122119 . 127611) (\TERPRI.PSC 127613 . 128735)) (128772 182628 (\BITBLT.PSC 128782 . -129334) (\BLTSHADE.PSC 129336 . 133997) (\CHARWIDTH.PSC 133999 . 134506) (\CREATECHARSET.PSC 134508 . -135864) (\DRAWARC.PSC 135866 . 138244) (\DRAWCIRCLE.PSC 138246 . 140497) (\DRAWCURVE.PSC 140499 . -144343) (\DRAWELLIPSE.PSC 144345 . 146709) (\DRAWLINE.PSC 146711 . 149451) (\DRAWPOINT.PSC 149453 . -150029) (\DRAWPOLYGON.PSC 150031 . 153160) (\DSPBOTTOMMARGIN.PSC 153162 . 153849) ( -\DSPCLIPPINGREGION.PSC 153851 . 155226) (\DSPCOLOR.PSC 155228 . 156159) (\DSPFONT.PSC 156161 . 159798) - (\DSPLEFTMARGIN.PSC 159800 . 160486) (\DSPLINEFEED.PSC 160488 . 161078) (\DSPPUSHSTATE.PSC 161080 . -162540) (\DSPPOPSTATE.PSC 162542 . 166027) (\DSPRESET.PSC 166029 . 166694) (\DSPRIGHTMARGIN.PSC 166696 - . 167385) (\DSPROTATE.PSC 167387 . 168386) (\DSPSCALE.PSC 168388 . 169340) (\DSPSCALE2.PSC 169342 . -170182) (\DSPSPACEFACTOR.PSC 170184 . 171105) (\DSPTOPMARGIN.PSC 171107 . 171678) (\DSPTRANSLATE.PSC -171680 . 173711) (\DSPXPOSITION.PSC 173713 . 174277) (\DSPYPOSITION.PSC 174279 . 174870) ( -\FILLCIRCLE.PSC 174872 . 177097) (\FILLPOLYGON.PSC 177099 . 180336) (\FIXLINELENGTH.PSC 180338 . -181657) (\MOVETO.PSC 181659 . 182429) (\NEWPAGE.PSC 182431 . 182626)) (182684 204830 ( -\POSTSCRIPT.CHANGECHARSET 182694 . 183412) (\POSTSCRIPT.OUTCHARFN 183414 . 195684) ( -\POSTSCRIPT.PRINTSLUG 195686 . 197410) (\POSTSCRIPT.SPECIALOUTCHARFN 197412 . 199763) (\UPDATE.PSC -199765 . 201011) (\POSTSCRIPT.ACCENTFN 201013 . 201955) (\POSTSCRIPT.ACCENTPAIR 201957 . 204828)) ( -204928 206573 (\PSC.SPACEDISP 204938 . 205217) (\PSC.SPACEWID 205219 . 205838) (\PSC.SYMBOLS 205840 . -206571)) (206682 209673 (\POSTSCRIPT.NSHASH 206692 . 209671)) (255083 255789 (POSTSCRIPTSEND 255093 . -255787))))) + (FILEMAP (NIL (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) ( +\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69808 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE +36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) ( +PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 . +48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE +51033 . 63835) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63837 . 66234) (POSTSCRIPT.FONTSAVAILABLE 66236 + . 68419) (POSTSCRIPT.FONTEXISTS? 68421 . 69806)) (69809 79532 (OPENPOSTSCRIPTSTREAM 69819 . 79198) ( +CLOSEPOSTSCRIPTSTREAM 79200 . 79530)) (79577 86399 (POSTSCRIPT.HARDCOPYW 79587 . 82694) ( +POSTSCRIPT.TEDIT 82696 . 83148) (POSTSCRIPT.TEXT 83150 . 83737) (POSTSCRIPTFILEP 83739 . 85227) ( +MAKEEPSFILE 85229 . 86397)) (86400 129974 (POSTSCRIPT.BITMAPSCALE 86410 . 88866) ( +POSTSCRIPT.CLOSESTRING 88868 . 89421) (POSTSCRIPT.ENDPAGE 89423 . 90314) (POSTSCRIPT.OUTSTR 90316 . +91533) (POSTSCRIPT.PUTBITMAPBYTES 91535 . 100006) (POSTSCRIPT.PUTCOMMAND 100008 . 100997) ( +POSTSCRIPT.SET-FAKE-LANDSCAPE 100999 . 105519) (POSTSCRIPT.SHOWACCUM 105521 . 107676) ( +POSTSCRIPT.STARTPAGE 107678 . 110210) (\POSTSCRIPTTAB 110212 . 111009) (\PS.BOUTFIXP 111011 . 112291) +(\PS.SCALEHACK 112293 . 114936) (\PS.SCALEREGION 114938 . 115498) (\SCALEDBITBLT.PSC 115500 . 119810) +(\SETPOS.PSC 119812 . 120293) (\SETXFORM.PSC 120295 . 122879) (\STRINGWIDTH.PSC 122881 . 123354) ( +\SWITCHFONTS.PSC 123356 . 128848) (\TERPRI.PSC 128850 . 129972)) (130009 183865 (\BITBLT.PSC 130019 . +130571) (\BLTSHADE.PSC 130573 . 135234) (\CHARWIDTH.PSC 135236 . 135743) (\CREATECHARSET.PSC 135745 . +137101) (\DRAWARC.PSC 137103 . 139481) (\DRAWCIRCLE.PSC 139483 . 141734) (\DRAWCURVE.PSC 141736 . +145580) (\DRAWELLIPSE.PSC 145582 . 147946) (\DRAWLINE.PSC 147948 . 150688) (\DRAWPOINT.PSC 150690 . +151266) (\DRAWPOLYGON.PSC 151268 . 154397) (\DSPBOTTOMMARGIN.PSC 154399 . 155086) ( +\DSPCLIPPINGREGION.PSC 155088 . 156463) (\DSPCOLOR.PSC 156465 . 157396) (\DSPFONT.PSC 157398 . 161035) + (\DSPLEFTMARGIN.PSC 161037 . 161723) (\DSPLINEFEED.PSC 161725 . 162315) (\DSPPUSHSTATE.PSC 162317 . +163777) (\DSPPOPSTATE.PSC 163779 . 167264) (\DSPRESET.PSC 167266 . 167931) (\DSPRIGHTMARGIN.PSC 167933 + . 168622) (\DSPROTATE.PSC 168624 . 169623) (\DSPSCALE.PSC 169625 . 170577) (\DSPSCALE2.PSC 170579 . +171419) (\DSPSPACEFACTOR.PSC 171421 . 172342) (\DSPTOPMARGIN.PSC 172344 . 172915) (\DSPTRANSLATE.PSC +172917 . 174948) (\DSPXPOSITION.PSC 174950 . 175514) (\DSPYPOSITION.PSC 175516 . 176107) ( +\FILLCIRCLE.PSC 176109 . 178334) (\FILLPOLYGON.PSC 178336 . 181573) (\FIXLINELENGTH.PSC 181575 . +182894) (\MOVETO.PSC 182896 . 183666) (\NEWPAGE.PSC 183668 . 183863)) (183921 206067 ( +\POSTSCRIPT.CHANGECHARSET 183931 . 184649) (\POSTSCRIPT.OUTCHARFN 184651 . 196921) ( +\POSTSCRIPT.PRINTSLUG 196923 . 198647) (\POSTSCRIPT.SPECIALOUTCHARFN 198649 . 201000) (\UPDATE.PSC +201002 . 202248) (\POSTSCRIPT.ACCENTFN 202250 . 203192) (\POSTSCRIPT.ACCENTPAIR 203194 . 206065)) ( +206165 207810 (\PSC.SPACEDISP 206175 . 206454) (\PSC.SPACEWID 206456 . 207075) (\PSC.SYMBOLS 207077 . +207808)) (207919 210910 (\POSTSCRIPT.NSHASH 207929 . 210908)) (256320 257026 (POSTSCRIPTSEND 256330 . +257024))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index b8c89407b4207393744c36e8362ca62a22ed24f6..737ecc662d447af61f77c799529880456125b737 100644 GIT binary patch delta 3303 zcmZuz&u<&Y73PwP0ZXkN*_Gwck@LdTc4SBN&g^d@K($;B#g&%3>)oXz83YX1Qf#GZ z+N92{22nTY$JTZ)V=S zAK&}l{OX@ieDjYd-q}2@twgu)t#Fka#H^O)v<&sZkIcHEFVk#;v8h$9rScYI4<0^~ zKU|p`((Y^2=njH_rgt@)%?54Xy0^3a*yCJnEYCjQ^#kE0!p%g78ticvymj%op%XV% z&UpTca#`MZahY0iBCh+W#c@fKN*nSY_39ho$AgCO$S_}?IlF%m&Wrp2i1Zzg0K zPAO0|8kVu}dTx@6j10@BZWLy562)W~hZPx`Nqx^tVNo|EUBgzXPG@F0(4aR?z3xRQ zXd=WNsfjd$6;dfoV-W;01EgtM?$)2aq%pm?ur!0XGueEgf!jR) zgf!bas+jA9EO;c7cE~EYPo`;*+GNNrFTYGJz8v>SIoAx@o41m=%fJ3^tx{dRQ^DWv zocw)v^`o_NJ}ali%GVGs?%i#_UaL7w%isU>%%Y=OG!&beNJ2O0MoHhz$TqB;efiAD z)>Z0@a6mRTc|mJUWL>fhqcC&~5KCn=OkeUduP4n_bW>jHrfKA1 z!t$GI3j#h4+tDBsfFXw^ag=5y2%C_mSt2QoQoq$o1WJ7nz9eahBfP`@^}tUvjMeL?YCbBH0X!;G z4+X9;*Fc&J^wt3M{MH{&D`312PhZi&tw+!6s!e|1T@$H)1A+1+VQIFWKe>L!w!p0j zNg{a#;FIY^`icn}0WybptcYs^HvpS6YGnc#(zyBF{hG2kgOMuLEFlL|YS3~H)No79 zf4_cq1pgm_C1`34Kh7+YxF)pYeY|k+^pq=w2T`07a}FTI9Duz;_$ zJ>Z#)@e#?c2H4o*DpICfoEjJKCtll5U)Z_#=1&_1r{npu^D>5-PK~R(KfZNm=V!Y= z-+B4g?R!6Y11}EE(DTnWsA}1J-)!vF+%j{elRn-Tvfh@davc0yU3Ci{ezNks30CR& zSu=~8QwNr3LqEua_}sG^s#w-hN^&kwwMsq62H_ULdF#^w5FpAkO^Gf6qUKW{Xth!*xwGI)ScjL>m7}+Vdk&YLI<7pF+qdb} zg@YQAFV7+&?PxRaXG^0uW+W_%z!vG7S1RRfB6_vjJ9*;N{IfN8l7v^beZ{XTG6^yZ zMYF%*SMf;2kFs9Or?fs?U4ON@aq`3`>qYJW4+h@yf@qYAE;(jtQ`BBBo|x!U{ph;L zBJ}Vgty2iaWAG6Xf>i7npGS;9Y8^j~19wZlNm1BSg$~}Hq{k$1%47we6-V`P5#@5Q~p4)_PB4p))P)t`bRd%ZX2RaZmg8%>k delta 3408 zcmZu!O>7)z8Q$5gi{juUuImO2ZCl-h`)2pciZ&SU~4?~*X)@U^9w7YY6Z}*Ysbyi=UT@mNK)OT~gO?B-NDip4A;e?@+&TYqH z#es71h4RiM&hpGlgCuVRQIM}vGfDmHLEO*Q+7L%|vL`C5jxdNB#h;YrDszthqkOo0 zR3~#oCglQ_oGhZq_B+F(-Y?E)M>6p=O)9Xa_c9L6&BaALe9Q26ckXluT1ECsdQRORsrdH_iNP6VYK1oMfKRs)1m%MTZzSiusooYK)o1-@g3SCzxi*E6R&W zcZ}jM#*@!;nu^4_pNq3Wn{<& zW3zx3N42QtE#q2j;a@b;Ad-&CTEK~tB==g+Z1yH)1sGQZ99n8TW+3_%{9ul zdaXDlTQ7ap_DlT4DOq+Ilc_0FvuWtvAnL@#5nEx~)D~`;a*H2%vABo~7+v~tCMSbi z#i99?WozVGVoqtzln8^9zyUGrU0YZ-O`Ft)Mh4?$t1;Q?+$vip*9-0A#p37ei6g^W zIXQDMSF2Qye$slgR*efO)G7x8i>816aCY7r$74@>xj8f@U-Ik(vGIhF}*R{@w0f4}&a6pHY##v^3BhMmU=E zbJCDpew6i7zmcxD$kNG8Q+JCDi{bFU8ThJHb#trjIg2jaM3n|Uni^x$pXJf zc$*nhNeUoX^!8&lzc}nJp4L=K1-&3u1cu0T?1#o8@?#6+85247;_wid z@VHP@AJQqADt!FVac&o%-dEmy2gFNEYJeR?M3QOaO(0pPRtS`WFQ~PJN(_hsZc`#fV1@b5zD-P{ z(h+>D60FP!uoUzaWg^K8T+r@r0q!VmDw0E0RY{Tc^Z4;^?`C^<-#VzHo>?gSyL+$I zLAB^!+W+p(>wDkd|H0mCJ2&s%`5qQg#ER!bsv6o+6du(EiO3}iQ2Rw^l`49rQmI}! zfp6t!W%I4dy-{b^-M_WF`?^@1`-1qE3+|c9ih)uP#+l!_Oh7)KGeO=ciMN3yY|F}z zx+9V~hh;fK{Brx-H`HJ!C>;!`iah#fMdv*l`NV(g}pg$WW68a@6 zi&@ZL<`wTGdiU!Ur80BHm8!SAwrmsm{id+v)+hK~!cS?IutylNndh;LzjV&riq7x9 zUscX6gNMeXfk(69_4KI+-4g?`6+qJP|3sM?pa!+nHf~*& z4^^;VFTU>QF-nv~LCK-RVuwHqN*!%R_(k?iZ2`zM71b!nlF;2kp#!Clz2n0pqP~wI zNg(%;udo-KJXtd6hY_A|sTZgIkMJsVQ931rkAB(@J~}hmiR?pWAN})xAM78S{q^C# HvRC~-i0n*= From 016a71622c5035765aba7258612f7ce68fbc0778 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 13 Oct 2025 18:05:42 -0700 Subject: [PATCH 3/3] Use field names instead of CAR/CADR --- library/POSTSCRIPTSTREAM | 72 +++++++++++++++++----------------- library/POSTSCRIPTSTREAM.LCOM | Bin 93174 -> 93174 bytes 2 files changed, 36 insertions(+), 36 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 204736af..f088d9fe 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,6 +1,6 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Oct-2025 17:39:50" {WMEDLEY}POSTSCRIPTSTREAM.;54 260212 +(FILECREATED "13-Oct-2025 18:05:08" {WMEDLEY}POSTSCRIPTSTREAM.;55 260304 :EDIT-BY rmk @@ -889,7 +889,7 @@ FONTID]) (POSTSCRIPT.FONTCREATE - [LAMBDA (FONTSPEC) (* ; "Edited 13-Oct-2025 17:39 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 13-Oct-2025 18:04 by rmk") (* ; "Edited 7-Sep-2025 23:44 by rmk") (* ; "Edited 30-Aug-2025 23:24 by rmk") (* ; "Edited 21-Aug-2025 18:21 by rmk") @@ -899,9 +899,9 @@ (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD FACECHANGED FAMILY SIZE FACE ROTATION DEVICE WEIGHT SLOPE EXPANSION) (SPREADFONTSPEC FONTSPEC) - (SETQ WEIGHT (CAR FACE)) - (SETQ SLOPE (CADR FACE)) - (SETQ EXPANSION (CADDR FACE)) + (SETQ WEIGHT (fetch (FONTFACE WEIGHT) of FACE)) + (SETQ SLOPE (fetch (FONTFACE SLOPE) of FACE)) + (SETQ EXPANSION (fetch (FONTFACE EXPANSION) of FACE)) (* ;;  "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") @@ -4425,38 +4425,38 @@ ) (DECLARE%: DONTCOPY (FILEMAP (NIL (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) ( -\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69808 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE +\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69900 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE 36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) ( PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 . 48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE -51033 . 63835) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63837 . 66234) (POSTSCRIPT.FONTSAVAILABLE 66236 - . 68419) (POSTSCRIPT.FONTEXISTS? 68421 . 69806)) (69809 79532 (OPENPOSTSCRIPTSTREAM 69819 . 79198) ( -CLOSEPOSTSCRIPTSTREAM 79200 . 79530)) (79577 86399 (POSTSCRIPT.HARDCOPYW 79587 . 82694) ( -POSTSCRIPT.TEDIT 82696 . 83148) (POSTSCRIPT.TEXT 83150 . 83737) (POSTSCRIPTFILEP 83739 . 85227) ( -MAKEEPSFILE 85229 . 86397)) (86400 129974 (POSTSCRIPT.BITMAPSCALE 86410 . 88866) ( -POSTSCRIPT.CLOSESTRING 88868 . 89421) (POSTSCRIPT.ENDPAGE 89423 . 90314) (POSTSCRIPT.OUTSTR 90316 . -91533) (POSTSCRIPT.PUTBITMAPBYTES 91535 . 100006) (POSTSCRIPT.PUTCOMMAND 100008 . 100997) ( -POSTSCRIPT.SET-FAKE-LANDSCAPE 100999 . 105519) (POSTSCRIPT.SHOWACCUM 105521 . 107676) ( -POSTSCRIPT.STARTPAGE 107678 . 110210) (\POSTSCRIPTTAB 110212 . 111009) (\PS.BOUTFIXP 111011 . 112291) -(\PS.SCALEHACK 112293 . 114936) (\PS.SCALEREGION 114938 . 115498) (\SCALEDBITBLT.PSC 115500 . 119810) -(\SETPOS.PSC 119812 . 120293) (\SETXFORM.PSC 120295 . 122879) (\STRINGWIDTH.PSC 122881 . 123354) ( -\SWITCHFONTS.PSC 123356 . 128848) (\TERPRI.PSC 128850 . 129972)) (130009 183865 (\BITBLT.PSC 130019 . -130571) (\BLTSHADE.PSC 130573 . 135234) (\CHARWIDTH.PSC 135236 . 135743) (\CREATECHARSET.PSC 135745 . -137101) (\DRAWARC.PSC 137103 . 139481) (\DRAWCIRCLE.PSC 139483 . 141734) (\DRAWCURVE.PSC 141736 . -145580) (\DRAWELLIPSE.PSC 145582 . 147946) (\DRAWLINE.PSC 147948 . 150688) (\DRAWPOINT.PSC 150690 . -151266) (\DRAWPOLYGON.PSC 151268 . 154397) (\DSPBOTTOMMARGIN.PSC 154399 . 155086) ( -\DSPCLIPPINGREGION.PSC 155088 . 156463) (\DSPCOLOR.PSC 156465 . 157396) (\DSPFONT.PSC 157398 . 161035) - (\DSPLEFTMARGIN.PSC 161037 . 161723) (\DSPLINEFEED.PSC 161725 . 162315) (\DSPPUSHSTATE.PSC 162317 . -163777) (\DSPPOPSTATE.PSC 163779 . 167264) (\DSPRESET.PSC 167266 . 167931) (\DSPRIGHTMARGIN.PSC 167933 - . 168622) (\DSPROTATE.PSC 168624 . 169623) (\DSPSCALE.PSC 169625 . 170577) (\DSPSCALE2.PSC 170579 . -171419) (\DSPSPACEFACTOR.PSC 171421 . 172342) (\DSPTOPMARGIN.PSC 172344 . 172915) (\DSPTRANSLATE.PSC -172917 . 174948) (\DSPXPOSITION.PSC 174950 . 175514) (\DSPYPOSITION.PSC 175516 . 176107) ( -\FILLCIRCLE.PSC 176109 . 178334) (\FILLPOLYGON.PSC 178336 . 181573) (\FIXLINELENGTH.PSC 181575 . -182894) (\MOVETO.PSC 182896 . 183666) (\NEWPAGE.PSC 183668 . 183863)) (183921 206067 ( -\POSTSCRIPT.CHANGECHARSET 183931 . 184649) (\POSTSCRIPT.OUTCHARFN 184651 . 196921) ( -\POSTSCRIPT.PRINTSLUG 196923 . 198647) (\POSTSCRIPT.SPECIALOUTCHARFN 198649 . 201000) (\UPDATE.PSC -201002 . 202248) (\POSTSCRIPT.ACCENTFN 202250 . 203192) (\POSTSCRIPT.ACCENTPAIR 203194 . 206065)) ( -206165 207810 (\PSC.SPACEDISP 206175 . 206454) (\PSC.SPACEWID 206456 . 207075) (\PSC.SYMBOLS 207077 . -207808)) (207919 210910 (\POSTSCRIPT.NSHASH 207929 . 210908)) (256320 257026 (POSTSCRIPTSEND 256330 . -257024))))) +51033 . 63927) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63929 . 66326) (POSTSCRIPT.FONTSAVAILABLE 66328 + . 68511) (POSTSCRIPT.FONTEXISTS? 68513 . 69898)) (69901 79624 (OPENPOSTSCRIPTSTREAM 69911 . 79290) ( +CLOSEPOSTSCRIPTSTREAM 79292 . 79622)) (79669 86491 (POSTSCRIPT.HARDCOPYW 79679 . 82786) ( +POSTSCRIPT.TEDIT 82788 . 83240) (POSTSCRIPT.TEXT 83242 . 83829) (POSTSCRIPTFILEP 83831 . 85319) ( +MAKEEPSFILE 85321 . 86489)) (86492 130066 (POSTSCRIPT.BITMAPSCALE 86502 . 88958) ( +POSTSCRIPT.CLOSESTRING 88960 . 89513) (POSTSCRIPT.ENDPAGE 89515 . 90406) (POSTSCRIPT.OUTSTR 90408 . +91625) (POSTSCRIPT.PUTBITMAPBYTES 91627 . 100098) (POSTSCRIPT.PUTCOMMAND 100100 . 101089) ( +POSTSCRIPT.SET-FAKE-LANDSCAPE 101091 . 105611) (POSTSCRIPT.SHOWACCUM 105613 . 107768) ( +POSTSCRIPT.STARTPAGE 107770 . 110302) (\POSTSCRIPTTAB 110304 . 111101) (\PS.BOUTFIXP 111103 . 112383) +(\PS.SCALEHACK 112385 . 115028) (\PS.SCALEREGION 115030 . 115590) (\SCALEDBITBLT.PSC 115592 . 119902) +(\SETPOS.PSC 119904 . 120385) (\SETXFORM.PSC 120387 . 122971) (\STRINGWIDTH.PSC 122973 . 123446) ( +\SWITCHFONTS.PSC 123448 . 128940) (\TERPRI.PSC 128942 . 130064)) (130101 183957 (\BITBLT.PSC 130111 . +130663) (\BLTSHADE.PSC 130665 . 135326) (\CHARWIDTH.PSC 135328 . 135835) (\CREATECHARSET.PSC 135837 . +137193) (\DRAWARC.PSC 137195 . 139573) (\DRAWCIRCLE.PSC 139575 . 141826) (\DRAWCURVE.PSC 141828 . +145672) (\DRAWELLIPSE.PSC 145674 . 148038) (\DRAWLINE.PSC 148040 . 150780) (\DRAWPOINT.PSC 150782 . +151358) (\DRAWPOLYGON.PSC 151360 . 154489) (\DSPBOTTOMMARGIN.PSC 154491 . 155178) ( +\DSPCLIPPINGREGION.PSC 155180 . 156555) (\DSPCOLOR.PSC 156557 . 157488) (\DSPFONT.PSC 157490 . 161127) + (\DSPLEFTMARGIN.PSC 161129 . 161815) (\DSPLINEFEED.PSC 161817 . 162407) (\DSPPUSHSTATE.PSC 162409 . +163869) (\DSPPOPSTATE.PSC 163871 . 167356) (\DSPRESET.PSC 167358 . 168023) (\DSPRIGHTMARGIN.PSC 168025 + . 168714) (\DSPROTATE.PSC 168716 . 169715) (\DSPSCALE.PSC 169717 . 170669) (\DSPSCALE2.PSC 170671 . +171511) (\DSPSPACEFACTOR.PSC 171513 . 172434) (\DSPTOPMARGIN.PSC 172436 . 173007) (\DSPTRANSLATE.PSC +173009 . 175040) (\DSPXPOSITION.PSC 175042 . 175606) (\DSPYPOSITION.PSC 175608 . 176199) ( +\FILLCIRCLE.PSC 176201 . 178426) (\FILLPOLYGON.PSC 178428 . 181665) (\FIXLINELENGTH.PSC 181667 . +182986) (\MOVETO.PSC 182988 . 183758) (\NEWPAGE.PSC 183760 . 183955)) (184013 206159 ( +\POSTSCRIPT.CHANGECHARSET 184023 . 184741) (\POSTSCRIPT.OUTCHARFN 184743 . 197013) ( +\POSTSCRIPT.PRINTSLUG 197015 . 198739) (\POSTSCRIPT.SPECIALOUTCHARFN 198741 . 201092) (\UPDATE.PSC +201094 . 202340) (\POSTSCRIPT.ACCENTFN 202342 . 203284) (\POSTSCRIPT.ACCENTPAIR 203286 . 206157)) ( +206257 207902 (\PSC.SPACEDISP 206267 . 206546) (\PSC.SPACEWID 206548 . 207167) (\PSC.SYMBOLS 207169 . +207900)) (208011 211002 (\POSTSCRIPT.NSHASH 208021 . 211000)) (256412 257118 (POSTSCRIPTSEND 256422 . +257116))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index 737ecc662d447af61f77c799529880456125b737..c29c0a4f8d6206384b20eb5c414ee83b57a27b2a 100644 GIT binary patch delta 80 zcmex%o%P#w)(I)>7FGtPRt6Rmv&|VzCoY~2<4<;EROc{NFfubRHZa*-z^JJqVyO_I dV5s2j>E{Au7$`WJ8k$=)uhrbXR+G`w2>{)37KQ)- delta 80 zcmex%o%P#w)(I)>=2pg*R;C6Mv&|VzCN7>1<4<;EROc{JFfubRGBny;z^JJqVyqCL dV5s2j>E{Au7$`WJ8k!q5uhrbXR+G`w2>{(&7JL8z