From 99a4b726a5b84301b349c8dbd6d267181370b8e2 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 16 Jun 2025 16:55:37 -0700 Subject: [PATCH 1/4] Add MEDLEYFONTFORMAT to loadup Including moving \READBINARYBITMAP from IMAGEOBJ to LLDISPLAY --- library/IMAGEOBJ | 60 +-- library/IMAGEOBJ.LCOM | Bin 14637 -> 13889 bytes sources/FILESETS | 18 +- sources/LLDISPLAY | 125 ++++-- sources/LLDISPLAY.LCOM | 108 +++-- sources/MEDLEYFONTFORMAT | 796 ++++++++++++++++++++++++++++++++++ sources/MEDLEYFONTFORMAT.LCOM | Bin 0 -> 19559 bytes 7 files changed, 966 insertions(+), 141 deletions(-) create mode 100644 sources/MEDLEYFONTFORMAT create mode 100644 sources/MEDLEYFONTFORMAT.LCOM diff --git a/library/IMAGEOBJ b/library/IMAGEOBJ index 2348610cf..457956e1d 100644 --- a/library/IMAGEOBJ +++ b/library/IMAGEOBJ @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}IMAGEOBJ.;4 34381 +(FILECREATED " 9-Jun-2025 20:33:49" {WMEDLEY}IMAGEOBJ.;5 32874 :EDIT-BY rmk - :CHANGES-TO (FNS GET.OBJ.FROM.USER) + :CHANGES-TO (VARS IMAGEOBJCOMS) - :PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}IMAGEOBJ.;3) + :PREVIOUS-DATE " 7-Dec-2024 19:44:25" {WMEDLEY}IMAGEOBJ.;4) (PRETTYCOMPRINT IMAGEOBJCOMS) @@ -15,8 +15,7 @@ ((COMS (* ;; "Bit-map image objects") - (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP - ) + (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT) (* ;; "fns for the bitmap tedit object.") @@ -117,42 +116,6 @@ (* reset type of function that changes  the title font) (DSPFONT FONT WindowTitleDisplayStream))) - -(\PRINTBINARYBITMAP - (LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16") - - (* * prints the representation of a bitmap onto STREAM in a form that can be - read back by \READBINARYBITMAP.) - - (PROG ((STREAM (GETSTREAM STREAM 'OUTPUT)) - BMH) - (OR (BITMAPP BITMAP) - (\ILLEGAL.ARG BITMAP)) - (\WOUT STREAM (BITMAPWIDTH BITMAP)) - (\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP))) - (\WOUT STREAM (BITSPERPIXEL BITMAP)) - (\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) - 0 - (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) - BMH BYTESPERWORD)) - (RETURN BITMAP)))) - -(\READBINARYBITMAP - (LAMBDA (STREAM) (* rrb "23-Jul-84 15:17") - - (* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.) - - (SETQ STREAM (GETSTREAM STREAM 'INPUT)) - (PROG ((BMW (\WIN STREAM)) - (BMH (\WIN STREAM)) - (BPP (\WIN STREAM)) - BITMAP) - (SETQ BITMAP (BITMAPCREATE BMW BMH BPP)) - (\BINS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) - 0 - (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) - BMH BYTESPERWORD)) - (RETURN BITMAP)))) ) @@ -770,12 +733,11 @@ (FILESLOAD EDITBITMAP) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT -5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 ( -BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) ( -BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5 -20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) ( -BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4 -25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) ( -PROMPTFOREVALED 32055 . 34279))))) + (FILEMAP (NIL (2914 5964 (BITMAPTEDITOBJ 2924 . 3567) (COERCETOBITMAP 3569 . 5613) (WINDOWTITLEFONT +5615 . 5962)) (6015 22133 (BMOBJ.BUTTONEVENTINFN 6025 . 10571) (BMOBJ.COPYFN 10573 . 11199) ( +BMOBJ.DISPLAYFN 11201 . 14930) (BMOBJ.IMAGEBOXFN 14932 . 17347) (BMOBJ.PUTFN 17349 . 18281) ( +BMOBJ.INIT 18283 . 19322) (BMOBJ.GETFN5 19324 . 19914) (BMOBJ.CREATE.MENU 19916 . 22131)) (22223 25507 + (SCALED.BITMAP.GETFN 22233 . 22659) (BMOBJ.GETFN 22661 . 23196) (BMOBJ.GETFN2 23198 . 23683) ( +BMOBJ.GETFN3 23685 . 24473) (BMOBJ.GETFN4 24475 . 25505)) (27442 32774 (GET.OBJ.FROM.USER 27452 . +29418) (BITMAPOBJ.SNAPW 29420 . 30546) (PROMPTFOREVALED 30548 . 32772))))) STOP diff --git a/library/IMAGEOBJ.LCOM b/library/IMAGEOBJ.LCOM index 3ab45fd9871ccfbcfc6bbb0ceaa53b6dc5c521ad..7d00568cb3a75ec71a6ebbceaf4fa0ad3241d432 100644 GIT binary patch delta 299 zcmZ2mbTDT^gs`QqS81NEk%5t^f{}rhv9Xn@!NhF6dQ(jWE+qwHgruRRm7%GXfuWK@ zQc-Gher`c#PHKumaz z?ymk$Ue5l$!I}zI0YR=|p8lc1x-LMYCd)ILZoa_C$2_@^Lv-^xb|&@7SM>~m9I?r= s`n-%>leP3MCMWA_16h6gnv-|v8v|Ld^^MsTG_(|~6}UF58gOs|0PC<$g8%>k delta 1036 zcmZuv%Wl&^6t&YpTBAk{qAbx>P*sN}mdB4IHBx1}ags^w*m4}&LJ-h4LMtd6@gE~YOk~QXlr|;+gXRsi|yW%83iha$Ju&~E4#MEwVH+t z8xJ8}ZkZ+=FT!zL8rJVUB`43UE~hgLTgIl5Sac1|GfKfLS}uSniA4m8QNmtMUxD7% z15g<BBk#bDj-sxzPmXR11MmPp4|nx?%qUQg}&0`5;GMp~bzgbaKpZJ1%Z`I&Nt0 zijF-?b3iE-8P)*=x>W@ScxZa06ALieI)Xfe*%_dAFHlrWyHAmi87!&C3H8eW?5OY5 zi2>+W!}#H5{r51XU#oWy{t)Po$oFj=ktPnw5%=kKBjT*aG4A}J_;*Sj#&0pa-;M33 z#u$4lB$zO$canX3%D%X1U+Tu~WKx}?ScC*<>vqfc0P$!DJ(w2;k7_!G>)>U>grXD? z1u+77DSCF*z?G^8ay}v?IRaun%2>iBuL?pD+SoLWie_?}TOpSX<|I@xGsz-f7NA@* zZU7<`B5@Hp6j_0UL!AN5A8yKEw>+oik@K0!HnFC3mVM%3x&!1{jzgRrIjUPr#7^R@ zKeU#Zcz2wlXmw=bDzy&3RQRbLTT@r#Ra_%(Q`9ZB9*G~uBk>c~3GEj?T8&LR*^QgY zI+0x>EewY&oNYkzNj-{us0I-{5`&C>q=hsRAb5KY_Ws6WvomnU{GO5|_&0}WCg@LJ p4*2Y3u#hd1zvtPx;3b+J1C|MXWX0ehD<&9VufcWLo6n6;{0FeX{9^zB diff --git a/sources/FILESETS b/sources/FILESETS index 0aea357f3..7e68ebd98 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,9 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-May-2023 08:11:56" {DSK}larry>il>medley>sources>FILESETS.;24 - :EDIT-BY "lmm" +(FILECREATED "16-Jun-2025 15:43:50" {MEDLEY}FILESETS.;5 6206 + + :EDIT-BY rmk + + :CHANGES-TO (VARS 1LISPSET) + + :PREVIOUS-DATE "10-Jun-2025 18:00:09" {MEDLEY}FILESETS.;4) - :PREVIOUS-DATE " 1-Mar-2023 07:49:03" {DSK}larry>il>medley>sources>FILESETS.;23) (PRETTYCOMPRINT FILESETSCOMS) @@ -53,8 +57,8 @@ (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY - DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST - CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT)) + DSK UFS UFSCALLC PASSWORDS FONT MEDLEYFONTFORMAT APUTDQ COMPATIBILITY DMISC CMLMACROS + CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT LLDISPLAY)) (RPAQQ 2LISPSET (MACHINEINDEPENDENT)) @@ -64,8 +68,8 @@ (IOCHAR MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER - IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS - DTDECLARE BIGBITMAPS)) + IMAGEIO PROC MCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS + DTDECLARE)) (RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW)) diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index 634f7a058..2e9501fb6 100644 --- a/sources/LLDISPLAY +++ b/sources/LLDISPLAY @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 +(FILECREATED " 9-Jun-2025 20:34:14" {WMEDLEY}LLDISPLAY.;20 272103 :EDIT-BY rmk - :CHANGES-TO (FNS BITMAPEQUAL) + :CHANGES-TO (VARS LLDISPLAYCOMS) + (FNS \PRINTBINARYBITMAP) - :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) + :PREVIOUS-DATE "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19) (PRETTYCOMPRINT LLDISPLAYCOMS) @@ -33,6 +34,7 @@ \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) + (FNS \READBINARYBITMAP \PRINTBINARYBITMAP) (FUNCTIONS FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) @@ -1501,6 +1503,44 @@ (T (SHOULDNT "Invalid argument to \XW.BIBLT"))) T]) ) +(DEFINEQ + +(\READBINARYBITMAP + [LAMBDA (STREAM) (* rrb "23-Jul-84 15:17") + + (* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.) + + (SETQ STREAM (GETSTREAM STREAM 'INPUT)) + (PROG ((BMW (\WIN STREAM)) + (BMH (\WIN STREAM)) + (BPP (\WIN STREAM)) + BITMAP) + (SETQ BITMAP (BITMAPCREATE BMW BMH BPP)) + (\BINS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) + 0 + (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) + BMH BYTESPERWORD)) + (RETURN BITMAP]) + +(\PRINTBINARYBITMAP + [LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16") + + (* * prints the representation of a bitmap onto STREAM in a form that can be read + back by \READBINARYBITMAP.) + + (PROG ((STREAM (GETSTREAM STREAM 'OUTPUT)) + BMH) + (OR (BITMAPP BITMAP) + (\ILLEGAL.ARG BITMAP)) + (\WOUT STREAM (BITMAPWIDTH BITMAP)) + (\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP))) + (\WOUT STREAM (BITSPERPIXEL BITMAP)) + (\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP) + 0 + (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) + BMH BYTESPERWORD)) + (RETURN BITMAP]) +) (CL:DEFUN FINISH-READING-BITMAP (STREAM) @@ -4573,43 +4613,44 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20459 23127 (\FBITMAPBIT 20469 . 20929) (\FBITMAPBIT.UFN 20931 . 21950) ( -\NEWPAGE.DISPLAY 21952 . 22087) (INITBITMASKS 22089 . 23125)) (25052 25561 (\CreateCursorBitMap 25062 - . 25559)) (25678 86230 (BITBLT 25688 . 36078) (BLTSHADE 36080 . 36858) (\BITBLTSUB 36860 . 46995) ( -\GETPILOTBBTSCRATCHBM 46997 . 47612) (BITMAPCOPY 47614 . 48190) (BITMAPCREATE 48192 . 49752) ( -BITMAPBIT 49754 . 58141) (BITMAPEQUAL 58143 . 59605) (BLTCHAR 59607 . 60223) (\BLTCHAR 60225 . 60727) -(\MEDW.BLTCHAR 60729 . 65607) (\CHANGECHARSET.DISPLAY 65609 . 68567) (\INDICATESTRING 68569 . 69765) ( -\SLOWBLTCHAR 69767 . 76863) (TEXTUREP 76865 . 77135) (INVERT.TEXTURE 77137 . 77411) ( -INVERT.TEXTURE.BITMAP 77413 . 78948) (BITMAPWIDTH 78950 . 79322) (READBITMAP 79324 . 81834) ( -\INSUREBITSPERPIXEL 81836 . 82131) (MAXIMUMCOLOR 82133 . 82274) (OPPOSITECOLOR 82276 . 82455) ( -MAXIMUMSHADE 82457 . 82668) (OPPOSITESHADE 82670 . 82849) (\MEDW.BITBLT 82851 . 86228)) (86232 91418 ( -FINISH-READING-BITMAP 86232 . 91418)) (92540 93021 (BITMAPBIT.EXPANDER 92550 . 93019)) (93022 141556 ( -\BITBLT.DISPLAY 93032 . 116271) (\BITBLT.BITMAP 116273 . 125372) (\BITBLT.MERGE 125374 . 127627) ( -\BLTSHADE.DISPLAY 127629 . 134729) (\BLTSHADE.BITMAP 134731 . 141554)) (141557 150877 ( -\BITBLT.BITMAP.SLOW 141567 . 150875)) (150878 167259 (\PUNT.BLTSHADE.BITMAP 150888 . 157984) ( -\PUNT.BITBLT.BITMAP 157986 . 167257)) (167260 170700 (\SCALEDBITBLT.DISPLAY 167270 . 168903) ( -\BACKCOLOR.DISPLAY 168905 . 170698)) (174555 176828 (DISPLAYSTREAMP 174565 . 175173) (DSPSOURCETYPE -175175 . 176184) (DSPXOFFSET 176186 . 176505) (DSPYOFFSET 176507 . 176826)) (176829 191024 ( -DSPDESTINATION 176839 . 179942) (DSPTEXTURE 179944 . 180106) (\DISPLAYSTREAMINCRXPOSITION 180108 . -180395) (\SFFixDestination 180397 . 181575) (\SFFixClippingRegion 181577 . 183749) (\SFFixFont 183751 - . 184801) (\SFFIXLINELENGTH 184803 . 186299) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 186301 . 188114 -) (\SFFixY 188116 . 191022)) (191025 194872 (\SIMPLE.DSPCREATE 191035 . 191585) (\COMMON.DSPCREATE -191587 . 194870)) (194973 197167 (\MEDW.XOFFSET 194983 . 196124) (\MEDW.YOFFSET 196126 . 197165)) ( -197168 205094 (\DSPCLIPPINGREGION.DISPLAY 197178 . 197924) (\DSPFONT.DISPLAY 197926 . 200296) ( -\DISPLAY.PILOTBITBLT 200298 . 200447) (\DSPLINEFEED.DISPLAY 200449 . 201020) (\DSPLEFTMARGIN.DISPLAY -201022 . 201753) (\DSPOPERATION.DISPLAY 201755 . 202779) (\DSPRIGHTMARGIN.DISPLAY 202781 . 203626) ( -\DSPXPOSITION.DISPLAY 203628 . 204485) (\DSPYPOSITION.DISPLAY 204487 . 205092)) (209282 214318 ( -TTYDISPLAYSTREAM 209292 . 214316)) (214621 215651 (DSPSCROLL 214631 . 215331) (PAGEHEIGHT 215333 . -215649)) (215696 218718 (\DSPRESET.DISPLAY 215706 . 218716)) (218754 219277 (\MAYBE-DRIBBLE-CHAR -218754 . 219277)) (219278 239916 (\DSPPRINTCHAR 219288 . 227126) (\DSPPRINTCR/LF 227128 . 239914)) ( -239917 240509 (\TTYBACKGROUND 239927 . 240507)) (240510 243797 (DSPBACKUP 240520 . 243795)) (243981 -244237 (COLORDISPLAYP 243991 . 244235)) (244238 246309 (DISPLAYBEFOREEXIT 244248 . 245074) ( -DISPLAYAFTERENTRY 245076 . 246307)) (246681 251213 (\DSPCLIPTRANSFORMX 246691 . 247280) ( -\DSPCLIPTRANSFORMY 247282 . 248007) (\DSPTRANSFORMREGION 248009 . 248541) (\DSPUNTRANSFORMY 248543 . -248803) (\DSPUNTRANSFORMX 248805 . 249065) (\OFFSETCLIPPINGREGION 249067 . 251211)) (252527 255114 ( -UPDATESCREENDIMENSIONS 252537 . 253166) (\CreateScreenBitMap 253168 . 255112)) (255673 268832 ( -\CoerceToDisplayDevice 255683 . 256096) (\CREATEDISPLAY 256098 . 257938) (DISPLAYSTREAMINIT 257940 . -261084) (\STARTDISPLAY 261086 . 263997) (\MOVE.WINDOWS.ONTO.SCREEN 263999 . 266191) ( -\UPDATE.PBT.RASTERWIDTHS 266193 . 267975) (\STOPDISPLAY 267977 . 268469) (\DEFINEDISPLAYINFO 268471 . -268830)) (269440 270201 (INITIALIZEDISPLAYSTREAMS 269450 . 270199))))) + (FILEMAP (NIL (20562 23230 (\FBITMAPBIT 20572 . 21032) (\FBITMAPBIT.UFN 21034 . 22053) ( +\NEWPAGE.DISPLAY 22055 . 22190) (INITBITMASKS 22192 . 23228)) (25155 25664 (\CreateCursorBitMap 25165 + . 25662)) (25781 86333 (BITBLT 25791 . 36181) (BLTSHADE 36183 . 36961) (\BITBLTSUB 36963 . 47098) ( +\GETPILOTBBTSCRATCHBM 47100 . 47715) (BITMAPCOPY 47717 . 48293) (BITMAPCREATE 48295 . 49855) ( +BITMAPBIT 49857 . 58244) (BITMAPEQUAL 58246 . 59708) (BLTCHAR 59710 . 60326) (\BLTCHAR 60328 . 60830) +(\MEDW.BLTCHAR 60832 . 65710) (\CHANGECHARSET.DISPLAY 65712 . 68670) (\INDICATESTRING 68672 . 69868) ( +\SLOWBLTCHAR 69870 . 76966) (TEXTUREP 76968 . 77238) (INVERT.TEXTURE 77240 . 77514) ( +INVERT.TEXTURE.BITMAP 77516 . 79051) (BITMAPWIDTH 79053 . 79425) (READBITMAP 79427 . 81937) ( +\INSUREBITSPERPIXEL 81939 . 82234) (MAXIMUMCOLOR 82236 . 82377) (OPPOSITECOLOR 82379 . 82558) ( +MAXIMUMSHADE 82560 . 82771) (OPPOSITESHADE 82773 . 82952) (\MEDW.BITBLT 82954 . 86331)) (86334 87763 ( +\READBINARYBITMAP 86344 . 86982) (\PRINTBINARYBITMAP 86984 . 87761)) (87765 92951 ( +FINISH-READING-BITMAP 87765 . 92951)) (94073 94554 (BITMAPBIT.EXPANDER 94083 . 94552)) (94555 143089 ( +\BITBLT.DISPLAY 94565 . 117804) (\BITBLT.BITMAP 117806 . 126905) (\BITBLT.MERGE 126907 . 129160) ( +\BLTSHADE.DISPLAY 129162 . 136262) (\BLTSHADE.BITMAP 136264 . 143087)) (143090 152410 ( +\BITBLT.BITMAP.SLOW 143100 . 152408)) (152411 168792 (\PUNT.BLTSHADE.BITMAP 152421 . 159517) ( +\PUNT.BITBLT.BITMAP 159519 . 168790)) (168793 172233 (\SCALEDBITBLT.DISPLAY 168803 . 170436) ( +\BACKCOLOR.DISPLAY 170438 . 172231)) (176088 178361 (DISPLAYSTREAMP 176098 . 176706) (DSPSOURCETYPE +176708 . 177717) (DSPXOFFSET 177719 . 178038) (DSPYOFFSET 178040 . 178359)) (178362 192557 ( +DSPDESTINATION 178372 . 181475) (DSPTEXTURE 181477 . 181639) (\DISPLAYSTREAMINCRXPOSITION 181641 . +181928) (\SFFixDestination 181930 . 183108) (\SFFixClippingRegion 183110 . 185282) (\SFFixFont 185284 + . 186334) (\SFFIXLINELENGTH 186336 . 187832) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187834 . 189647 +) (\SFFixY 189649 . 192555)) (192558 196405 (\SIMPLE.DSPCREATE 192568 . 193118) (\COMMON.DSPCREATE +193120 . 196403)) (196506 198700 (\MEDW.XOFFSET 196516 . 197657) (\MEDW.YOFFSET 197659 . 198698)) ( +198701 206627 (\DSPCLIPPINGREGION.DISPLAY 198711 . 199457) (\DSPFONT.DISPLAY 199459 . 201829) ( +\DISPLAY.PILOTBITBLT 201831 . 201980) (\DSPLINEFEED.DISPLAY 201982 . 202553) (\DSPLEFTMARGIN.DISPLAY +202555 . 203286) (\DSPOPERATION.DISPLAY 203288 . 204312) (\DSPRIGHTMARGIN.DISPLAY 204314 . 205159) ( +\DSPXPOSITION.DISPLAY 205161 . 206018) (\DSPYPOSITION.DISPLAY 206020 . 206625)) (210815 215851 ( +TTYDISPLAYSTREAM 210825 . 215849)) (216154 217184 (DSPSCROLL 216164 . 216864) (PAGEHEIGHT 216866 . +217182)) (217229 220251 (\DSPRESET.DISPLAY 217239 . 220249)) (220287 220810 (\MAYBE-DRIBBLE-CHAR +220287 . 220810)) (220811 241449 (\DSPPRINTCHAR 220821 . 228659) (\DSPPRINTCR/LF 228661 . 241447)) ( +241450 242042 (\TTYBACKGROUND 241460 . 242040)) (242043 245330 (DSPBACKUP 242053 . 245328)) (245514 +245770 (COLORDISPLAYP 245524 . 245768)) (245771 247842 (DISPLAYBEFOREEXIT 245781 . 246607) ( +DISPLAYAFTERENTRY 246609 . 247840)) (248214 252746 (\DSPCLIPTRANSFORMX 248224 . 248813) ( +\DSPCLIPTRANSFORMY 248815 . 249540) (\DSPTRANSFORMREGION 249542 . 250074) (\DSPUNTRANSFORMY 250076 . +250336) (\DSPUNTRANSFORMX 250338 . 250598) (\OFFSETCLIPPINGREGION 250600 . 252744)) (254060 256647 ( +UPDATESCREENDIMENSIONS 254070 . 254699) (\CreateScreenBitMap 254701 . 256645)) (257206 270365 ( +\CoerceToDisplayDevice 257216 . 257629) (\CREATEDISPLAY 257631 . 259471) (DISPLAYSTREAMINIT 259473 . +262617) (\STARTDISPLAY 262619 . 265530) (\MOVE.WINDOWS.ONTO.SCREEN 265532 . 267724) ( +\UPDATE.PBT.RASTERWIDTHS 267726 . 269508) (\STOPDISPLAY 269510 . 270002) (\DEFINEDISPLAYINFO 270004 . +270363)) (270973 271734 (INITIALIZEDISPLAYSTREAMS 270983 . 271732))))) STOP diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM index 7aba939d9..fde2f0f03 100644 --- a/sources/LLDISPLAY.LCOM +++ b/sources/LLDISPLAY.LCOM @@ -1,9 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jul-2023 14:50:58" ("compiled on " {WMEDLEY}LLDISPLAY.;19) -"31-Jul-2023 14:48:17" "COMPILE-FILEd" in "FULL 31-Jul-2023 ..." dated "31-Jul-2023 14:48:24") -(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 :EDIT-BY rmk :CHANGES-TO ( -FNS BITMAPEQUAL) :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) +(FILECREATED " 9-Jun-2025 20:34:14" ("compiled on " {WMEDLEY}LLDISPLAY.;20) +" 3-Jun-2025 19:15:01" "COMPILE-FILEd" in "FULL 3-Jun-2025 ..." dated " 3-Jun-2025 19:15:08") +(FILECREATED " 9-Jun-2025 20:34:14" {WMEDLEY}LLDISPLAY.;20 272103 :EDIT-BY rmk :CHANGES-TO ( +VARS LLDISPLAYCOMS) (FNS \PRINTBINARYBITMAP) :PREVIOUS-DATE "31-Jul-2023 14:50:58" +{WMEDLEY}LLDISPLAY.;19) (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION @@ -15,11 +16,12 @@ WORDMASK 65535)))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS)))) (COMS (* COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP -\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS -FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE - \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT -BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY -\BLTSHADE.BITMAP) (FNS (* ;; "For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; +\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FNS +\READBINARYBITMAP \PRINTBINARYBITMAP) (FUNCTIONS FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) ( +MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS +\INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS +\BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP) (FNS (* ;; +"For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; " punt case for C funcs.bitblt_bitmap,bitshade.bitmap") \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) ( FNS (* ;; "from SUMEX-AIM") \SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY) (DECLARE%: DONTCOPY (CONSTANTS ( \DisplayWordAlign 16) (\MaxBitMapWidth 65535) (\MaxBitMapHeight 65535) (\MaxBitMapWords 131066)) ( @@ -192,7 +194,7 @@ BLTCHAR :D8 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT) () \BLTCHAR :D8 -(P 0 A0229 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) +(P 0 A0185 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () \MEDW.BLTCHAR :D8 @@ -205,10 +207,11 @@ BLTCHAR :D8 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT) () \CHANGECHARSET.DISPLAY :D8 -(P 4 \INTERRUPTABLE P 2 BM P 1 CSINFO P 0 PBT I 1 CHARSET I 0 DISPLAYDATA) Š@É*@É ÉAàÐɵ A@É h "@IÉ¿@IÉ¿@IÉ0¿@A>¿IɺHJÈàààànÿÿåÍ¿@È'IÈ -ð—@È@IÈ ð©@I -¿°#JÉJÈ@ÉBÚлHKÒÍ¿HKÓÍh(98 \SFFixY 24 \CREATECHARSET) -(130 PILOTBBT 119 PILOTBBT) +(P 7 \INTERRUPTABLE P 5 BM P 4 CSINFO P 3 PBT I 1 CHARSET I 0 DISPLAYDATA) œ@É*@É ÉAàÐɵ@É ÉAàA@É +HIÐJ¿J"@LÉ¿@LÉ¿@LÉ0¿@A>¿LɽKMÈàààànÿÿåÍ¿@È'LÈ +ð—@È@LÈ ð©@L +¿°#MÉMÈ@ÉBÚоKNÒÍ¿KNÓÍh(116 \SFFixY 30 \CREATECHARSET) +(148 PILOTBBT 137 PILOTBBT) () \INDICATESTRINGA0001 :D8 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) Hgd gi @@ -220,17 +223,18 @@ BLTCHAR :D8 (75 ^ 52 %# 16 SI::RESETUNWIND) ( 81 "" 58 "") \SLOWBLTCHAR :D8 -(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORP F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \SCREENBITMAPS) K@@lÿåYAÉ0ZdÉ È Xdjð¢±~€ JÉ_JÉIÐÈØ\JÉñ²l A -¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢± OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W"²-W$´ hA -W&ð_²`È_¿`jÍ¿¿A`ð³hA -W(–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ @ãJÉ h _ ¿HdlZð²;¿AOOØ +(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 20 \SOFTCURSORP F 21 \SOFTCURSORUPP F 22 \CURSORDESTINATION F 23 \SCREENBITMAPS) b@@lÿåYAÉ0ZdÉ È Xdjð¢±~€ JÉ_JÉIÐÈØ\JÉñ²l A +¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢± OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W(²-W*´ hA +W,ð_²`È_¿`jÍ¿¿A`ð³hA +W.–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Î0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ$JÉ É@ãà@ãJÉ +O"O$ÐO&¿O&_ ¿HdlZð²;¿AOOØ ¿O ÉjJÉIÐÈAJÉO È ÙkØOO È O È ØO °Hnð²8AOOÙ ¿O ÉjJÉIÐÈAJÉO È ÙJÉO È -O È ØO ‰o h(583 ERROR 572 BKBITBLT 530 \DSPYPOSITION.DISPLAY 511 BKBITBLT 468 \DSPYPOSITION.DISPLAY 446 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) +O È ØO ‰o h(606 ERROR 595 BKBITBLT 553 \DSPYPOSITION.DISPLAY 534 BKBITBLT 491 \DSPYPOSITION.DISPLAY 453 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) (393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA) -( 578 "Not implemented to rotate by other than 0, 90 or 270") +( 601 "Not implemented to rotate by other than 0, 90 or 270") TEXTUREP :D8 (I 0 OBJECT) @d3 ³ô@Èkð´@NIL (18 BITMAP 10 BITMAP) @@ -278,7 +282,7 @@ OPPOSITESHADE :D8 NIL () \MEDW.BITBLT :D8 -(P 9 A0232 P 8 A0231 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0230 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)  +(P 9 A0188 P 8 A0187 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0186 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)   @ ³C ªo ¿@òZ@²WCi Cgh É0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±–Cô‚±¯C´‚±¨@i !@gh É0AIÉصABIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@ @@ -288,6 +292,25 @@ NIL W–@ ¿KÉ2ÉL KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO‰o i(524 SHOULDNT 418 \TOTOPWDS 408 DSPDESTINATION 345 \GETSTREAM 330 WFROMDS 318 DSPDESTINATION 311 DSPDESTINATION 162 \GETSTREAM 147 WFROMDS 55 \GETSTREAM 43 WFROMDS 24 SHOULDNT 13 IMAGESTREAMP 5 IMAGESTREAMP) (494 \DISPLAYDATA 477 \DISPLAYDATA 451 \DISPLAYDATA 443 WINDOW 432 SCREEN 425 WINDOW 398 \TOPWDS 383 \DISPLAYDATA 367 \DISPLAYDATA 357 \DISPLAYDATA 350 STREAM 339 OUTPUT 284 \DISPLAYDATA 267 \DISPLAYDATA 241 \DISPLAYDATA 233 WINDOW 222 SCREEN 215 WINDOW 200 \DISPLAYDATA 184 \DISPLAYDATA 174 \DISPLAYDATA 167 STREAM 156 OUTPUT 127 BITMAP 92 WINDOW 83 SCREEN 76 WINDOW 67 \DISPLAYDATA 60 STREAM 49 OUTPUT 31 BITMAP) ( 519 "Invalid argument to \XW.BIBLT" 19 "Neither SOURCE nor DESTINATION is an imagestream.") +\READBINARYBITMAP :D8 +(P 3 BITMAP P 2 BPP P 1 BMH P 0 BMW I 0 STREAM) `@g +bd á@ Ø@ á@ Ø@ á@ Ø#HIJ [@KÉKÈIÚlÚMÉ +É>¼MNjOlLK(41 BITMAPCREATE 10 GETSTREAM) +(80 FDEV 73 STREAM 57 BITMAP 49 BITMAP 5 INPUT) +() +\PRINTBINARYBITMAP :D8 +(P 1 BMH P 0 STREAM I 1 STREAM I 0 BITMAP) ­ Ag +q@Ñ@¦@ ¿H@ »ZKã +¿JKlÿå +¿H@ ¹\Iã +¿LIlÿå +¿H@ ¾]Nã +¿MNlÿå +¿H@É@ÈIÚlÚ +OÉ +É@_¿OOjOlO@(112 \BOUT 101 \BOUT 92 BITSPERPIXEL 84 \BOUT 73 \BOUT 64 BITMAPHEIGHT 56 \BOUT 45 \BOUT 36 BITMAPWIDTH 28 \ILLEGAL.ARG 10 GETSTREAM) +(152 FDEV 145 STREAM 128 BITMAP 120 BITMAP 19 BITMAP 5 OUTPUT) +() FINISH-READING-BITMAP :D8 (L (0 STREAM) F 29 *READ-SUPPRESS*) (@ ñ Hd²µoH ¿°íYºI[¼K]µLk¾M_¿J3 šL3 –N3 ’O›oH @@ -414,8 +437,8 @@ JI (RPAQQ \PILOTBBTSCRATCHBM NIL) (MOVD? (QUOTE BITBLT) (QUOTE BKBITBLT)) DISPLAYSTREAMP :D8 -(I 0 X F 0 \DISPLAYSTREAMTYPES) :@ô2@É.ÉP³@É.É…dP¤µùh´@NIL -(39 IMAGEOPS 32 STREAM 20 IMAGEOPS 13 STREAM 5 STREAM) +(I 0 X) B@ô:@É.É`³"@É.ɉd`¤µõh´@NIL +(53 \DISPLAYSTREAMTYPES 43 IMAGEOPS 36 STREAM 27 \DISPLAYSTREAMTYPES 20 IMAGEOPS 13 STREAM 5 STREAM) () DSPSOURCETYPE :D8 (P 1 \INTERRUPTABLE P 0 DD I 1 DISPLAYSTREAM I 0 SOURCETYPE) ŸAgh É0HÉ @²y@gð³@dgð¦l @@ -425,11 +448,11 @@ Q (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT) () DSPXOFFSET :D8 -(P 0 A0244 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) +(P 0 A0202 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPYOFFSET :D8 -(P 0 A0245 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) +(P 0 A0203 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPDESTINATION :D8 @@ -481,20 +504,20 @@ I@A (15 BITMAP 7 ScreenBitMap) () \COMMON.DSPCREATE :D8 -(P 2 DSTRM I 3 OLDDSP I 2 IMAGEOPS I 1 FDEV I 0 DESTINATION F 5 DisplayFDEV F 6 OLDSTREAM F 7 DEFAULTFONT) ÀCµ‚±nl djÏ0¿dg&¿`dj6¿dk.¿dk,¿`dkÏ +(P 2 DSTRM I 3 OLDDSP I 2 IMAGEOPS I 1 FDEV I 0 DESTINATION F 5 DisplayFDEV F 6 OLDSTREAM) ÃCµ‚±ql djÏ0¿dg&¿`dj6¿dk.¿dk,¿`dkÏ ¿HdI*¿dj¿d`¿odnÿdhHdI ¿d`¿dj¿dj¿dj¿dj¿HdI0¿Bµ`HdI.¿AµUHdI ¿dkÏ 0¿dnÿÿÍ5¿`HdIÍ4¿dh2¿dg*¿dg$¿`HdIÍ¿dj¿dj¿dkÏ ¿dkÏ ¿djÍ¿dlÏ¿dh¿djÏ¿HdÉ Éhµg ¿Hdg -¿!WJ +¿!`J @J `@ȼ[Ló²3K°1 ¦C ¿VAµU -¿VBµ`.¿C°¬LJ +¿VBµ`.¿C°©LJ gJ gJ -J(444 DSPOPERATION 433 DSPSOURCETYPE 422 DSPRIGHTMARGIN 381 \ILLEGAL.ARG 374 DISPLAYSTREAMP 347 DSPDESTINATION 340 DSPFONT 328 \SETACCESS 314 \EXTERNALFORMAT) -(438 REPLACE 427 INPUT 409 \DISPLAYIMAGEOPS 401 STREAM 388 STREAM 358 BITMAP 352 SCREENWIDTH 323 OUTPUT 309 :DEFAULT 300 FDEV 233 FILELINELENGTH 225 \STREAM.NOT.OPEN 216 \EOSERROR 195 \STREAM.DEFAULT.MAXBUFFERS 153 \DISPLAYIMAGEOPS 112 ScreenBitMap 78 SCREENWIDTH 50 |PILOTBBTTYPE#| 29 |\DISPLAYDATATYPE#| 21 \DSPPRINTCHAR) +J(447 DSPOPERATION 436 DSPSOURCETYPE 425 DSPRIGHTMARGIN 384 \ILLEGAL.ARG 377 DISPLAYSTREAMP 350 DSPDESTINATION 343 DSPFONT 328 \SETACCESS 314 \EXTERNALFORMAT) +(441 REPLACE 430 INPUT 412 \DISPLAYIMAGEOPS 404 STREAM 391 STREAM 361 BITMAP 355 SCREENWIDTH 337 DEFAULTFONT 323 OUTPUT 309 :DEFAULT 300 FDEV 233 FILELINELENGTH 225 \STREAM.NOT.OPEN 216 \EOSERROR 195 \STREAM.DEFAULT.MAXBUFFERS 153 \DISPLAYIMAGEOPS 112 ScreenBitMap 78 SCREENWIDTH 50 |PILOTBBTTYPE#| 29 |\DISPLAYDATATYPE#| 21 \DSPPRINTCHAR) ( 86 -16383) (MOVD? (QUOTE \SIMPLE.DSPCREATE) (QUOTE DSPCREATE)) \MEDW.XOFFSET :D8 @@ -514,11 +537,11 @@ A (23 \DISPLAYDATA 16 STREAM 5 OUTPUT) ( 63 " is not a REGION.") \DSPFONT.DISPLAY :D8 -(P 3 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) {0@É0ZdÉ YA²cA@i µJÉ giA -µ o XIð³7JH ¿JjHÈ -Ù¿JHÉɵ -jHh ÉÈ ÍA¿@J -(119 \SFFixFont 105 \CREATECHARSET 62 ERROR 50 FONTCOPY 31 \COERCEFONTDESC) +(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) ‚@@É0ZdÉ YA²jA@i µJÉ giA +µ o XIð³>JH ¿JjHÈ +Ù¿JHÉɵHÉjH +[¿KÉÈ ÍA¿@J +(126 \SFFixFont 107 \CREATECHARSET 62 ERROR 50 FONTCOPY 31 \COERCEFONTDESC) (83 FONTDESCRIPTOR 41 NOERROR 17 \DISPLAYDATA 8 STREAM) ( 57 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") \DISPLAY.PILOTBITBLT :D8 @@ -563,14 +586,13 @@ Q (RPAQ? \SCREENBITMAPS) (MOVD? (QUOTE NILL) (QUOTE \TOTOPWDS)) TTYDISPLAYSTREAM :D8 -(P 3 DD P 2 WIN P 0 \INTERRUPTABLE I 0 DISPLAYSTREAM F 4 \TERM.OFD F 5 \LINEBUF.OFD F 6 *STANDARD-OUTPUT* F 7 *STANDARD-INPUT* F 8 \DISPLAYSTREAMTYPES F 9 TtyDisplayStream) T@¢± -@gh b ³g –@ ¦@ ¿ @dTð’±…¿Tµ VTð²8@c °4`ð³ð`–h ¿Ti +(P 3 DD P 2 WIN P 0 \INTERRUPTABLE I 0 DISPLAYSTREAM F 4 \TERM.OFD F 5 \LINEBUF.OFD F 6 *STANDARD-OUTPUT* F 7 *STANDARD-INPUT* F 8 TtyDisplayStream) T@¢± @gh b ³g –@ ¦@ ¿ @dTð’±…¿Tµ VTð²8@c °4`ð³ð`–h ¿Ti JœJgU ¿°Ç@c¿WU@i Z² Jg` ¿Jg µc -ð“Uc¿@c W²Cg@ -¿@É0[È%KÈ$ÙKɹjIñ¡I‚jIÙÛ (266 PAGEHEIGHT 213 DSPSCROLL 197 IMAGESTREAMTYPE 180 \CREATELINEBUFFER 173 GETWINDOWUSERPROP 161 PUTWINDOWPROP 142 WFROMDS 121 PUTWINDOWPROP 104 WFROMDS 96 \CARET.DOWN 50 \ILLEGAL.ARG 43 TEXTSTREAMP 36 \DEFINEDP 24 DISPLAYSTREAMP 17 \GETSTREAM) -(248 \DISPLAYDATA 239 \DISPLAYDATA 231 \DISPLAYDATA 223 STREAM 207 ON 168 \LINEBUF.OFD 156 \RUNNING.PROCESS 151 PROCESS 115 \LINEBUF.OFD 89 \CARET.UP 81 \DEFAULTTTYDISPLAYSTREAM 31 TEXTSTREAMP 11 OUTPUT) +ð“Uc¿@c `²Cg@ +¿@É0[È%KÈ$ÙKɹjIñ¡I‚jIÙÛ (269 PAGEHEIGHT 216 DSPSCROLL 197 IMAGESTREAMTYPE 180 \CREATELINEBUFFER 173 GETWINDOWUSERPROP 161 PUTWINDOWPROP 142 WFROMDS 121 PUTWINDOWPROP 104 WFROMDS 96 \CARET.DOWN 50 \ILLEGAL.ARG 43 TEXTSTREAMP 36 \DEFINEDP 24 DISPLAYSTREAMP 17 \GETSTREAM) +(251 \DISPLAYDATA 242 \DISPLAYDATA 234 \DISPLAYDATA 226 STREAM 210 ON 202 \DISPLAYSTREAMTYPES 168 \LINEBUF.OFD 156 \RUNNING.PROCESS 151 PROCESS 115 \LINEBUF.OFD 89 \CARET.UP 81 \DEFAULTTTYDISPLAYSTREAM 31 TEXTSTREAMP 11 OUTPUT) () optimize-TTYDISPLAYSTREAM :D8 (L (2 $$CTX 1 $$ENV 0 $$WHOLE)) @¥ggNIL @@ -785,11 +807,11 @@ NIL (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted)) (ADDTOVAR GLOBALVARS WHOLESCREEN) INITIALIZEDISPLAYSTREAMS :D8 -(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Uodnÿdh`ld +(F 0 \GUARANTEEDDISPLAYFONT) Xodnÿdh`ld gl hdg cgkPh -c(80 FONTCLASS 63 FONTCREATE 38 BITMAPCREATE) -(70 DEFAULTFONT 57 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) +(80 FONTCLASS 63 FONTCREATE 38 BITMAPCREATE) +(85 DEFAULTFONT 70 DEFAULTFONT 57 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) ( 4 -16383) (RPAQQ \DisplayStarted NIL) (RPAQQ \LastTTYLines 12) diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT new file mode 100644 index 000000000..04b969909 --- /dev/null +++ b/sources/MEDLEYFONTFORMAT @@ -0,0 +1,796 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "10-Jun-2025 20:57:44" {WMEDLEY}MEDLEYFONTFORMAT.;173 49035 + + :EDIT-BY rmk + + :CHANGES-TO (FNS MEDLEYFONT.READ.ITEM MEDLEYFONT.WRITE.FONTPROPS MEDLEYFONT.READ.VERIFIEDFONT + MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET) + + :PREVIOUS-DATE "10-Jun-2025 11:34:15" {WMEDLEY}MEDLEYFONTFORMAT.;169) + + +(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) + +(RPAQQ MEDLEYFONTFORMATCOMS + [ + (* ;; "Eventually, MEDLEYFONT should be a package") + + + (* ;; "Main public entries") + + (FNS MEDLEYFONT.WRITE.FONT MEDLEYFONT.GETCHARSET MEDLEYFONT.CHARSET? MEDLEYFONT.GETFILEPROP + MEDLEYFONT.FILEP) + + (* ;; "Reading") + + (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.READ.CHARSET MEDLEYFONT.READ.ITEM + MEDLEYFONT.READ.FONTPROPS MEDLEYFONT.READ.VERIFIEDFONT) + + (* ;; "Writing") + + (FNS MEDLEYFONT.WRITE.CHARSET MEDLEYFONT.WRITE.ITEM MEDLEYFONT.WRITE.FONTPROPS + MEDLEYFONT.WRITE.HEADER) + (FNS MEDLEYFONT.FILENAME) + (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) + (INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT)) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (PRINTDATA 0) + (SMALLPDATA 1) + (BITMAPDATA 2) + (WORDBLOCKDATA 3) + (CLARRAYDATA 4) + (FIXPDATA 5) + (ILARRAYDATA 6) + (HPRINTDATA 7) + (ALISTDATA 8) + (PLISTDATA 9) + (LISTDATA 10]) + + + +(* ;; "Eventually, MEDLEYFONT should be a package") + + + + +(* ;; "Main public entries") + +(DEFINEQ + +(MEDLEYFONT.WRITE.FONT + [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS) (* ; "Edited 9-Jun-2025 12:17 by rmk") + (* ; "Edited 25-May-2025 20:48 by rmk") + (* ; "Edited 23-May-2025 14:59 by rmk") + (* ; "Edited 22-May-2025 09:58 by rmk") + (* ; "Edited 16-May-2025 20:17 by rmk") + (* ; "Edited 14-May-2025 17:45 by rmk") + (SETQ FONT (FONTCREATE FONT)) + (CL:UNLESS FILE + (SETQ FILE (MEDLEYFONT.FILENAME FONT CHARSETNOS))) + (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS) + (LET ((CHARSETLOCS (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT 0)) + (FONTCHARENCODING (FONTPROP FONT 'CHARENCODING)) + (*READTABLE* (FIND-READTABLE "INTERLISP")) + CSVECTORPTRLOC CSVECTORLOC FILECHARSETS) + + (* ;; "Figure out the actual non empty/sluggish charsets that will be wrtitten.") + + (SETQ FILECHARSETS (for CSNO CSINFO from 0 to \MAXCHARSET + when (OR (NULL CHARSETNOS) + (MEMB CSNO CHARSETNOS)) + when (SETQ CSINFO (\XGETCHARSETINFO FONT CSNO)) + unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CSNO)) + + (* ;; "Right after the header, leave 4 bytes for the pointer to the charset dispatch vector. If writing a single charset, we store the negative of the byte location so we can still easily skip the font properties without writing the whole vector.") + + (* ;; "") + + (SETQ CSVECTORPTRLOC (GETFILEPTR STREAM)) (* ; + "Ptr is before fontproperties, vector is after") + (\FIXPOUT STREAM 0) + (MEDLEYFONT.WRITE.ITEM STREAM 'FILECHARSETS (OR CHARSETNOS 'ALL)) + (MEDLEYFONT.WRITE.FONTPROPS STREAM FONT) + (CL:WHEN (CDR FILECHARSETS) (* ; + "Allocate the vector space if multiple") + (PRINTOUT STREAM "CHARSET LOCATIONS" T) + (SETQ CSVECTORLOC (GETFILEPTR STREAM)) + (for I from 0 to \MAXCHARSET do (\FIXPOUT STREAM 0)) + (TERPRI STREAM)) + (for CSNO in FILECHARSETS do + (* ;; + "LOC remains zero for missing charsets, slug properties are determined by font-level properties.") + + (CL:SETF (CL:SVREF CHARSETLOCS CSNO) + (GETFILEPTR STREAM)) + (MEDLEYFONT.WRITE.CHARSET FONT CSNO STREAM + FONTCHARENCODING)) + (CL:WHEN FILECHARSETS (* ; + "An empty font? Cause an error? Print a message?") + [if (CDR FILECHARSETS) + then + (* ;; "More than one, fill in the vector") + + (SETFILEPTR STREAM CSVECTORLOC) + (for CSNO from 0 to \MAXCHARSET do (\FIXPOUT STREAM (CL:SVREF + CHARSETLOCS + CSNO))) + else + (* ;; + "Minus means direct for one charset, no need for the dispatch vector.") + + (SETQ CSVECTORLOC (IMINUS (CL:SVREF CHARSETLOCS (CAR FILECHARSETS]) + (SETFILEPTR STREAM CSVECTORPTRLOC) + (\FIXPOUT STREAM (OR CSVECTORLOC 0)) (* ; + "Pointer to the charset dispatch vector--or negative of actual location for a singleton") + (FULLNAME STREAM]) + +(MEDLEYFONT.GETCHARSET + [LAMBDA (STREAM FAMILY SIZE FACE ROTATION DEVICE CHARSET) (* ; "Edited 10-Jun-2025 17:59 by rmk") + (* ; "Edited 25-May-2025 20:52 by rmk") + (* ; "Edited 21-May-2025 11:35 by rmk") + (* ; "Edited 17-May-2025 00:45 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + + (* ;; "Assume that the initial Me etc. has been checked, and we are positioned after the header information") + + (RESETLST + (CL:UNLESS (OPENSTREAM STREAM 'INPUT) + [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + [PROG ((CSVECTORLOC (\FIXPIN STREAM)) + (FILECHARSETS (MEDLEYFONT.READ.ITEM STREAM 'FILECHARSETS)) + FONTPROPS CSLOC) + (CL:UNLESS (OR (EQ FILECHARSETS 'ALL) + (MEMB CHARSET FILECHARSETS)) + (RETURN NIL)) + + (* ;; "We know now that this file has information about the requested charset, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") + + (SETQ FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) + (if (ILESSP CSVECTORLOC 0) + then + (* ;; "File contains only one charset and it's the one we want. If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + else + (* ;; "The vector-entry points to the one we want") + + (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL))) + (CL:WHEN (EQ 0 (SETQ CSLOC (\FIXPIN STREAM))) + (RETURN NIL)) + (SETFILEPTR STREAM CSLOC)) + (RETURN (CADR (MEDLEYFONT.READ.CHARSET STREAM])]) + +(MEDLEYFONT.CHARSET? + [LAMBDA (FILE CHARSET) (* ; "Edited 25-May-2025 20:53 by rmk") + (* ; "Edited 21-May-2025 11:35 by rmk") + (* ; "Edited 17-May-2025 11:29 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + + (* ;; "If CHARSET, returns T if FILE contains a non-slug entry for CHARSET. If not CHARSET, returns the list of non-slug charsets in FILE.") + + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (CL:UNLESS (MEDLEYFONT.FILEP STREAM) + (ERROR "Not a MEDLEYFONT file" FILE)) + (LET [(CSVECTORLOC (\FIXPIN STREAM)) + (FILECHARSETS (MEDLEYFONT.READ.ITEM STREAM 'FILECHARSETS] + (if (EQ FILECHARSETS 'ALL) + then (if CHARSET + then (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL) + )) + (NEQ 0 (\FIXPIN STREAM)) + else (SETFILEPTR STREAM CSVECTORLOC) + (for CS from 0 to \MAXCHARSET unless (EQ 0 (\FIXPIN STREAM)) + collect CS)) + elseif CHARSET + then (MEMB CHARSET FILECHARSETS]) + +(MEDLEYFONT.GETFILEPROP + [LAMBDA (FILE PROP) (* ; "Edited 25-May-2025 20:53 by rmk") + (* ; "Edited 21-May-2025 11:36 by rmk") + (* ; "Edited 17-May-2025 19:07 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (LET (HEADERPROPS CSVECTORLOC FILECHARSETS) + (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM)) + (ERROR "Not a MEDLEYFONT file" FILE)) + (SETQ CSVECTORLOC (\FIXPIN STREAM)) + (SETQ FILECHARSETS (MEDLEYFONT.READ.ITEM STREAM 'FILECHARSETS)) + (SELECTQ PROP + (OTHERPROPS (CDDR HEADERPROPS)) + (DATE (CADR HEADERPROPS)) + (FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) + (CHARSETS (if (EQ FILECHARSETS 'ALL) + then (SETFILEPTR STREAM CSVECTORLOC) + (for CS from 0 to \MAXCHARSET unless (EQ 0 (\FIXPIN STREAM)) + collect CS) + else FILECHARSETS)) + (ERROR "Unknown MEDLEYFONT property"]) + +(MEDLEYFONT.FILEP + [LAMBDA (FILE) (* ; "Edited 10-Jun-2025 18:19 by rmk") + (* ; "Edited 8-Jun-2025 22:55 by rmk") + (* ; "Edited 25-May-2025 20:54 by rmk") + (* ; "Edited 21-May-2025 11:37 by rmk") + (* ; "Edited 16-May-2025 21:58 by rmk") + (* ; "Edited 14-May-2025 17:00 by rmk") + + (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others. This may be called after the first 2 bytes have been read to verify the %"Me%", if not we skip over it here.") + + (* ;; "For a valid file, returns (fullname date)") + + (* ;; "If FILE is an open stream, it is left open. Otherwise it is opened and closed.") + + (RESETLST + [LET (STREAM VERSION DATE) + [if (\GETSTREAM FILE 'INPUT T) + then (SETQ STREAM FILE) + else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CL:UNLESS (ZEROP (GETFILEPTR STREAM)) + (SETFILEPTR STREAM 0)) + (CL:WHEN (for C in (CONSTANT (CHCON "Medley font")) always (EQ C (READCCODE STREAM))) + [CAR (NLSETQ [CL:WHEN (EQ 0 (SETQ VERSION (MEDLEYFONT.READ.ITEM STREAM 'VERSION] + `(,(FULLNAME STREAM) + ,(MEDLEYFONT.READ.ITEM STREAM 'DATE) + ,VERSION + ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) +) + + + +(* ;; "Reading") + +(DEFINEQ + +(MEDLEYFONT.READ.FONT + [LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 10-Jun-2025 11:34 by rmk") + (* ; "Edited 25-May-2025 20:54 by rmk") + (* ; "Edited 24-May-2025 08:24 by rmk") + (* ; "Edited 21-May-2025 22:59 by rmk") + (* ; "Edited 19-May-2025 18:01 by rmk") + (* ; "Edited 16-May-2025 20:23 by rmk") + (* ; "Edited 14-May-2025 17:46 by rmk") + (CL:UNLESS FILE (SETQ FILE FONT)) + (CL:WHEN (OR (type? FONTDESCRIPTOR FILE) + (LISTP FILE)) + (SETQ FILE (MEDLEYFONT.FILENAME FILE))) + (CL:WITH-OPEN-FILE + (STREAM FILE :DIRECTION :INPUT) + (CL:UNLESS (MEDLEYFONT.FILEP STREAM) + (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))) + (LET ((*READTABLE* (FIND-READTABLE "INTERLISP")) + FONTCHARSETVECTOR CSVECTORLOC FILECHARSETS) + (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) (* ; "The request") + (SETQ CSVECTORLOC (\FIXPIN STREAM)) (* ; + "Byte location of the charset dispatch vector") + (SETQ FILECHARSETS (MEDLEYFONT.READ.ITEM STREAM 'FILECHARSETS)) + (CL:UNLESS (OR (EQ FILECHARSETS 'ALL) + (NULL (LDIFFERENCE CHARSETNOS FILECHARSETS))) + [ERROR FILE (CONCAT " does not contain information for charsets " + (SORT (LDIFFERENCE CHARSETNOS FILECHARSETS]) + + (* ;; "We know now that this file has information about all requested charsets, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") + + (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT)) + (SETQ FONTCHARSETVECTOR (fetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT)) + (CL:UNLESS (EQ CSVECTORLOC 0) (* ; "Not empty") + [if (ILESSP CSVECTORLOC 0) + then + (* ;; "File contains only one charset and it's the one we want. If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") + + (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) + (\SETCHARSETINFO FONTCHARSETVECTOR (CAR CHARSETNOS) + (CADR (MEDLEYFONT.READ.CHARSET STREAM FONT))) + else + (* ;; "Gather all of the CSLOCS before reading, so that we always move forward") + + (for CSNO CSLOC inside (OR CHARSETNOS (for I from 0 to \MAXCHARSET collect + I)) + eachtime (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CSNO BYTESPERCELL))) + (SETQ CSLOC (\FIXPIN STREAM)) unless (ZEROP CSLOC) + collect (CONS CSNO CSLOC) + finally (for X CS in $$VAL + do (SETQ CSNO (CAR X)) + (SETFILEPTR STREAM (CDR X)) + (SETQ CS (MEDLEYFONT.READ.CHARSET STREAM)) + (CL:WHEN CS + (CL:UNLESS (EQ CSNO (CAR CS)) + (ERROR "MISMATCHED CHARSET NUMBERS" (LIST CSNO + (CAR CS))))) + (\SETCHARSETINFO FONTCHARSETVECTOR CSNO (CADR CS]) + FONT]) + +(MEDLEYFONT.READ.CHARSET + [LAMBDA (STREAM) (* ; "Edited 25-May-2025 20:54 by rmk") + (* ; "Edited 23-May-2025 11:01 by rmk") + (* ; "Edited 21-May-2025 16:25 by rmk") + (* ; "Edited 16-May-2025 20:19 by rmk") + (* ; "Edited 14-May-2025 10:43 by rmk") + (* ; "Edited 12-May-2025 07:55 by rmk") + (LET (CHARSETNO CSINFO) + (MEDLEYFONT.READ.ITEM STREAM 'CHARSETSTRING) (* ; + "Throwaway for looking with text editor") + (SETQ CHARSETNO (MEDLEYFONT.READ.ITEM STREAM 'CHARSETNO)) + (SETQ CSINFO (create CHARSETINFO + WIDTHS _ NIL + OFFSETS _ NIL)) (* ; + "Wait until we see the vectors, like the others") + (bind PAIR LABEL DATA eachtime (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM)) + (SETQ LABEL (CAR PAIR)) + (SETQ DATA (CADR PAIR)) until (EQ LABEL 'STOP) + do (SELECTQ LABEL + (WIDTHS (replace (CHARSETINFO WIDTHS) of CSINFO with DATA)) + (OFFSETS (replace (CHARSETINFO OFFSETS) of CSINFO with DATA)) + (IMAGEWIDTHS (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with DATA)) + (YWIDTHS (replace (CHARSETINFO YWIDTHS) of CSINFO with DATA)) + (ASCENT (replace (CHARSETINFO CHARSETASCENT) of CSINFO with DATA)) + (DESCENT (replace (CHARSETINFO CHARSETDESCENT) of CSINFO with DATA)) + (LEFTKERN (replace (CHARSETINFO LEFTKERN) of CSINFO with DATA)) + (BITMAP (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with DATA)) + (CSINFOPROPS (replace (CHARSETINFO CSINFOPROPS) of CSINFO with DATA)) + (CSCOMPLETEP (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with DATA)) + (SHOULDNT "Unrecognized charsetinfo label'"))) + (CL:UNLESS (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO) + (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO WIDTHS) + of CSINFO))) + (LIST CHARSETNO CSINFO]) + +(MEDLEYFONT.READ.ITEM + [LAMBDA (STREAM LABEL?) (* ; "Edited 10-Jun-2025 20:10 by rmk") + (* ; "Edited 25-May-2025 20:55 by rmk") + (* ; "Edited 23-May-2025 10:57 by rmk") + (* ; "Edited 21-May-2025 23:12 by rmk") + (* ; "Edited 17-May-2025 10:12 by rmk") + (* ; "Edited 13-May-2025 11:36 by rmk") + + (* ;; "Reads and returns the (label data) that starts at the current position in STREAM according to its storage type. If LABEL? is provided, error if the data read does not have that label. ") + + (LET ((*READTABLE* (FIND-READTABLE 'INTERLISP)) + LABEL ITEM NWORDS NELTS) + (SETQ LABEL (RATOM STREAM)) + (CL:WHEN (AND LABEL? (NEQ LABEL? LABEL)) + (ERROR (CONCAT LABEL? " data not found") + LABEL)) + (READCCODE STREAM) + (SETQ ITEM (SELECTC (BIN STREAM) + (SMALLPDATA (\WIN STREAM)) + (FIXPDATA (\FIXPIN STREAM)) + (PRINTDATA (READ STREAM)) + (ALISTDATA (bind X until [EQ 'STOP (CAR (SETQ X (MEDLEYFONT.READ.ITEM STREAM] + collect (CONS (CAR X) + (CADR X)))) + (PLISTDATA (bind X until [EQ 'STOP (CAR (SETQ X (MEDLEYFONT.READ.ITEM STREAM] + join X)) + (LISTDATA (bind ELT until [EQ 'STOP (CAR (SETQ ELT (MEDLEYFONT.READ.ITEM + STREAM] + collect (CADR ELT) finally (CL:WHEN (CADR ELT) + (NCONC $$VAL ELT)))) + (BITMAPDATA (\READBINARYBITMAP STREAM)) + (CLARRAYDATA (LET [[ARRAY (CL:MAKE-ARRAY (READ STREAM) + :ELEMENT-TYPE + (MEDLEYFONT.READ.ITEM STREAM 'ELEMENT-TYPE] + (ALLFIXED (EQ 1 (BIN STREAM] + (for I from 0 to (\FIXPIN STREAM) + do [CL:SETF (XCL:ROW-MAJOR-AREF ARRAY I) + (CL:IF ALLFIXED + (\FIXPIN STREAM) + (CADR (MEDLEYFONT.READ.ITEM STREAM)))] + finally (RETURN ARRAY)))) + (ILARRAYDATA (LET [(NELTS (\FIXPIN STREAM)) + (ORIG (BIN STREAM)) + (ALLFIXED (EQ 1 (BIN STREAM] + (for I (ARRAY _ (ARRAY NELTS NIL ORIG)) from ORIG + to (CL:IF (EQ ORIG 1) + NELTS + (SUB1 NELTS)) + do (SETA ARRAY I (CL:IF ALLFIXED + (\FIXPIN STREAM) + (MEDLEYFONT.READ.ITEM STREAM I))) + finally (RETURN ARRAY)))) + (WORDBLOCKDATA (SETQ NWORDS (\FIXPIN STREAM)) + (for I (BLOCK _ (\ALLOCBLOCK (FOLDHI NWORDS WORDSPERCELL))) + from 0 to (SUB1 NWORDS) do (\PUTBASE BLOCK I (\WIN STREAM)) + finally (RETURN BLOCK))) + (HPRINTDATA (HREAD STREAM)) + (SHOULDNT "UNKNOWN MEDLEYFONT DATA TYPE"))) + (READCCODE STREAM) (* ; "Skip the EOL") + (CL:IF LABEL? + ITEM + (LIST LABEL ITEM))]) + +(MEDLEYFONT.READ.FONTPROPS + [LAMBDA (STREAM) (* ; "Edited 25-May-2025 20:55 by rmk") + (* ; "Edited 16-May-2025 21:58 by rmk") + (* ; "Edited 14-May-2025 09:11 by rmk") + (bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR]) + +(MEDLEYFONT.READ.VERIFIEDFONT + [LAMBDA (STREAM FONT) (* ; "Edited 10-Jun-2025 20:57 by rmk") + (* ; "Edited 21-May-2025 22:55 by rmk") + (* ; "Edited 19-May-2025 17:42 by rmk") + (* ; "Edited 16-May-2025 10:28 by rmk") + (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM))) + [if FONT + then (* ; "compare/verify") + (for P in FONTPROPS unless (EQUAL (CADR P) + (RECORDACCESS (CAR P) + FONT NIL 'FETCH)) + do (ERROR "Mismatching font property" P)) + else (SETQ FONT (create FONTDESCRIPTOR)) (* ; "Construct") + (for P VAL in FONTPROPS do (SETQ VAL (CADR P)) + (SELECTQ (CAR P) + (FONTDEVICE (replace (FONTDESCRIPTOR FONTDEVICE) + of FONT with VAL)) + (FONTCOMPLETEP (replace (FONTDESCRIPTOR FONTCOMPLETEP) + of FONT with VAL)) + (FONTFAMILY (replace (FONTDESCRIPTOR FONTFAMILY) + of FONT with VAL)) + (FONTSIZE (replace (FONTDESCRIPTOR FONTSIZE) + of FONT with VAL)) + (FONTFACE (replace (FONTDESCRIPTOR FONTFACE) + of FONT with VAL)) + (\SFAscent (replace (FONTDESCRIPTOR \SFAscent) + of FONT with VAL)) + (\SFDescent (replace (FONTDESCRIPTOR \SFDescent) + of FONT with VAL)) + (\SFHeight (replace (FONTDESCRIPTOR \SFHeight) + of FONT with VAL)) + (ROTATION (replace (FONTDESCRIPTOR ROTATION) + of FONT with VAL)) + (FONTDEVICESPEC + (replace (FONTDESCRIPTOR FONTDEVICESPEC) + of FONT with VAL)) + (OTHERDEVICEFONTPROPS + (replace (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) + of FONT with VAL)) + (FONTSCALE (replace (FONTDESCRIPTOR FONTSCALE) + of FONT with VAL)) + (\SFFACECODE (replace (FONTDESCRIPTOR \SFFACECODE) + of FONT with VAL)) + (FONTAVGCHARWIDTH + (replace (FONTDESCRIPTOR FONTAVGCHARWIDTH) + of FONT with VAL)) + (FONTCHARENCODING + (replace (FONTDESCRIPTOR FONTCHARENCODING) + of FONT with VAL)) + (FONTCHARSETVECTOR + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) + of FONT with VAL)) + (FONTHASLEFTKERNS + (replace (FONTDESCRIPTOR FONTHASLEFTKERNS) + of FONT with VAL)) + (FONTEXTRAFIELD2 + (replace (FONTDESCRIPTOR FONTEXTRAFIELD2) + of FONT with VAL)) + (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"] + FONT]) +) + + + +(* ;; "Writing") + +(DEFINEQ + +(MEDLEYFONT.WRITE.CHARSET + [LAMBDA (FONT CHARSETNO STREAM FONTCHARENCODING) (* ; "Edited 25-May-2025 20:49 by rmk") + (* ; "Edited 22-May-2025 09:58 by rmk") + (* ; "Edited 16-May-2025 20:18 by rmk") + (* ; "Edited 13-May-2025 23:26 by rmk") + + (* ;; "This outputs") + + (LET ((CSINFO (\INSURECHARSETINFO CHARSETNO FONT)) + CSCHARENCODING) + (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSETSTRING (MKSTRING CHARSETNO)) + (* ; "For human file-scan") + (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSETNO CHARSETNO) + (CL:UNLESS (OR (NULL CSINFO) + (fetch (CHARSETINFO CSSLUGP) of CSINFO)) + (* ; + "Slug info is determined by FONT properties") + + (* ;; "Copy the fonts charencoding down to each charset info so that it is availble when the charsetinfo is read. The fontdescriptor isn't available at that point and coercion could lead to fonts of different encodings. At least this would make it possible to fix things up.") + + (SETQ CSCHARENCODING (ASSOC 'CSCHARENCODING (fetch (CHARSETINFO CSINFOPROPS) + of CSINFO))) + (if (EQ FONTCHARENCODING (CDR CSCHARENCODING)) + elseif (NULL CSCHARENCODING) + then (CL:WHEN FONTCHARENCODING + (push (fetch (CHARSETINFO CSINFOPROPS) of CSINFO) + (CONS 'CSCHARENCODING FONTCHARENCODING))) + elseif FONTCHARENCODING + then (ERROR "Charencoding of character set " CHARSETNO + " disagrees with font charencoding")) + (CL:WHEN (fetch (CHARSETINFO CSINFOPROPS) of CSINFO) + (MEDLEYFONT.WRITE.ITEM STREAM 'CSINFOPROPS (fetch (CHARSETINFO CSINFOPROPS) + of CSINFO) + NIL + 'ALIST)) + (MEDLEYFONT.WRITE.ITEM STREAM 'WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (CL:UNLESS [OR (EQ (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO) + (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (for I (W _ (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (IM _ (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) from 0 + to (SUB1 (IPLUS \MAXTHINCHAR 3)) always (EQ (\GETBASE W I) + (\GETBASE IM I] + (MEDLEYFONT.WRITE.ITEM STREAM 'IMAGEWIDTHS (fetch (CHARSETINFO IMAGEWIDTHS) + of CSINFO))) + (MEDLEYFONT.WRITE.ITEM STREAM 'OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'YWIDTHS (fetch (CHARSETINFO YWIDTHS) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'ASCENT (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'DESCENT (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'LEFTKERN (fetch (CHARSETINFO LEFTKERN) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'BITMAP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) + (MEDLEYFONT.WRITE.ITEM STREAM 'CSCOMPLETEP (fetch (CHARSETINFO CSCOMPLETEP) of CSINFO))) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T]) + +(MEDLEYFONT.WRITE.ITEM + [LAMBDA (STREAM LABEL ITEM EVENIFNIL TYPE BLOCKNELTS) (* ; "Edited 8-Jun-2025 21:14 by rmk") + (* ; "Edited 25-May-2025 20:48 by rmk") + (* ; "Edited 23-May-2025 10:58 by rmk") + (* ; "Edited 22-May-2025 10:31 by rmk") + (* ; "Edited 17-May-2025 10:10 by rmk") + (* ; "Edited 14-May-2025 00:07 by rmk") + + (* ;; "Writes ITEM preceded by LABEL. BLOCKNELTS overrides the default for array blocks, because of the uncertainty/complexity in determining arrayblock length.") + + (CL:WHEN (OR ITEM EVENIFNIL) + (PRIN2 LABEL STREAM (FIND-READTABLE "INTERLISP")) + (PRIN1 " " STREAM) + (SELECTQ (OR TYPE (TYPENAME ITEM)) + (SMALLP (BOUT STREAM SMALLPDATA) + (\WOUT STREAM ITEM)) + (FIXP (* ; "Must come after SMALLP") + (BOUT STREAM FIXPDATA) + (\FIXPOUT STREAM ITEM)) + ((LITATOM STRINGP PRINT) + (BOUT STREAM PRINTDATA) (* ; + "A printable Lisp object, even a list") + (PRIN2 ITEM STREAM (FIND-READTABLE 'INTERLISP))) + (ALIST + (* ;; + " This could be done as LISTDATA, but this way it uses the alist keys as labels.") + + (BOUT STREAM ALISTDATA) + (for X KEY in ITEM do (SETQ KEY (CAR X)) + (CL:UNLESS (OR (LITATOM KEY) + (SMALLP KEY)) + (ERROR "NOT AN ALIST" ITEM)) + (MEDLEYFONT.WRITE.ITEM STREAM KEY (CDR X) + EVENIFNIL)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T)) + (PLIST (BOUT STREAM PLISTDATA) + (for DTAIL KEY on ITEM by (CDDR DTAIL) do (SETQ KEY (CAR DTAIL)) + (CL:UNLESS (OR (LITATOM KEY) + (SMALLP KEY)) + (ERROR "NOT A PLIST" ITEM)) + (MEDLEYFONT.WRITE.ITEM STREAM KEY + (CADR DTAIL) + EVENIFNIL)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T)) + (LISTP (BOUT STREAM LISTDATA) + (for TAIL on ITEM as I from 1 do (MEDLEYFONT.WRITE.ITEM STREAM I (CAR TAIL) + T) + (CL:UNLESS (LISTP (CDR TAIL)) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP + (CDR TAIL) + T) + (RETURN)))) + (BITMAP (BOUT STREAM BITMAPDATA) + (\PRINTBINARYBITMAP ITEM STREAM)) + ((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY) + (BOUT STREAM CLARRAYDATA) + (PRIN2 (CL:ARRAY-DIMENSIONS ITEM) + STREAM) + (MEDLEYFONT.WRITE.ITEM STREAM 'ELEMENT-TYPE (CL:ARRAY-ELEMENT-TYPE ITEM)) + (for I ALLFIXED ELT from 0 to (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM)) + first [SETQ ALLFIXED (for I from 0 to (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM)) + always (FIXP (XCL:ROW-MAJOR-AREF ITEM I] + (BOUT STREAM (CL:IF ALLFIXED + 1 + 0)) + (\FIXPOUT STREAM (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM))) + do (SETQ ELT (XCL:ROW-MAJOR-AREF ITEM I)) + (CL:IF ALLFIXED + (\FIXPOUT STREAM ELT) + (MEDLEYFONT.WRITE.ITEM STREAM I ELT T)))) + (ARRAYP (BOUT STREAM ILARRAYDATA) + (\FIXPOUT STREAM (ARRAYSIZE ITEM)) + (BOUT STREAM (ARRAYORIG ITEM)) + (for I ALLFIXED from (ARRAYORIG ITEM) to (IDIFFERENCE (ARRAYSIZE ITEM) + (ARRAYORIG ITEM)) + first [SETQ ALLFIXED (for I from 1 to (ARRAYSIZE ITEM) + always (FIXP (ELT ITEM I] + (BOUT STREAM (CL:IF ALLFIXED + 1 + 0)) do (CL:IF ALLFIXED + (\FIXPOUT STREAM (ELT ITEM I)) + (MEDLEYFONT.WRITE.ITEM STREAM I + (ELT ITEM I) + T)))) + (if (\BLOCKDATAP ITEM) + then + (* ;; "This assumes word-element blocks. We can distinguish pointer blocks (from the DTD, see BLOCKEQUALP), caller would have to tell us (a different TYPE?) whether we are looking at full integer or word blocks--how to interpret NELTS") + + (BOUT STREAM WORDBLOCKDATA) + (CL:UNLESS BLOCKNELTS (* ; "Why 3 ?") + (SETQ BLOCKNELTS (IPLUS \MAXTHINCHAR 3))) + (\FIXPOUT STREAM BLOCKNELTS) + (for I from 0 to (SUB1 BLOCKNELTS) do (\WOUT STREAM (\GETBASE ITEM I))) + else (BOUT STREAM HPRINTDATA) (* ; "A datatype?") + (HPRINT ITEM STREAM T T))) + + (* ;; "Terpri to make sure ratom is OK, also looks better") + + (TERPRI STREAM))]) + +(MEDLEYFONT.WRITE.FONTPROPS + [LAMBDA (STREAM FONT) (* ; "Edited 10-Jun-2025 20:50 by rmk") + (* ; "Edited 25-May-2025 20:50 by rmk") + (* ; "Edited 22-May-2025 10:31 by rmk") + (* ; "Edited 19-May-2025 10:42 by rmk") + (* ; "Edited 14-May-2025 17:26 by rmk") + + (* ;; "RECORDFIELDACCESS would be more succinct but would depend on runtime availability of the record. If the record changes, this and the reader have to be updated.") + + (* ;; "HPRINT would be obvious, but it would get charsetvector etc.") + + (* ;; "Exclude FONTCHARSETVECTOR and \SFFACECODE") + + (* ;; "Write even NIL values for default overerides") + + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTDEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCOMPLETEP (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTFAMILY (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTFACE (fetch (FONTDESCRIPTOR FONTFACE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFAscent (fetch (FONTDESCRIPTOR \SFAscent) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFDescent (fetch (FONTDESCRIPTOR \SFDescent) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM '\SFHeight (fetch (FONTDESCRIPTOR \SFHeight) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTDEVICESPEC (fetch (FONTDESCRIPTOR FONTDEVICESPEC) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'OTHERDEVICEFONTPROPS (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSCALE (fetch (FONTDESCRIPTOR FONTSCALE) of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTAVGCHARWIDTH (fetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCHARENCODING (fetch (FONTDESCRIPTOR FONTCHARENCODING) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTHASLEFTKERNS (fetch (FONTDESCRIPTOR FONTHASLEFTKERNS) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTEXTRAFIELD2 (fetch (FONTDESCRIPTOR FONTEXTRAFIELD2) + of FONT) + T) + (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T]) + +(MEDLEYFONT.WRITE.HEADER + [LAMBDA (STREAM OTHERFONTPROPS) (* ; "Edited 25-May-2025 20:51 by rmk") + (* ; "Edited 16-May-2025 20:20 by rmk") + (* ; "Edited 14-May-2025 17:01 by rmk") + + (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others") + + (PRINTOUT STREAM "Medley font" T) + (MEDLEYFONT.WRITE.ITEM STREAM 'VERSION 0) + (MEDLEYFONT.WRITE.ITEM STREAM 'DATE (DATE)) + (MEDLEYFONT.WRITE.ITEM STREAM 'OTHERFONTPROPS OTHERFONTPROPS T]) +) +(DEFINEQ + +(MEDLEYFONT.FILENAME + [LAMBDA (FONT CHARSET EXTENSION FILE) (* ; "Edited 10-Jun-2025 11:02 by rmk") + (* ; "Edited 25-May-2025 21:25 by rmk") + (* ; "Edited 19-May-2025 17:42 by rmk") + (* ; "Edited 16-May-2025 14:09 by rmk") + + (* ;; "If EXTENSION and FILE are NIL, puts the file in the MEDLEYDIR fonts/medley[device]fonts/ directory with extension MEDLEY[device]FONT. If CHARSET, goes in the CHARSET subdirectory.") + + (CL:WHEN (AND (LISTP CHARSET) + (NULL (CDR CHARSET))) + (SETQ CHARSET (CAR CHARSET))) (* ; "Edited 14-May-2025 12:02 by rmk") + (LET (FAMILY SIZE FACE DEVICE FILENAME) + [if (LISTP FONT) + then (SETQ FAMILY (CAR FONT)) + (SETQ SIZE (CADR FONT)) + (SETQ FACE (OR (CADDR FONT) + 'MRR)) + (SETQ DEVICE (OR (CADDDR FONT) + 'DISPLAY)) + elseif (type? FONTDESCRIPTOR FONT) + then (SETQ FAMILY (FONTPROP FONT 'FAMILY)) + (SETQ SIZE (FONTPROP FONT 'SIZE)) + (SETQ FACE (FONTPROP FONT 'FACE)) + (SETQ DEVICE (FONTPROP FONT 'DEVICE] + (CL:WHEN (LISTP FACE) + (SETQ FACE (CONCAT (NTHCHAR (CAR FACE) + 1) + (NTHCHAR (CADR FACE) + 1) + (NTHCHAR (CADDR FACE) + 1)))) + (CL:UNLESS EXTENSION + (SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE) + "FONT")) + (CL:UNLESS FILE + [SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION) + "s"])) + (SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9) + "0" + "") + SIZE "-" FACE (CL:IF (SMALLP CHARSET) + (CONCAT "-C" (OCTALSTRING CHARSET)) + "") + "." EXTENSION)) + (PACKFILENAME 'BODY FILE 'BODY FILENAME]) +) + +(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) + +(ADDTOVAR INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ PRINTDATA 0) + +(RPAQQ SMALLPDATA 1) + +(RPAQQ BITMAPDATA 2) + +(RPAQQ WORDBLOCKDATA 3) + +(RPAQQ CLARRAYDATA 4) + +(RPAQQ FIXPDATA 5) + +(RPAQQ ILARRAYDATA 6) + +(RPAQQ HPRINTDATA 7) + +(RPAQQ ALISTDATA 8) + +(RPAQQ PLISTDATA 9) + +(RPAQQ LISTDATA 10) + + +(CONSTANTS (PRINTDATA 0) + (SMALLPDATA 1) + (BITMAPDATA 2) + (WORDBLOCKDATA 3) + (CLARRAYDATA 4) + (FIXPDATA 5) + (ILARRAYDATA 6) + (HPRINTDATA 7) + (ALISTDATA 8) + (PLISTDATA 9) + (LISTDATA 10)) +) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2068 13946 (MEDLEYFONT.WRITE.FONT 2078 . 6718) (MEDLEYFONT.GETCHARSET 6720 . 9067) ( +MEDLEYFONT.CHARSET? 9069 . 10615) (MEDLEYFONT.GETFILEPROP 10617 . 12087) (MEDLEYFONT.FILEP 12089 . +13944)) (13972 31117 (MEDLEYFONT.READ.FONT 13982 . 18216) (MEDLEYFONT.READ.CHARSET 18218 . 21057) ( +MEDLEYFONT.READ.ITEM 21059 . 25580) (MEDLEYFONT.READ.FONTPROPS 25582 . 26047) ( +MEDLEYFONT.READ.VERIFIEDFONT 26049 . 31115)) (31143 45728 (MEDLEYFONT.WRITE.CHARSET 31153 . 35202) ( +MEDLEYFONT.WRITE.ITEM 35204 . 41869) (MEDLEYFONT.WRITE.FONTPROPS 41871 . 45073) ( +MEDLEYFONT.WRITE.HEADER 45075 . 45726)) (45729 48298 (MEDLEYFONT.FILENAME 45739 . 48296))))) +STOP diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..5203dfdabeb80e721b071dc8d2d4f717f9316c95 GIT binary patch literal 19559 zcmcg!dvIJ=dEbZph@2=|NfAaEak3aAo5<|FcX#!mCA-?avR2yNtL(15R$>sgRz$Ld zov|GrrJd=tol@HAv|$PZ1GEi&&`>&ENfD3`vUJ)hab_~OB~y~lbS4xSO8==+Gvz4`XBN_@Y!S^B zD|RWLD=$XHXvt1zE9sehOZH5^wPK)GZVs$O(!O% z_RL-y`drt2J@?l8A~AR||GFZ!i7YFI~O-=#`b#tM8Q0vre%x>y!%V%E@;a z6V`Fj8x>Ppht{-VOCR zS?ewW2r_e4Y)KNt@WsDz_)6eAXbn*1!I0;1ggqRh^geX_gU4hb*+!Ljy+~!56jAt_@ zoXVVCYMxN!8T^LEaS?nXvM&&`2#-AUsNhQhly3cL4JqYLhPj(#y}( z|1>ZbkD21!Z0_u$bGjm|iAe#C#^P2f2`e!r&K1r;QKKkf3DQD*`mK0EYh+ozMmR;9 zq)HKTRi!y)3CONHfSI(K{TP!|XjquRF*F41!(u51$(hpY8}VidMn#RH0a-HJ2W%cr z125P%A6CedvF6|yQkxfE54I~i?uiy&pT&VRvM?cs`RPJ>!5&YSO6esr**?G=gwifS z2b++1_4X|9QxhT$T|No%BD3ZSyCr4R6Iv|dbgr1Im-YMId0c=2e z#wpQcx{M+RfQpm7viea&<)Fb@R7Xyj?(&d!!H)B~u#%!ZJT3w&m{U)RkNbr{`ia^M zALk39#!M~zXSK)HMr2V>n&;i}XNqT889OZ!F&vB8ar-PpvMg{+ry;hBkX#&q>1?h9V}WX|o71$Gw`s=6&`6VGddHp& zlH45c(6VLGEL3;P5^tWigfu=Sn-q;}d6MoSzY?jdF7Rtq*|1P4_(~b zd8wk*t;`D1nJ^%j+I}*uapli|BG9y@0ZCy^nkxdh;*FbnZqlcMxRa)Wny@ee)E@S_ zbtG0(@wnHmImw4jiIV|CjH4%?u;)p@45${I5ua+oEOSLVBMJE%HObPCL6@B>iZPb# z+53f)&z?!=Pus_j`vkjrc3iTe^_TFCnQZE34Tv&dO*w7&uUl+#70)tY#9S% zv`av1JVA-r2;8{R4fU+8dh=~rQb;vsRr@_5Q4KEct?kuk zP$at{q+#w~n7_GmuUFxTg=Y)9cNN!0-u2AF#)}WtzgIl=wfc|q10SvS*FG*K(uFQV zYJ-dfAc#`7Mx68~fq)pW2jLP((-iim%7Z$x_AwWKMVufMxAc z$tmGTYE>DIU|-{tEI?M=CqOJOrid0VUlZrGX5zi@H{oV!9qDJGi=|b2^YdF;cMMk? zVP~mNznz86R?aC254|7GLjs00l;SPtA8h+>&op9JJkyBfad*q~t++cgDGBg@NITK8 z!ZtBz5O9pTt`-h15RcSTuW8D7w}8WLQ{c#n!s5V?>3ECumfyLG35nUH)7{;a;mEnb zNf$ash7dow9Z4+rKOBVkMPi|9KTF`*77>)WPgVPyGWc|LsK!rwA8*WsLiG=6Pr>?z zdiqpD^;ln$mA6mLtD@~wD3e0gVBtKFU%0vR7FGY^-WT)BeU0L7pVPNC^6szYH(oqf z|Blml?AiMN6b3%p^v7HQ9d-p2aK+tn1IS2q$rvS@h64nAzFE=kaA(#q)%ffI|=3=_~5n!~_V! zrHM(V>ozn1p8_6(eptE|AC^HAYt#Z0l9G@*Y1tLXoHi@puo-P!Yi0v5XTEut& zY`DT~2^VC~0+~>QVjf5OfpLk7MBtsFa44{zf}t!mMRsL>qr~E^<(0Mc$jHdr$jU)( z05}=<`NrDW?}GiHFg>Rm3bm8m;2gtEpDq%snHO=h)x!dSWnsYTsux5HpVexvs9em~ zBDki+iHuVO3kWx39P}T|ZE1W4zA~65a7c^rg?X*z+Rf(ErzmqmoWOz1*mf36U$(ho zvTcn~F(HWOGUbd(N4tB%n<%%cyK2TO(z{?^p@w-HIx0mj*s_*+Ak%uySAx8LwwDxn zDqJ1nZCq!&`A5~Ev-MGls$@Q6qO35I!;LvU7UWmlv#>Axi3NWA{G4KOxM3u+ zFCX4D)(4)vFVesNJ%m}Shey_Brz0bg@EwjsZv#@%KN&6#1p9;Ul3nk8Zms@}eCS;L zS-2^11?ek7#~Qi=WLK;J*W^{2WZo`IFB_ouVe3KQYzpM|(# zAzgPL>*fAwynnMYZwc7~+L$S3KWa1NJ7jBr)xRMCoPsD@8hN1LkrAt_`# zZ>tK)18m=0Jt{j^8QdLrFUP2kDx!HM%KY&4(WmAi?+;v@e|7uK)zORdFUxwlstCSv z!>b(%4h0%@46_?ykan<8%ir97TcbD-dEiiS_nl5(R)&Ij{(}%e-!?UBFO2r-!2C6s~CE=Iy&zRHQhM5Ld(OL zthBtoFn|&&f(DV;jLT8UUxM4X`rS~GcCA$u15)I*sXUXi38YdW`N~wtqKFwyrna6>8QXj zW)DLMAOZ0~CrtfeLiucNcGjlL7h8bq)*s=wwsy|$smp=G(FI`To~$I~&c{D{17lnd z5%@Y}l>u#G00NNUWbJaMlv~8*k-!=fF$9iVmuA!jZ8#yKgxQ3M^nU^T>9c!SyK){iOR&@0@Hm1w%&*!z})gf4x+k(bjwGHi9|&Jt)d&88!tp0V>t z;odWyDkh~sZa&#Quo-|}cR<(&BO)ky3RWOm^6YzPz28(@g9gQqP-7_) zQ+ERo2ERHV3O=*oy23{Xb5bey?5LD_4h;1)=5o+Z{i^C`8nPr$YWYcN1wQR&g&Ot8 z-9DQYdm8oMlNCSXRy+u0`9ZhlXWcGe=tcHZ=vPhM>rKRkUmFlJ$6%X7}@d=>^Z(XJ0AP1eOP_cNrt=Tsku z!GiWs+t1r-l1E<7IEBT$T|pd#3Ese04n!wU0J*1Spf>;A7|~cWxk@38rty{{9MZf! zTUoG6MPZWimHd_*7r>s>9WKdmJMAwsz(u5GkwL?2%?v=_rD`r)nJeSA-XjyZOS*W> z6%efAmO~}`+7cB%JBtI1wtylkjh}34ndjAITV10KcL5ImI1-&7jDYhcB)F3L-<4S|)8RHqT#J-F#~YrOTVIq!(sp z1{XgIB(-q}CVs(o@Fgdb2Imk6%jZGO!d^h8u@0piMHyffigq6Bfn-wFO}rseg7 z{X$JtoMZqR_ZnKFSanKSN!ankNNc!?q!m`GlKXucBvc*&&B?MM;a^%Qh^6%I>!prP ziQ2~A_R&U4d?zJd+6oQl_I7@dW}#t)qZqXMw`!aF_CBQ)`&RJ3Y8SPq@6STo8-;y;84dy!C|92mh96tFOQbLSXh zC=j{u37P*9`70FUCJjd*=0Vh7c1AFtz*Du&{d?Q*R)eGj_ZS{@j&AII%!&S{6Ww^( zIqF2$oTJ=25*~I=IAb)#eMlVhhHy^sOR6DGV2BeK;=X}_`kC5hcyIe1YJ`V2UcR`n z@zTG`%@4oci8&{4?i_YZCw4<__zQuC6GQu0{RfUYP=DR#fju>f#(_R4-zojre1C49 zj74B90jHGIpLDVlz;jKV3fY~bGH6#=Z^(y}k%E+nsZa^PySVhc(@6MCwx?4?Tmyq~ z@a9tV2&H*Q7a3fpIVmfa zR5A^yI1oIfD^7uL#&jr6b_=RX1yzibZUtsVY?m*`L}#pw4U8!h zbdN~t8G6wTUnH%Yz{*EY7Z-|7wW!Tr!XWBBN;kW}(C4q6XAJ$`%a2~Fb)Nry*)V?6|qQek;IA95AJV{`pa=XUSFL0$Sv{rmIBo~pkR0B_J~F)?STXL=K) z+Tonf-|;XVI8bP7ObGu;R48Z4x3rkIPXh;k3=9{NGmJ!n>1`8%PvQCS?!Li#F8EL= zxDZUQv9{r8ryu<_YhHEtJ|B9p{%wi!Hba}YURr0Vf2x)n8f_rvV=i)U4|?iJ_ftpD zECf9amu9pF47U}0zl#Bf8Y)*}BNRQtJ?J*()f)}e-zd%7r`)9$n!apc59<3(}5B~oC>UbI+L->WpKW&$JCPqoX|M#o9J0{XGwcfmVLHTN+W_cpEVH*Bk3Z& z8pw94HkU5D$Ppnk3Qs8#D-I!Ptq3*jR`de3tf{to)}*YLK68rtWGDy) zEkl5`30lx$=gPAb_rSER1^%^VND8#0ta2s|UfTkh+FAiHjqkW*R0Wkv$+Up6TI=Gr zL}pO{MtRZBK%+|nPn(qqw!n+aFyWWB^kO373A3JCU4MA(8c-r`)%@#el9egXW>>GS ztX@J5Xwudiuo9?|Ru$B;YI88)NKhLN2{GVBv~)m7p0YSngh-s$@`P-n0!Zklvb6?0 zBFbtyD}>@(D*?#MERI-#B?T_`*HO@%!UHKFoD4!7ag3fp@YhDfB0Tm|WocR<^d09j zT3Ejd8f9f|{nEoAQm|a!)uT@}`=cn8TAqZ50)0Fos`x1pHxavZ=Dg!6gNE6q;TRiw zWxbr(4v+ZooE7Di)8yfj{|lg0PwM(;n!;gsM>v&Ev0jdZLvy(s^KhK!2O^Q48CDQ! zhF%QRR0gLPcJG#t@&ct_3#t7fw_A|@df)IfnS5w(Cz;=QQ)W9RbGbrh#H}(i)K|YJ zvpvX`Ln3zx4BZObZg zf|Py58_xxte)_rhI5^jh7vEj~kM)6_Vc!5fasXdms6*bt_PpnMJLDZ|&%1tShrIpm zdCv#>DTGHBZ2jaav^5U3rher)W6TwY&~z#BgFLN`HPx++HPN*Mx0jvAvAWK{>N*3{ z4`Q{s;fs+jLqC;`A-jg4C-ubA8K)2% zjXR0sn#)&?D=r1N<52CsBH(k^!U>C_ST&Bpg7zfMO5BJA!|5x70aDzE)iNCm({Z^G zt7R${rs8rRWM+I_VlFywV&Z)1=CzfoN*I zk^vK@^Grs|dy_rz)dy$YqBkkf+E)buo%*w6x^zw2!gWnh$Sd8cdP6~}f|^&IG+7%1 z4h+15^{eL}zOo9M{R8XQ)}$#Q_Gb0c%H3+MDd| z!5OwLE=Ik#k=l^tM{4G~ZesJ+_c^&0UUBOUH&UDX+;Uau!v38>RqLq(K}^6r9<+Yme^5@I)S7hLjn#RvMeL3H^JHvmHa_7uL)(0_HH^)EY8-w+$ za zI$=JCDonzZa`_~v|8uNV=q3pqF-Ymo#&;5Z5|2DdJ-Xj8O(JB3GABUXaDNlH@Zb!1 zPt2#W*DwLciJzFgo&fmQpP(3t^p-WD`njVd&`q;a60VasXcF4L*&+#!PPXvJdubXu z36G)K8UW!e$T*GDE7`Lm=~9QZJPEQm`Dq?xyn?v-{5a1p0Zxv`O2CeE=p+GetYbU4 zWu5bVM4~q31UzD|g^w&tz_Fz5h8vF0o4h*N96np3&sN}eyR(er>x6TBG<+Ol9F~#a zB95)>yx9~9(4~Z~jcAQ5*zqn^=%jGqw+VWpa~%_>k-IUw?wSeqKy?Eg(zzQ0-amI^ z0A0ydG2k+{+~*s>hq4xouy+s)EF|aRU8RVSgm6yMU7!S8Sos;A9KaBe5IGV>2lxU9 zfHac;uY7C(MsTI;+qpPMnp1YsF5x(F9Wc-U097aJJ_5fuMa1o?Qrt}`6l!6s8R1xv zSAt=zRClR;y{C<90;KZgsccT=@AJX{A%)ZC2PV!sWYj0 z78lPddS3Eh*8@`hN`oo$o~JKF*Y?^At}An@SH9lUq2B)Xyyp&f$h)IMUT=rIL+yFj zhdSg9cgRx~QJ?d3Z|G3(NPFJ%qumxl=#>=}fE#Lj+1Xj1=#)`Vhe>CWXM$%FFvE%GN@>(K{r=+8&LlICu$2lYT% zl3O*~`Cb#+vLm-@w7-O*UP98a%&i*juV8>q^|)1|ed-2TM~_=I+UHDBw;H#K*w@y# zqLA1ox7t2YHBV+%+b5{#UWqK)`c@08SXCI?))kfet#hiaRa~l;2vr=P4$4@5g(CyB zNE5exFzkK|h{)_;CY`Lghwdda!*=->2c+^kh>DWvQ_4&#A->e@B0pf>I|~*76$jLJ z)l0yV?&s?d=&@MN6O@61wP=I(| z^6*iLMM19`OeP$mQsfFvQG}dlmHD+9`}p1lnXGwW4OrcNr!h&L>7Ax^zdyr&E726B@9!V5i(%#Mu6m2OV6h->nX3;Pk=wRy*@J8$FC`thLT2M`4cgaC0PPYi+3_VB+4slG)v;nB)=F{c*V%a{Ob-ZB=KsI?)@dY?y zZxA`9B2(c~<@t*Xz$}1wl?!U?w8~XiF9d!BF4;+*IgLmMFAWIlrg1<`hPT-zfIWiC zNKlBVI(npB=qq0OGZOR>FA%U&76`9uQ5G=xS$rd$$KOwYD^e)YA4@<)*rbS_1en81 zMDYtOWOO`3;0_pW9KRuS$S1-t8Y5(f-&gUQu2SgwHw(qs*a`8DcZjI{e%x$5dVX{BL-%PF#nrXT zk8ak)g;jhf`pEf}jq?xV`%od<^hOI5IQz(>7dF>d1e#x2U%g7DEq^#i+IE`0)^nG? zHl(=3`+a|KNc*fx?}1LsqC1&rY4tp_itXcb$OaFuf7r^oYB;^uW`IX?G3A%H)P=;< zttEPd0mko@OIp3MevNp}_8G|)=`gqkgS0W43n+)zUqhCuzs=FM^sYc*3h699hA)-H zm^z~LHlDUDs}<17@Q0+v*r&k}E0;Ug_7@+=AXz(;2b96zm9i0Ek)m@+UoT}bR>oOe z!Y49tohxY|6s!^-Sq`m@p{aC)_z{0|XH2?e{Al8lLg+jKMc}Vo;bR;2-?&B`&*V_? z1HKa<%QXvo1wN)3liUrLPvDW=Hh!AK6T4gdgwHU>$jRde{HZSb*Go%Raj Date: Mon, 16 Jun 2025 16:56:27 -0700 Subject: [PATCH 2/4] Get MEDLEYDISPLAYFONT into DISPLAYFONTEXTENSIONS --- internal/loadups/LOADUP-FULL | 14 +++---- internal/loadups/LOADUP-FULL.LCOM | Bin 3558 -> 3519 bytes sources/APUTDQ | 59 +++++++++++------------------- sources/APUTDQ.LCOM | Bin 6198 -> 5730 bytes 4 files changed, 29 insertions(+), 44 deletions(-) diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL index 155ab7077..c4235a5cd 100644 --- a/internal/loadups/LOADUP-FULL +++ b/internal/loadups/LOADUP-FULL @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Apr-2025 05:14:27" {DSK}larry>il>medley>internal>loadups>LOADUP-FULL.;2 4662 +(FILECREATED "16-Jun-2025 16:33:00" {MEDLEY}loadups>LOADUP-FULL.;4 4743 - :EDIT-BY "lmm" + :EDIT-BY rmk :CHANGES-TO (FNS LOADFULLFONTS) - :PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}larry>il>medley>internal>loadups>LOADUP-FULL.;1 -) + :PREVIOUS-DATE "23-Apr-2025 05:14:27" {MEDLEY}loadups>LOADUP-FULL.;3) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -17,13 +16,14 @@ (DEFINEQ (LOADFULLFONTS - [LAMBDA NIL (* ; "Edited 23-Apr-2025 05:13 by lmm") + [LAMBDA NIL (* ; "Edited 16-Jun-2025 16:32 by rmk") + (* ; "Edited 23-Apr-2025 05:13 by lmm") (* ; "Edited 13-Feb-2021 22:51 by larry") (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q") (PRINTOUT T "Loading FULL fonts..." T) - (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE)) + (SETQ DISPLAYFONTEXTENSIONS '(MEDLEYDISPLAYFONT DISPLAYFONT)) (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT) (RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL) (MISSINGCHARSETDISPLAYFONTCOERCIONS NIL)) (* ; @@ -89,5 +89,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622))))) + (FILEMAP (NIL (454 4705 (LOADFULLFONTS 464 . 2140) (LOADUP-FULL 2142 . 4455) (FIXMETA 4457 . 4703))))) STOP diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM index 1332ec1f6c818f8c841c011262e4f595966e2375..0840537aaab357741a7a534025d3e07257400911 100644 GIT binary patch delta 851 zcmZuw&2G~`5RQ|Qgq#p+)heZBaEpi|#q6&C5(|P{dm|Y+iDkQuB5`PGq7sGtD1a0R zq24%gK-vdD@B$oqMdAf`2X4FqhaO;^q=5)5dFJ!1XXg86>>t}-x8Jw!W4-kF)v!bm z(E#hFqL>JYP!LZ?gK_V9w*#Xgi14~j9gnu(JYWN1_gs}AC$1!Frly(15aH>hyUgrP z$CDR#P4JqQQ#3QAH_NsJR}s18VI@)PdFh zOX4d;H&jp!RRNPaZd5vG!(`Bh9Q!07AWF#^Pv)|bW@2^5KDUxCC>MLlFT#4!51KZm zPRX`H8Wy1j7%?lgOE|#bH^V5j1J{pYeU2MYJ8A|l4JAnYyq-!3&o&eM>dY*AyVlR$ z%=bodsI|^6*QV#3U_=8ya5*U*xNl$}1c4vgaYdOcc47bo8Ng@2TX0CgZZ>Qy0$i?K z<>NA0!E*uDgK* zWz0V_5p)cNGM_JCB7s_&#YpVH8=Z7|!!r)C&N7*4n$P!0NV0F4dpC~bapuordmI~f znc2HtfzUP0fQB?WY_!~l1BMDu>PMa%Mxa;N!>qKStN*;Dkyu(%HRcX;i975=R^FNa U0*)K{p4FZ$fgc5Utg;Nh86b0)Y}*1{aB>k|Xb~?Iaeml*W!^>U?0kR7G4uV%i8Nj*?Vr zLC_070JJ})7myI#IB@Ba19v2j`~${mTIEoIrM1_yGjHa-w_mfrvhR1dD3dC~kwj&x zf~@L9(P>eHoY;x_!(JG4AsT=P>DQ*W{pR68)DMiXJsKSwz0l|f-7q*d_;+DlqInQ0 znS(0p3PLdvo{xe{taRs~J=hOEoMlhulM97{2;KGsyIlpMiTQM{W;<5ZwJN@4V$zjE z|6|79U=oZ5?a&CLcK2{NHuz8B+ARu-rcp@imTCLa)*gsqzb^uRCCHQ!>Cs^r>%xGP zbXw9?B=bKV1akUY_$=_psXK`p5Sf2jy3c4G!MEI&YXfC6;I~155(QdbwbpF- z1(e2&H$Y_qD3)ovK*}0an~iG4M+)qso)ooNJyEsGAfwO?%QA^y6iNhI zC)0*nc~+@hY;dgEEVBq&MF;`U*7b(tS^i^bo->{Tr3#2~A9xWBCS!;#3A!RqOF%R_ zvawm1k-}I}#@h!@lx=r=gMAoAJ2C7#h5{5?k(SYS}sFQ2F8FXz*H2egsTix zA$cejAy;=@*uqt}-8>XkL={0*Ay-0|5F`%@o5s-YX~Xk=h%fWA<)Z{z#ds^VwparN zP2E^V#~MO{*OL!YUS>Zw%IEKr8+XsCyB1R4Y3$k!6EqE;)t@-F=YvN0w`Be%${y=8 fpQNzqRq3Y+tETO>oXXzROwV`iZR_-7D!KF*9~t+n diff --git a/sources/APUTDQ b/sources/APUTDQ index c9192b34e..7fbeb9529 100644 --- a/sources/APUTDQ +++ b/sources/APUTDQ @@ -1,18 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Jan-2025 13:35:20" {DSK}matt>Interlisp>medley>sources>APUTDQ.;2 10901 +(FILECREATED "11-Jun-2025 08:43:36" {WMEDLEY}APUTDQ.;5 10433 - :EDIT-BY "mth" + :EDIT-BY rmk - :CHANGES-TO (FNS LOADUP) + :CHANGES-TO (VARS APUTDQCOMS) - :PREVIOUS-DATE "25-Oct-2022 11:44:17" {DSK}matt>Interlisp>medley>sources>APUTDQ.;1) + :PREVIOUS-DATE "23-May-2025 09:03:46" {WMEDLEY}APUTDQ.;4) -(* ; " -Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation. -") - (PRETTYCOMPRINT APUTDQCOMS) (RPAQQ APUTDQCOMS @@ -33,10 +29,8 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation. (LOGINHOST/DIR '{DSK})) (FNS LOADUP ENDLOADUP) (ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG - UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES - NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION - ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS - INTERPRESSFONTDIRECTORIES)) + UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST NETWORKOSTYPES CH.NET.HINT + CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION ADVISEDFNS)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ;; "many of these are obsolete and can be removed, but it is unclear which ones") @@ -173,26 +167,19 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation. (CLRPROMPT]) ) -(ADDTOVAR SYSTEMINITVARS - (\CONNECTED.DIRECTORY . {DSK}) - (DWIMFLG . T) - (ADDSPELLFLG . T) - (FILEPKGFLG . T) - (BUILDMAPFLG . T) - (UPDATEMAPFLG . T) - (DEFAULTREGISTRY) - (DEFAULTPRINTINGHOST) - (DIRECTORIES) - (USERGREETFILES) - (NETWORKOSTYPES) - (CH.NET.HINT) - (CH.DEFAULT.DOMAIN) - (CH.DEFAULT.ORGANIZATION) - (ADVISEDFNS) - (LISPUSERSDIRECTORIES {DSK}) - (DISPLAYFONTDIRECTORIES {DSK}) - (DISPLAYFONTEXTENSIONS DISPLAYFONT) - (INTERPRESSFONTDIRECTORIES {DSK})) +(ADDTOVAR SYSTEMINITVARS (\CONNECTED.DIRECTORY . {DSK}) + (DWIMFLG . T) + (ADDSPELLFLG . T) + (FILEPKGFLG . T) + (BUILDMAPFLG . T) + (UPDATEMAPFLG . T) + (DEFAULTREGISTRY) + (DEFAULTPRINTINGHOST) + (NETWORKOSTYPES) + (CH.NET.HINT) + (CH.DEFAULT.DOMAIN) + (CH.DEFAULT.ORGANIZATION) + (ADVISEDFNS)) (DECLARE%: DONTEVAL@LOAD DOCOPY (DUMMYDEF (ADDSTATS *) @@ -261,10 +248,8 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation. (ADDTOVAR LAMA ) ) -(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 -2021 2022 2025)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3999 6207 (GREETFILENAME 4009 . 5882) (FAULTEVAL 5884 . 5956) (FAULTAPPLY 5958 . 6044) -(ERRORX 6046 . 6112) (SET-DOCUMENTATION 6114 . 6205)) (6208 7228 (SMASHFILECOMS 6218 . 6560) ( -SMASHFILECOMSLST 6562 . 7226)) (7322 8926 (LOADUP 7332 . 7916) (ENDLOADUP 7918 . 8924))))) + (FILEMAP (NIL (3701 5909 (GREETFILENAME 3711 . 5584) (FAULTEVAL 5586 . 5658) (FAULTAPPLY 5660 . 5746) +(ERRORX 5748 . 5814) (SET-DOCUMENTATION 5816 . 5907)) (5910 6930 (SMASHFILECOMS 5920 . 6262) ( +SMASHFILECOMSLST 6264 . 6928)) (7024 8628 (LOADUP 7034 . 7618) (ENDLOADUP 7620 . 8626))))) STOP diff --git a/sources/APUTDQ.LCOM b/sources/APUTDQ.LCOM index cd668212f2f09e5d02843e28108c6c57bbba39ad..568867e67e31cf2614abffa42e0246fcf7c767f7 100644 GIT binary patch delta 436 zcmaKo%}T>S6h=|H3R0nT=jJjXB;bVn)#_M;*qLfHO=>1>?XtG9E!sr-vk;N)T`74E zR|OwId=6hh*W!SpE~*c3&$-`u)Lu63PG&kjoW|JDi~?v|#4?Gwi9kl3WOzBah`Nx( zfZ)1WWz=P@o6qZ%U`%j(gE~oj{yS z`h&O!1HrA--I)u&uT@n=&}~nIcoEjnks`?z$7SV!*&(BV^o0Zdd06-?(*(k(6XLzI z7L11HK*|TUx6e2ZeUKY=z(M+4SoW)20a6QC!}04JQ(*;Un7G=$`l_}~G?Q4O+TT)Z z{=W3El0Ic|`j$l*MMO()b8GYa)m|p&v9Rd}M?Mc*H6~=Tlq&g>WYdPj8LfDH{+fSY J&UlV1eE4IB#TfKaTH+kRtzAx|ndiKTq*j-kQm;ISxnN|fz$thKw z62YM1K{B0>C-D%H8DO~Z#Oa6QQ8JC|(|(rK*({6G$#^lZPvhYveqUcC=jk9`)ZMTx zy;sHO7SaKe$~Cu19IND1suC)NK1cZ1)w5MGV7!rj(#v zgf`ZZ)?_|yMAVhkQ&Vp_vdn)vSnja^#I#KU4)vHcUi8%bX*R;(G)~;0MTH?bXw5*t zm3$qXFrppC+rsda62Ml);DaoW)&fGDa@iqA7|^XOpZqUOvi^GT`Tir1MYJJ##HfI_ zpiwKLROZ&jYE&p5pw(pozX6|#Fn<->pL?q4yS*k4c_*!>z{?QyJU+-2MztLM^yqUU-Rgc3)u^)P=!@^c)Uce*I|NsDmGQxDRmQ%dfX#< z$Md%ItuDoJ)5wGC05?4A%fs(?E;O~XVZ=iLSKA8>9`+*EI+5xQI`Qm0hNsYt)8rjA zl60P={cN1fFc7;&a!`NQu9b2q=b-M$u2pk5%AuyfHUX(MAh6km{MK|G1 Date: Mon, 16 Jun 2025 16:57:14 -0700 Subject: [PATCH 3/4] Add extra fields to FONTDESCRIPTOR/CHARSETINFO To keep track of completeness, charset, slugness --- sources/FONT | 118 +++++++++++++++++++++++++++------------------- sources/FONT.LCOM | Bin 45400 -> 45804 bytes 2 files changed, 69 insertions(+), 49 deletions(-) diff --git a/sources/FONT b/sources/FONT index ebef461de..b1fc303e3 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,13 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Feb-2025 12:28:10" {DSK}matt>Interlisp>medley>sources>FONT.;4 191871 +(FILECREATED "16-Jun-2025 15:54:45" {MEDLEY}FONT.;22 193331 - :EDIT-BY "mth" + :EDIT-BY rmk :CHANGES-TO (VARS FONTCOMS) - (FNS WRITESTRIKEFONTFILE) + (RECORDS FONTDESCRIPTOR CHARSETINFO) + (MACROS \FSETWIDTH \FGETCHARWIDTH \GETCHARSETINFO \CREATEFONTCHARSETVECTOR + \FGETCHARIMAGEWIDTH) + (FUNCTIONS \CREATEKERNELEMENT \FSETLEFTKERN) + (FNS FONTCREATE1 \FONTCREATE1.NOFN \FONTEXISTS.NOFN FONTEXISTS?) - :PREVIOUS-DATE "19-Dec-2024 15:25:17" {DSK}matt>Interlisp>medley>sources>FONT.;1) + :PREVIOUS-DATE " 1-Feb-2025 12:28:10" {MEDLEY}FONT.;20) (PRETTYCOMPRINT FONTCOMS) @@ -130,7 +134,7 @@ (CHARSETERRORFLG NIL) (\DEFAULTCHARSET 0))) (FNS \FONTRESETCHARWIDTHS) - [DECLARE%: DONTEVAL@LOAD (INITVARS (DISPLAYFONTEXTENSIONS 'DISPLAYFONT) + [DECLARE%: DONTEVAL@LOAD (INITVARS (DISPLAYFONTEXTENSIONS '(MEDLEYDISPLAYFONT DISPLAYFONT)) (DISPLAYFONTDIRECTORIES '( {DSK}/USR/LOCAL/LDE/FONTS/DISPLAY/PRESENTATION/ @@ -2871,10 +2875,11 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) + (FONTDESCRIPTOR 0 (FLAGBITS . 0)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -2901,22 +2906,27 @@ (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT)) -(/DECLAREDATATYPE 'CHARSETINFO '(POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER) +(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER + POINTER) '((CHARSETINFO 0 POINTER) + (CHARSETINFO 0 (FLAGBITS . 0)) + (CHARSETINFO 0 (FLAGBITS . 16)) (CHARSETINFO 2 POINTER) (CHARSETINFO 4 POINTER) (CHARSETINFO 6 POINTER) (CHARSETINFO 8 POINTER) (CHARSETINFO 10 (BITS . 15)) (CHARSETINFO 11 (BITS . 15)) - (CHARSETINFO 12 POINTER)) - '14) + (CHARSETINFO 12 POINTER) + (CHARSETINFO 14 POINTER)) + '16) (ADDTOVAR SYSTEMRECLST (DATATYPE FONTCLASS ((PRETTYFONT# BYTE) DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME)) (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) + (FONTCOMPLETEP FLAG) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -2935,14 +2945,16 @@ (FONTSCALE POINTER) (\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) - (FONTIMAGEWIDTHS POINTER) + (FONTCHARENCODING POINTER) (FONTCHARSETVECTOR POINTER) (FONTHASLEFTKERNS FLAG) (FONTEXTRAFIELD2 POINTER))) -(DATATYPE CHARSETINFO (WIDTHS OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD) +(DATATYPE CHARSETINFO (WIDTHS (CSSLUGP FLAG) + (CSCOMPLETEP FLAG) + OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD) (CHARSETDESCENT WORD) - LEFTKERN)) + LEFTKERN CSINFOPROPS)) ) (RPAQ? \FONTSINCORE ) @@ -2985,6 +2997,7 @@ (INIT (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)))) (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) + (FONTCOMPLETEP FLAG) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -3009,8 +3022,8 @@ (\SFFACECODE BITS 8) (FONTAVGCHARWIDTH WORD) (* ;  "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") - (FONTIMAGEWIDTHS POINTER) (* ; "This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.") - (FONTCHARSETVECTOR POINTER) (* ; "A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset.") + (FONTCHARENCODING POINTER) (* ; "Was FONTIMAGEWIDTHS: This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.") + (FONTCHARSETVECTOR POINTER) (* ; "A 257-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset. The last cell if not NIL is the %"slug%" charsetinfo that can be shared as the dummy entry for otherwise NIL charsets") (FONTHASLEFTKERNS FLAG) (* ;  "T if at least one character set has an entry for left kerns") (FONTEXTRAFIELD2 POINTER)) @@ -3042,10 +3055,12 @@ WEIGHT _ 'MEDIUM SLOPE _ 'REGULAR EXPANSION _ 'REGULAR (TYPE? LISTP)) (DATATYPE CHARSETINFO (WIDTHS (* ; "The advance-width of each character, an array indexed by charcode. Usually the same as the imagewidth, but can differ for accents, kerns kerns. This is what should be used for stringwidth calculations.") + (CSSLUGP FLAG) (* ; "True if this is a slug charset") + (CSCOMPLETEP FLAG) (* ; + "True if there is no further data to fill in any remaining slug-characters in a non-slug charset") OFFSETS (* ;  "Offset of each character into the image bitmap; X value of left edge") - IMAGEWIDTHS (* ; - "imagewidths is not automagically allocated since it is not always needed") + IMAGEWIDTHS (* ; "imagewidths is not automagically allocated since it is not always needed. But at least some times the IMAGEWIDTHS and WIDTHS vectors are EQ in this case.") CHARSETBITMAP (* ;  "Bitmap containing the character images, indexed by OFFSETS") YWIDTHS @@ -3053,7 +3068,7 @@  "Max ascent for all characters in this CHARSET") (CHARSETDESCENT WORD) (* ;  "Max descent for all characters in this CHARSET") - LEFTKERN) + LEFTKERN CSINFOPROPS (* ; "Alist of extra properties")) WIDTHS _ (\CREATECSINFOELEMENT) OFFSETS _ (\CREATECSINFOELEMENT)) ) @@ -3070,10 +3085,11 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) + (FONTDESCRIPTOR 0 (FLAGBITS . 0)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -3100,16 +3116,20 @@ (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT)) -(/DECLAREDATATYPE 'CHARSETINFO '(POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER) +(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER + POINTER) '((CHARSETINFO 0 POINTER) + (CHARSETINFO 0 (FLAGBITS . 0)) + (CHARSETINFO 0 (FLAGBITS . 16)) (CHARSETINFO 2 POINTER) (CHARSETINFO 4 POINTER) (CHARSETINFO 6 POINTER) (CHARSETINFO 8 POINTER) (CHARSETINFO 10 (BITS . 15)) (CHARSETINFO 11 (BITS . 15)) - (CHARSETINFO 12 POINTER)) - '14) + (CHARSETINFO 12 POINTER) + (CHARSETINFO 14 POINTER)) + '16) (DECLARE%: EVAL@COMPILE (PUTPROPS FONTASCENT MACRO ((FONTSPEC) @@ -3343,7 +3363,7 @@ ) (DECLARE%: DONTEVAL@LOAD -(RPAQ? DISPLAYFONTEXTENSIONS 'DISPLAYFONT) +(RPAQ? DISPLAYFONTEXTENSIONS '(MEDLEYDISPLAYFONT DISPLAYFONT)) (RPAQ? DISPLAYFONTDIRECTORIES '({DSK}/USR/LOCAL/LDE/FONTS/DISPLAY/PRESENTATION/ {dsk}/usr/local/lde/fonts/display/publishing/)) @@ -3394,31 +3414,31 @@ (ADDTOVAR LAMA FONTCOPY) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8870 18389 (CHARWIDTH 8880 . 9665) (CHARWIDTHY 9667 . 11037) (STRINGWIDTH 11039 . 12132 -) (\CHARWIDTH.DISPLAY 12134 . 12547) (\STRINGWIDTH.DISPLAY 12549 . 12973) (\STRINGWIDTH.GENERIC 12975 - . 18387)) (18390 24772 (DEFAULTFONT 18400 . 20233) (FONTCLASS 20235 . 22397) (FONTCLASSUNPARSE 22399 - . 23298) (FONTCLASSCOMPONENT 23300 . 23809) (SETFONTCLASSCOMPONENT 23811 . 24770)) (25446 38178 ( -FONTCREATE 25456 . 34723) (\FONT.SYMBOLMEMB 34725 . 34955) (\FONT.SYMBOLASSOC 34957 . 36115) ( -\FONT.COMPARESYMBOL 36117 . 38176)) (38217 42841 (FONTASCENT 38227 . 38395) (FONTDESCENT 38397 . 38666 -) (FONTHEIGHT 38668 . 38854) (FONTPROP 38856 . 42299) (\AVGCHARWIDTH 42301 . 42839)) (42888 55527 ( -GETCHARBITMAP 42898 . 45788) (PUTCHARBITMAP 45790 . 53847) (MOVECHARBITMAP 53849 . 55525)) (55528 -140067 (FONTCOPY 55538 . 60846) (FONTSAVAILABLE 60848 . 66053) (FONTFILEFORMAT 66055 . 67679) (FONTP -67681 . 67980) (FONTUNPARSE 67982 . 70546) (SETFONTDESCRIPTOR 70548 . 72257) (CHARCODEP 72259 . 72620) - (EDITCHAR 72622 . 73051) (\STREAMCHARWIDTH 73053 . 77217) (\UNITWIDTHSVECTOR 77219 . 77582) ( -\CREATEDISPLAYFONT 77584 . 78337) (\CREATECHARSET.DISPLAY 78339 . 81255) (\CREATE-REAL-CHARSET.DISPLAY - 81257 . 88161) (\BUILDSLUGCSINFO 88163 . 89606) (\SEARCHDISPLAYFONTFILES 89608 . 91541) ( -\SEARCHFONTFILES 91543 . 94854) (\FINDFONTFILE 94856 . 96047) (\FONTSYMBOL 96049 . 96699) ( -\DEVICESYMBOL 96701 . 97570) (\FONTFACE 97572 . 104762) (\FONTFACE.COLOR 104764 . 111684) ( -\FONTFILENAME 111686 . 115101) (\FONTFILENAME.OLD 115103 . 118052) (\FONTFILENAME.NEW 118054 . 120311) - (\FONTINFOFROMFILENAME 120313 . 123427) (\FONTINFOFROMFILENAME.OLD 123429 . 125706) (\GETFONTDESC -125708 . 126099) (\COERCEFONTDESC 126101 . 131486) (\LOOKUPFONT 131488 . 132832) (\LOOKUPFONTSINCORE -132834 . 134907) (\READDISPLAYFONTFILE 134909 . 140065)) (140970 157694 (\READSTRIKEFONTFILE 140980 . -145182) (\SFMAKEBOLD 145184 . 147580) (\SFMAKEITALIC 147582 . 150485) (\SFMAKEROTATEDFONT 150487 . -151888) (\SFROTATECSINFO 151890 . 152527) (\SFROTATEFONTCHARACTERS 152529 . 152909) ( -\SFFIXOFFSETSAFTERROTATION 152911 . 155050) (\SFROTATECSINFOOFFSETS 155052 . 156321) (\SFMAKECOLOR -156323 . 157692)) (157695 165057 (WRITESTRIKEFONTFILE 157705 . 161597) (STRIKECSINFO 161599 . 165055)) - (165058 166897 (FONTDESCRIPTOR.DEFPRINT 165068 . 166419) (FONTCLASS.DEFPRINT 166421 . 166895)) ( -182093 182415 (\CREATEKERNELEMENT 182093 . 182415)) (182417 182545 (\FSETLEFTKERN 182417 . 182545)) ( -182671 183718 (\FGETLEFTKERN 182681 . 183716)) (183762 187272 (\CREATECHARSET 183772 . 185523) ( -\INSTALLCHARSETINFO 185525 . 187270)) (188427 190179 (\FONTRESETCHARWIDTHS 188437 . 190177))))) + (FILEMAP (NIL (9139 18658 (CHARWIDTH 9149 . 9934) (CHARWIDTHY 9936 . 11306) (STRINGWIDTH 11308 . 12401 +) (\CHARWIDTH.DISPLAY 12403 . 12816) (\STRINGWIDTH.DISPLAY 12818 . 13242) (\STRINGWIDTH.GENERIC 13244 + . 18656)) (18659 25041 (DEFAULTFONT 18669 . 20502) (FONTCLASS 20504 . 22666) (FONTCLASSUNPARSE 22668 + . 23567) (FONTCLASSCOMPONENT 23569 . 24078) (SETFONTCLASSCOMPONENT 24080 . 25039)) (25715 38447 ( +FONTCREATE 25725 . 34992) (\FONT.SYMBOLMEMB 34994 . 35224) (\FONT.SYMBOLASSOC 35226 . 36384) ( +\FONT.COMPARESYMBOL 36386 . 38445)) (38486 43110 (FONTASCENT 38496 . 38664) (FONTDESCENT 38666 . 38935 +) (FONTHEIGHT 38937 . 39123) (FONTPROP 39125 . 42568) (\AVGCHARWIDTH 42570 . 43108)) (43157 55796 ( +GETCHARBITMAP 43167 . 46057) (PUTCHARBITMAP 46059 . 54116) (MOVECHARBITMAP 54118 . 55794)) (55797 +140336 (FONTCOPY 55807 . 61115) (FONTSAVAILABLE 61117 . 66322) (FONTFILEFORMAT 66324 . 67948) (FONTP +67950 . 68249) (FONTUNPARSE 68251 . 70815) (SETFONTDESCRIPTOR 70817 . 72526) (CHARCODEP 72528 . 72889) + (EDITCHAR 72891 . 73320) (\STREAMCHARWIDTH 73322 . 77486) (\UNITWIDTHSVECTOR 77488 . 77851) ( +\CREATEDISPLAYFONT 77853 . 78606) (\CREATECHARSET.DISPLAY 78608 . 81524) (\CREATE-REAL-CHARSET.DISPLAY + 81526 . 88430) (\BUILDSLUGCSINFO 88432 . 89875) (\SEARCHDISPLAYFONTFILES 89877 . 91810) ( +\SEARCHFONTFILES 91812 . 95123) (\FINDFONTFILE 95125 . 96316) (\FONTSYMBOL 96318 . 96968) ( +\DEVICESYMBOL 96970 . 97839) (\FONTFACE 97841 . 105031) (\FONTFACE.COLOR 105033 . 111953) ( +\FONTFILENAME 111955 . 115370) (\FONTFILENAME.OLD 115372 . 118321) (\FONTFILENAME.NEW 118323 . 120580) + (\FONTINFOFROMFILENAME 120582 . 123696) (\FONTINFOFROMFILENAME.OLD 123698 . 125975) (\GETFONTDESC +125977 . 126368) (\COERCEFONTDESC 126370 . 131755) (\LOOKUPFONT 131757 . 133101) (\LOOKUPFONTSINCORE +133103 . 135176) (\READDISPLAYFONTFILE 135178 . 140334)) (141239 157963 (\READSTRIKEFONTFILE 141249 . +145451) (\SFMAKEBOLD 145453 . 147849) (\SFMAKEITALIC 147851 . 150754) (\SFMAKEROTATEDFONT 150756 . +152157) (\SFROTATECSINFO 152159 . 152796) (\SFROTATEFONTCHARACTERS 152798 . 153178) ( +\SFFIXOFFSETSAFTERROTATION 153180 . 155319) (\SFROTATECSINFOOFFSETS 155321 . 156590) (\SFMAKECOLOR +156592 . 157961)) (157964 165326 (WRITESTRIKEFONTFILE 157974 . 161866) (STRIKECSINFO 161868 . 165324)) + (165327 167166 (FONTDESCRIPTOR.DEFPRINT 165337 . 166688) (FONTCLASS.DEFPRINT 166690 . 167164)) ( +183533 183855 (\CREATEKERNELEMENT 183533 . 183855)) (183857 183985 (\FSETLEFTKERN 183857 . 183985)) ( +184111 185158 (\FGETLEFTKERN 184121 . 185156)) (185202 188712 (\CREATECHARSET 185212 . 186963) ( +\INSTALLCHARSETINFO 186965 . 188710)) (189867 191619 (\FONTRESETCHARWIDTHS 189877 . 191617))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index 4f13ebbeed9682d7f0e5877b330bd9bdad7c37e0..3fed0a8c7783aa3409f29b267fd38d49f9d0e62e 100644 GIT binary patch delta 1212 zcmah|&1)1{5GRAK@x_lglikJmk+Ks*H#);~XJ#^)jUQw8>#?=dJ#_aZ2E&qUl0#Ty zf*KJ-BI`*I6zgi{BOijeO9HtFD)<+8@gjKJW!Z}tZ-N)=%?#R#ve4aB)%(@2epU7Q z_1}@V|3>bOEUKCKnT3mSEvcnJP3O|7Tq-SrEKSbM&d*$!o`SiHAi?z^ZrFVE#^B|- zg-esumyesS6C{4oGzFwELo%6D>FJk%NxC~!v}_(X=`$t44DpyH+lDYcv6x6mFg0<7 z3Vnm9Z$MI*EC_Uu=L2qh3Hq$}yZS&K=Hz{VPS>Pe0GFxLau!~A;3 zB2kznM-MF5@u7)4%RPtNe26;%jG4q^b2AV@0VY_Ze!WSR076W|NjR?QG$Q<*Mq zMveV2LPG_HPnLS|)zZlb1N^b<^(3i(LY=Y#9}C}6En1pK9ft8)hJ(xei;${?uq+H#Q+RK=qa}lD%j*Zk4`%a#7wbxi zR&3174_Wpo&H4OFCth7SLyf&y>A=?2J)yU&jeQn_+Ui(>LAFVdA1;WBBbE`I2GMvk zE`r?AUBhw;_;fYfTJMq$@x$ssx2*fVT`GK%qWfQ~W0+byg5zu2PGGt(exsu27X8ip YYwg=X{-2wNHy?N4wdlfT|N5cGN1=OQ1^@s6 delta 850 zcmb7CO=uHA6eg)Zbz5!Pja2-h!wQnvZjxQnCRs~h+ucp4O|x-#+ZYfvCJU`3O=;sn zN(tymJgB^zwCS#GqNrdYM-PGrJ$UpYo<#8`c=RUDq?dvo^e{7z_vU@y_r96$-@G5c zcpv2INZ>X5Ixj}VQ6z|x7?%WrLjkT>tt>B=?GmakAr7r6=FIx|LbYNiD}`DuiI-~j zN_la0Ia#qwW&2igwR&@8(@2NJt3rn1Ccz!4^M} zC;BV31rAA*Q*tJyn!Kf>z`Sgjh)zgmFoP(dWlWSau%()ofoD`&q1u8-${OlC*5^!K zAu16kBzVOxQY#42s3eX`LX1Pqo~!5o*;b*w;hppO6l`YGa-Px!i3$dO-5G=twi|Bj z77ox1JYq*Y47_Cn@Pi#E(XjsLVc9(e##RCh_jFf+WG}jB;N8|Rjf*?99fiF8|r{|NS!h6Tp zJBFCR1hz~RLNSmX7BVhR3Vm?TJql|s3(wp*e0A4}h#|m@9s;rXI0pXha2JEd;L7%( zCr);?k0I_GrfT7grjy?Z?xx=ph0ohB4{P!)PUjK4*f~ij-I<2|rk_NqCI^?A{bUXG zWObaeRHI|j?dD}3#c4=wljlFJ0-m;p W3BiY!*dBP|JJPf7725LdbMJ2xeF;(k From 2f881df57114fbae4ecdbeadb1f4f46eb4ea046a Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 16 Jun 2025 22:37:32 -0700 Subject: [PATCH 4/4] Upload MEDLEYFONTFORMAT.TEDIT --- docs/internal/MEDLEYFONTFORMAT.TEDIT | Bin 0 -> 11797 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 docs/internal/MEDLEYFONTFORMAT.TEDIT diff --git a/docs/internal/MEDLEYFONTFORMAT.TEDIT b/docs/internal/MEDLEYFONTFORMAT.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..db635f6a9432557865cf883d070a652e864593f2 GIT binary patch literal 11797 zcmeHNU2_{}6_%3#jl$>f4a4wGTL!tcRof(KC^PLS@;X@}ORls|8lW?*rM11uYFF&8 zVhqC!7hLrp@B_HvhI=lVVTNn|4OiuP&ikQV$!?R<3ohy=@#@|4o^#%Fp7Zsp`_Uwc z&adx#yFKsm-k=}s4Tk%jpt;j*-fT9vo6VIsSi_sU=Wi)B%u@9roF!q}3{K-hO|tQP z8l|O5!lG2sBrc_Lc zMYGLf7LDWMc&vozILoJDsqjk`WtPY3i7HRAH`On|QH`^-4C54%<5Y$ClOM%p9_HtY z$J_Nr-JyRF42EhFmLa(0&}5!R8=##C<2(u{nlU6*Imc<4sc@N1^qYD7EKGQ8yrwqL z>m*LYq^(p?`KZRw<|tBOQAE?D1PW3j)YUrR^KqU{v3RbEY@Uy!Le$~sN%SlpL&a$} zfi3jWrqMLZ&$Zf+nyMmvrr%J9q6G6WpQx#r@fb!SHy96EbyR@^!sg@CFb~IN1Zzg6 z)sKeNjKbP(IB7#2%}dZei}EnRIaQe8*Rh=R#PU2_KOr)FBFSuuEBu<4wehL<_ z_Bbpey%qz-tq9>I~b!nvSUhiU5t%P3_BNWC_{`d+p>3>!H`#)tt@2g?SyW z?Pja8qoRz6Q9QTm-tP=ygZ^No2El!ANM#R(gM-of^<)+9!cQD z<-D|r*&GA6YL;iSC@*7J1X8KG3B#)42^<4mQvA43<9VJlgqP5E76agjSvrvV#m7~f z!6qrt0+GNf@CdG0>hyXWDx;~+Vh3j(d$dJ(lp%(m%wZ&2%@_*1KUy@S1m~gGmc(ud zpER5b(8*I$rB!`3!;qwICa#F7kk|!EgOar97*CX z=0}ql{y`c!SDO57&C0OQ99rRoHiO4^{n0_MBh_cuA9`IRXWtvGLq>TjT#ZI5`Yn7= z(1;orm5u5`cHVn|*B|+V{%9Tc>!2`2tW0Gzon=v+HA9|D2s6(&&oH%bT|v3P>EfOA#lDpvumDP>*lo9dB~%PSQhD{a}~~* z^OzMkyAV%<=oj=Wu}O{7`Sb`Wz!bV=%)tNyP%m(A9VdVkY7u>kN`=U&Bc55E+GKef zDRo|GSTA-0v1l5!N|$7|AGf-_&S>O!)tzt z)C(Z`w&AvQXLElz-0W_(?H-3$!*&l|d=8z~7m<3QS{0q%zBF*^TCJ+oZtk)9Ahhc_ z-PL#9QNfZS0fP+2mc^j3nkC`oO6o(@5eecDqBa3=P<~zEt(BWavR)}P%rmv}5`b$} zESXopeMwqm_0Gb*d0LmVIsb*N>z36|{W338dm zk!!(fSl1ovVymMbLrun)?ibK!qA$hHdibv7^JQzWR4thS-jH)ILKz)jf~FGO*!ed0t~oLdg>^gD%4?A zeiXb#Az>3L{mh~~0zkq))O|zic%CGZDbSur3XP`Zd!eTo)~y10>5r-(g1E~c(_Wln5sD1je(Zz=Go`z)*T zxHw(G0wx7cJxO#Dj?dL782S%9v0aB%NKbq4Fx*2k5Wrm|m%u~j`OQ2+VXUfQnk(IF zGO5*~rrr_X^8%A)P__f`+*f;@eZTiujr?DDc?I0!lc+6T4kJ@oO}Y`8E$XiD?m z@9zzk#!H^XzBY5-iYau%Lr22=oZT$65!0Qbz-UeUz_mtQSh(V&7HW8R+2b<3SY_uOg=WD5ZjwcrUz!c)rkdH12INt098_wKJTws z6Dl2>WDXboaH);`D8+W{1NXdlcHQ(&_3+O*$Kfgq_)3 zMYsS-a#oxXqk+s5^;{+b-m0ZhgMfE*CRNtu7a}GgLfNM1aZ|!HCC({T%p(ISh}>Xm zE;laF)CdMtx*_6@J*SHD9GgEjYggMzdM&NaG|U8|ixCaRi+8`1fV+5A$z z%zl=w)yvdPQ}9dINjt*dXKG^!uo_>Gl>Y-*X+6;H=d zdXOA_DCedr>d3RGSTv?u4~`fFz2ps&E+UdSheV6bx|lGFvQBdwk!kK=gjNn#tw|lU zgBbM)X*<75$7?aMDF~f~G3o?v;dGJGl`;vBqC_N63vvO>;r_5*L-ef*u6g!d4e536 zdOame-b1hN?=irG#|NIe+Z%Kr^u1nCzg>B>xErDXDHO8ZG~CigRV%m2{I^{pWq3w9H5vslAKo`XNqb%stW$3=>G z)A1w+=!Yx9S%`a`@f`EDv`WGTT6B8;NK)wmAN1HLmaO=lSHWoAfvRyfo#Dz;dJ72R z{Tsp|n`4Z}utR(q!jmYKTTY&q_MvU4beQ0B3Z#n$4WK$0`hAFon6uM(dHcT`>qNwj^llE@o$)uf$Hg2s=sR-?7tziuV41=fcHu zn2yDxA;Tx%#5^uH&6A1xi60r z+`l5V*qc_3mZKyaKjqB`f>Gcj3u=msB)J6;pUh6r3%NQx%W_n9@rqdbgf}jyynZb; z(yDj5VwJiQ7ESPkyMmOa3D*t!<^tI($xbK?xJ@J8>hh}rCm7~u>bYq0)qOIKGC)p{ zI}VLC^k7AN1a>Df?BQz2iCQ|?QV@bwtB>g$?b2d&(2WzmBS5I>XLgTy(wsGXAW?x}9O*_wRAgz1?+bR?VByAw|nqWnkp@ANnKzE_#!}-kutHJzUZrK#@Q` zqa_Kj;O*+SoSwF~>@c-I*!6~eHF)R^dw$XLE+wc?;UjH$`)Di-eIpZ zRHNPi)zf}@v$lp8&~;{ zA-RHgH|`G)dtRHDU46b0YD+|qe>y}|MC5A_U1?CEOIcf@kCbnT7~)^WUw1T~{588E z=g~I4(zu3I@eCJgC&j{*zu7(1jHKV-g5AsCf98TU4u5~gF1*4A?r~h@;d5A_GisYi zCbUoN8@J-y6>b!oAJ`Q~vtd_+F_#Ow;%G*8MU2E{!A3>(wZB>tx<*9(+pdtB3JmQ6 zK3tI_$O=#9R(`fZL(dBF9v?{TY+~6sk}s2l>iwDz74;h5whQ6}k~l8%K>b!ME41X| z&h)Zn<4p7F%E||J#qE-mPCjnew=4~hz||HPEH+5`buQHQJcq(xS=scyU2&dsY@9M~ zh0qsm+=?@(!;Rx3uWAa)8Mxy3bggv9=g_V=>3^~-)|-D>UT{(I2H$X_(@!2Q^xf;0 zi&bXr*LKC){JUJJ+Wb+Kf(LPK`V!wfr{o`5F7Ajf#H=n0#*XHPc9*01rd@F~fnBkt zk`qu-iGb(SkMwn9-CkK)rEyMxwRP|c5=bceQSI-o@DaO_Ms|_L?ULx=%GQhQl7n(r zZ)KMQ#j31#NX%W%ltRoEx67iUmZhosKk>JgOPnbLW6x=ImrI-q&UpesE?2FkbrmB~ z3FlxJh>p+P>gQIvD=SY{R{pTE@<+R39qiO`iR|~5#ICG4XxmLL(Y{E?+_ik2Ddd3% pcPj^$#$_OvRvnGYcGQL?N_&@Ib-nfEd;UKfjqhiT|NQRn{{?^kYfu0H literal 0 HcmV?d00001