Some initial work on adding support for Japanese glyphs.

(At this point I'm not sure this is the right approach, but I don't want to lose this work. Just in case it's useful.)

library/POSTSCRIPTSTREAM

@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12
 258100 
+
(FILECREATED "28-Jan-2024 19:48:39" {LIB}POSTSCRIPTSTREAM.;4
 261407 
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS POSTSCRIPTFILEP)
+      :CHANGES-TO (FNS READ-ADOBE-GLYPH-FILE)
+                  (VARS POSTSCRIPTSTREAMCOMS)
+                  (FILES UNICODE)
 
-      :PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
+      :PREVIOUS-DATE "21-Nov-2023 17:06:12" {LIB}POSTSCRIPTSTREAM.;1)
 
 
 (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -17,7 +19,7 @@
 
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
         (INITRECORDS \POSTSCRIPTDATA)
-        (FNS POSTSCRIPT.INIT)
+        (FNS POSTSCRIPT.INIT READ-ADOBE-GLYPH-FILE)
         (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
                         (PSC . TEXT)
                         (PSF . BINARY)
@@ -68,6 +70,8 @@
         (COMS 
               (* ;; "Character-output, plus special-cases:")

 
+              (FILES (SYSLOAD)
+                     UNICODE)
               (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG 
                    \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN 
                    \POSTSCRIPT.ACCENTPAIR)
@@ -481,6 +485,65 @@
                                      IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC)))
     (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255))
     (\POSTSCRIPT.NSHASH
 *POSTSCRIPT-NS-TRANSLATIONS*])
