1
0
mirror of synced 2026-03-12 05:34:56 +00:00

Merge remote-tracking branch 'origin/rmk122--FONT-next-round' into fgh_irm-01

This commit is contained in:
Frank Halasz
2025-10-14 23:37:12 -07:00
3 changed files with 247 additions and 242 deletions

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Sep-2025 14:51:53" {WMEDLEY}<library>POSTSCRIPTSTREAM.;42 258973
(FILECREATED "13-Oct-2025 18:05:08" {WMEDLEY}<library>POSTSCRIPTSTREAM.;55 260304
:EDIT-BY rmk
:CHANGES-TO (FNS POSTSCRIPTFILEP POSTSCRIPT.INIT)
:CHANGES-TO (FNS POSTSCRIPT.FONTCREATE)
:PREVIOUS-DATE " 8-Sep-2025 09:51:34" {WMEDLEY}<library>POSTSCRIPTSTREAM.;39)
:PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}<library>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 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")
(* ; "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 (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.")
[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 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 . 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

Binary file not shown.

View File

@@ -1,17 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Jul-2023 13:18:46" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;3 59739
(FILECREATED "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5 59521
:EDIT-BY rmk
:CHANGES-TO (VARS KEYBOARDCONFIGSCOMS)
:PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;4)
:PREVIOUS-DATE " 7-Feb-97 12:13:28" {WMEDLEY}<library>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