+
+(READ-ADOBE-GLYPH-FILE

+  [LAMBDA (FILESPEC)
                                         (* ; "Edited 28-Jan-2024 19:46 by mth")

+
+    (* ;; "Read the file of PostScript glyphs as provided by Adobe at ")

+
+    (* ;; "         https://github.com/adobe-type-tools/agl-aglfn/glyphlist.txt")

+
+    (* ;; " The file is assumed to be local. (i.e., this does not fetch the file from github.com)")

+
+    (* ;; "")

+
+    (* ;; "The file format is:")

+
+    (* ;; "Comment lines begin with #, ignore these lines (as well as blank lines)")

+
+    (* ;; "Glyph lines consist of two semicolon delimited fields")

+
+    (* ;; "  (1)  glyph name -- upper/lowercase letters and digits")

+
+    (* ;; "  (2) Unicode scalar value -- four uppercase hexadecimal digits")

+
+    (* ;; "* Note that some entries have multiple Unicode values. ")

+
+    (* ;; "   These are cases of a single glyph name for composite character. ")

+
+    (* ;; "      These must be handled separately. ")

+
+    (* ;; 
+
    "      (It might work just to ignore them as the composite characters may just work separately.)")

+
+    (* ;; "")

+
+    (* ;; "Result is a list of (glyph-name-string  Unicode-values)")

+
+    (CL:WITH-OPEN-FILE (STREAM FILESPEC :DIRECTION :INPUT :EXTERNAL-FORMAT :UTF-8-RAW)
+           (bind
 LINE NAME CODE SPLIT START [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE]
+              while
 (AND (SETQ LINE (CL:READ-LINE STREAM NIL NIL))
+                         (SETQ LINE (CL:STRING-TRIM " " LINE)))
+              when
 (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
+              unless
 [OR (STREQUAL LINE "")
+                         (EQ (CHARCODE %#)
+                             (NTHCHARCODE LINE START))
+                         (NOT (SETQ SPLIT (STRPOS ";" LINE]
+              collect
                                        (* (PROGN (SETQ NAME
+
                                                             (CL:STRING-RIGHT-TRIM " "
+
                                                             (SUBSTRING LINE START
+
                                                             (SUB1 SPLIT)))) (SETQ CODE
+
                                                             (HEXNUM? (SUBSTRING LINE
+
                                                             (ADD1 SPLIT)))) (LIST CODE NAME)))

+                    (CONS (PROG1 (CL:STRING-RIGHT-TRIM " " (SUBSTRING LINE START (SUB1 SPLIT)))
+                              (SETQ START (ADD1 SPLIT)))
+                          (bind
 END while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE START)
+                                                        (ADD1 (NCHARS LINE]
+                             collect
 [HEXNUM? (SUBSTRING LINE START (SUB1 END)
+                                                     (CONSTANT (CONCAT]
+                             repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T))
+                                              (NEQ (CHARCODE %#)
+                                                   (NTHCHARCODE LINE START])
 )
 
 (ADDTOVAR DEFAULTFILETYPELIST
 (PS . TEXT)
@@ -3071,6 +3134,9 @@
 
 (* ;; "Character-output, plus special-cases:")

 
+
+(FILESLOAD (SYSLOAD)
+       UNICODE)
 (DEFINEQ
 
 (\POSTSCRIPT.CHANGECHARSET

@@ -4382,39 +4448,40 @@
 
 (ADDTOVAR LAMA
 POSTSCRIPT.PUTCOMMAND)
 )
+(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT (NONE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 . 
+  (FILEMAP (NIL (22342 32527 (POSTSCRIPT.INIT 22352 . 29444) (READ-ADOBE-GLYPH-FILE 29446 . 32525)) (
-32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
+33507 68291 (PSCFONT.READFONT 33517 . 35425) (PSCFONT.SPELLFILE 35427 . 36005) (PSCFONT.COERCEFILE 
-PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
+36007 . 37579) (PSCFONTFROMCACHE.SPELLFILE 37581 . 38566) (PSCFONTFROMCACHE.COERCEFILE 38568 . 40220) 
-PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
+(PSCFONT.WRITEFONT 40222 . 41237) (READ-AFM-FILE 41239 . 47110) (CONVERT-AFM-FILES 47112 . 48324) (
-POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
+POSTSCRIPT.GETFONTID 48326 . 49721) (POSTSCRIPT.FONTCREATE 49723 . 62122) (
-\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622 
+\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62124 . 64521) (POSTSCRIPT.FONTSAVAILABLE 64523 . 68289)) (68846 
-74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
+77992 (OPENPOSTSCRIPTSTREAM 68856 . 77658) (CLOSEPOSTSCRIPTSTREAM 77660 . 77990)) (78037 84329 (
-POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
+POSTSCRIPT.HARDCOPYW 78047 . 81396) (POSTSCRIPT.TEDIT 81398 . 81878) (POSTSCRIPT.TEXT 81880 . 82171) (
-POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE 
+POSTSCRIPTFILEP 82173 . 83280) (MAKEEPSFILE 83282 . 84327)) (84330 129216 (POSTSCRIPT.BITMAPSCALE 
-81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
+84340 . 86796) (POSTSCRIPT.CLOSESTRING 86798 . 87332) (POSTSCRIPT.ENDPAGE 87334 . 88205) (
-POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND 
+POSTSCRIPT.OUTSTR 88207 . 89228) (POSTSCRIPT.PUTBITMAPBYTES 89230 . 97701) (POSTSCRIPT.PUTCOMMAND 
-94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
+97703 . 98752) (POSTSCRIPT.SET-FAKE-LANDSCAPE 98754 . 104202) (POSTSCRIPT.SHOWACCUM 104204 . 106442) (
-POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024) 
+POSTSCRIPT.STARTPAGE 106444 . 109023) (\POSTSCRIPTTAB 109025 . 109896) (\PS.BOUTFIXP 109898 . 111248) 
-(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719) 
+(\PS.SCALEHACK 111250 . 114079) (\PS.SCALEREGION 114081 . 114641) (\SCALEDBITBLT.PSC 114643 . 118943) 
-(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
+(\SETPOS.PSC 118945 . 119407) (\SETXFORM.PSC 119409 . 121228) (\STRINGWIDTH.PSC 121230 . 121684) (
-\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 . 
+\SWITCHFONTS.PSC 121686 . 127843) (\TERPRI.PSC 127845 . 129214)) (129251 184971 (\BITBLT.PSC 129261 . 
-126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 . 
+129814) (\BLTSHADE.PSC 129816 . 134098) (\CHARWIDTH.PSC 134100 . 134867) (\CREATECHARSET.PSC 134869 . 
-133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 . 
+136567) (\DRAWARC.PSC 136569 . 139049) (\DRAWCIRCLE.PSC 139051 . 141460) (\DRAWCURVE.PSC 141462 . 
-142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 . 
+145483) (\DRAWELLIPSE.PSC 145485 . 147962) (\DRAWLINE.PSC 147964 . 150314) (\DRAWPOINT.PSC 150316 . 
-147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
+150904) (\DRAWPOLYGON.PSC 150906 . 154020) (\DSPBOTTOMMARGIN.PSC 154022 . 154587) (
-\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
+\DSPCLIPPINGREGION.PSC 154589 . 156032) (\DSPCOLOR.PSC 156034 . 156875) (\DSPFONT.PSC 156877 . 161087)
- (\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 . 
+ (\DSPLEFTMARGIN.PSC 161089 . 161658) (\DSPLINEFEED.PSC 161660 . 162236) (\DSPPUSHSTATE.PSC 162238 . 
-160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
+164001) (\DSPPOPSTATE.PSC 164003 . 166512) (\DSPRESET.PSC 166514 . 167160) (\DSPRIGHTMARGIN.PSC 167162
- . 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 . 
+ . 167734) (\DSPROTATE.PSC 167736 . 168759) (\DSPSCALE.PSC 168761 . 169692) (\DSPSCALE2.PSC 169694 . 
-167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC 
+170513) (\DSPSPACEFACTOR.PSC 170515 . 171487) (\DSPTOPMARGIN.PSC 171489 . 172206) (\DSPTRANSLATE.PSC 
-168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
+172208 . 174782) (\DSPXPOSITION.PSC 174784 . 175383) (\DSPYPOSITION.PSC 175385 . 175957) (
-\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 . 
+\FILLCIRCLE.PSC 175959 . 178605) (\FILLPOLYGON.PSC 178607 . 182523) (\FIXLINELENGTH.PSC 182525 . 
-180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
+184019) (\MOVETO.PSC 184021 . 184772) (\NEWPAGE.PSC 184774 . 184969)) (185065 208217 (
-\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
+\POSTSCRIPT.CHANGECHARSET 185075 . 185879) (\POSTSCRIPT.OUTCHARFN 185881 . 198738) (
-\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC 
+\POSTSCRIPT.PRINTSLUG 198740 . 200707) (\POSTSCRIPT.SPECIALOUTCHARFN 200709 . 203141) (\UPDATE.PSC 
-199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
+203143 . 204366) (\POSTSCRIPT.ACCENTFN 204368 . 205310) (\POSTSCRIPT.ACCENTPAIR 205312 . 208215)) (
-205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 . 
+208315 209960 (\PSC.SPACEDISP 208325 . 208604) (\PSC.SPACEWID 208606 . 209225) (\PSC.SYMBOLS 209227 . 
-206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 . 
+209958)) (210069 213060 (\POSTSCRIPT.NSHASH 210079 . 213058)) (257535 258249 (POSTSCRIPTSEND 257545 . 
-254985)))))
+258247)))))
 STOP