From 1f317d34efc9584899289954a72e6be65edc8a71 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 3 Feb 2025 12:30:53 -0800 Subject: [PATCH] Obsolete and rename FONTSAMPLE no R (#2010) * Add back character sets that had characters outside 16 bit plane * Update XCCS-353=SYMBOLS3.TXT Update title line * Update UNICODE.TEDIT * Fix charset names * Reorganized the tables, added requested interfaces * Use a single hash * Top-level array branch beats a single hash * cleanup UNICODE.TRANSLATE macro * Fix slug in outcharfn * Remove a stray line * Another try, would work for raw * Remove duplicates, redo hashing * Getting complete maps in both directions * Initializing * Only the latest file versions * Add back gothic mappings * Enable FONTSAMPLER to display glyphs from DISPLAYFONT (bitmap font) on non-DISPLAY stream (e.g., PDF) Added .LCOM to repository. Corrected PR. * Relocate FONTSAMPLE files to obsolete. * Files renamed. Internal names and documentation were NOT updated. --------- Co-authored-by: rmkaplan --- lispusers/FONTSAMPLER | 204 ++++++++++-------- lispusers/FONTSAMPLER.LCOM | Bin 0 -> 4995 bytes .../library/IPFONTSAMPLE | 0 .../library/IPFONTSAMPLE.LCOM | Bin .../library/IPFONTSAMPLE.TEDIT | Bin 5 files changed, 114 insertions(+), 90 deletions(-) create mode 100644 lispusers/FONTSAMPLER.LCOM rename library/FONTSAMPLE => obsolete/library/IPFONTSAMPLE (100%) rename library/FONTSAMPLE.LCOM => obsolete/library/IPFONTSAMPLE.LCOM (100%) rename library/FONTSAMPLE.TEDIT => obsolete/library/IPFONTSAMPLE.TEDIT (100%) diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER index 3b3b609c..c409c92b 100644 --- a/lispusers/FONTSAMPLER +++ b/lispusers/FONTSAMPLER @@ -1,21 +1,26 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "29-Apr-87 22:43:49" {ERIS}LYRIC>FONTSAMPLER.;4 7992 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS FontSample) +(FILECREATED " 2-Feb-2025 22:56:24" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 8799 - previous date%: "29-Apr-87 22:41:24" {ERIS}KOTO>FONTSAMPLER.;6) + :EDIT-BY "mth" + + :CHANGES-TO (FNS FontTable) + + :PREVIOUS-DATE "29-Apr-87 22:43:49" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;1 +) -(* " -Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1985, 1987, 2025 by Xerox Corporation. ") (PRETTYCOMPRINT FONTSAMPLERCOMS) -(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable) - [VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241] - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - FONT)))) +(RPAQQ FONTSAMPLERCOMS + ((FNS FontSample FontSampleFaked FontTable) + [VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241] + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + FONT)))) (DEFINEQ (FontSample @@ -55,94 +60,113 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved. (FontTable [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits) + (* ; "Edited 2-Feb-2025 22:50 by mth") (* edited%: "29-Apr-87 22:36") - (LET* ((Family (FONTPROP Font 'FAMILY)) - (Face (FONTPROP Font 'FACE)) - (Size (FONTPROP Font 'SIZE)) - (Title (CONCAT " " Size "pt " (L-CASE Family T) - " " - (L-CASE Face T) - " Character set "))) - (printout T Title |.I0.8| CharacterSet "Q") - (RESETLST (RESETSAVE (RADIX 8)) - (for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45 - InchesToPrinterUnits - ) as Counter - from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits)) - do (MOVETO XPosition YPosition Stream) - (PRIN1 Counter Stream)) - (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 - InchesToPrinterUnits) - as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits - )) - do (MOVETO XPosition YPosition Stream) - (PRIN1 Counter Stream))) - (DRAWLINE (TIMES 0.25 InchesToPrinterUnits) - (TIMES 9.25 InchesToPrinterUnits) - (TIMES 8.0 InchesToPrinterUnits) - (TIMES 9.25 InchesToPrinterUnits) - (DSPSCALE NIL Stream) - 'PAINT Stream) - (DRAWLINE (TIMES 0.6 InchesToPrinterUnits) - (TIMES 9.7 InchesToPrinterUnits) - (TIMES 0.6 InchesToPrinterUnits) - (TIMES 1.25 InchesToPrinterUnits) - (DSPSCALE NIL Stream) - 'PAINT Stream) - (DSPFONT Font Stream) - (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits) - as YCounter from 0 to 15 bind (CharacterCode _ 0) - do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 - InchesToPrinterUnits) - as XCounter from 0 to 15 - do (MOVETO XPosition YPosition Stream) - (if (AND (NEQ CharacterCode (CHARCODE FF)) - (if (MEMB (IMAGESTREAMTYPE Stream) - '(DISPLAY INTERPRESS)) - then (OR (AND (IGREATERP CharacterCode 31) - (ILESSP CharacterCode 127)) - (AND (IGREATERP CharacterCode 160) - (ILESSP CharacterCode 255))) - else T)) - then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256) - CharacterCode) - Stream)) - (SETQ CharacterCode (ADD1 CharacterCode))) - (printout T ".")) - (MOVETO (FTIMES 0.75 InchesToPrinterUnits) - (FTIMES 0.75 InchesToPrinterUnits) - Stream) - (DSPFONT TitleFont Stream) - (printout Stream Title |.I0.8| CharacterSet) - (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream) - (TIMES -0.4 (FONTHEIGHT TitleFont))) - Stream) - (printout Stream "8") - [if (EQ (FILENAMEFIELD (FULLNAME Stream) - 'HOST) - 'LPT) - then (MOVETO (FTIMES 0.75 InchesToPrinterUnits) - (FTIMES 0.5 InchesToPrinterUnits) - Stream) - (printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream) - 'DEVICE) - (FILENAMEFIELD (FULLNAME Stream) - 'NAME)) - T) - ", " - (GDATE NIL (DATEFORMAT NO.TIME SPACES] - (if FormFeed - then (DSPNEWPAGE Stream)) - (printout T " done." T]) + (LET* + [(Family (FONTPROP Font 'FAMILY)) + (Face (FONTPROP Font 'FACE)) + (Size (FONTPROP Font 'SIZE)) + (Title (CONCAT " " Size "pt " (L-CASE Family T) + " " + (L-CASE Face T) + " Character set ")) + [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE) + 'DISPLAY) + (NOT (EQ (IMAGESTREAMTYPE Stream) + 'DISPLAY] + (CharSetInfo (\GETCHARSETINFO CharacterSet Font T)) + (CharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of CharSetInfo)) + (CharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of CharSetInfo)) + (CharSetRelativeDescent (FQUOTIENT CharSetDescent (IPLUS CharSetAscent CharSetDescent] + (printout T Title .I0.8 CharacterSet "Q" T) + (RESETLST + (RESETSAVE (RADIX 8)) + (for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits) + as Counter from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits)) + do (MOVETO XPosition YPosition Stream) + (PRIN1 Counter Stream)) + (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits) + as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits)) + do (MOVETO XPosition YPosition Stream) + (PRIN1 Counter Stream))) + (DRAWLINE (TIMES 0.25 InchesToPrinterUnits) + (TIMES 9.25 InchesToPrinterUnits) + (TIMES 8.0 InchesToPrinterUnits) + (TIMES 9.25 InchesToPrinterUnits) + (DSPSCALE NIL Stream) + 'PAINT Stream) + (DRAWLINE (TIMES 0.6 InchesToPrinterUnits) + (TIMES 9.7 InchesToPrinterUnits) + (TIMES 0.6 InchesToPrinterUnits) + (TIMES 1.25 InchesToPrinterUnits) + (DSPSCALE NIL Stream) + 'PAINT Stream) + (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream)) + (for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits) + as YCounter from 0 to 15 bind (CharacterCode _ 0) + do + (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits) + as XCounter from 0 to 15 + do [LET ((CCode (IPLUS (ITIMES CharacterSet 256) + CharacterCode))) + (MOVETO XPosition YPosition Stream) + (if UseDisplayFontBitmaps + then (LET* ((Glyph (GETCHARBITMAP CCode Font)) + (ImSize (BITMAPIMAGESIZE Glyph NIL Stream))) + (BITBLT Glyph 0 0 Stream XPosition (- YPosition (TIMES (CDR ImSize) + + CharSetRelativeDescent + )) + (CAR ImSize) + (CDR ImSize) + 'INPUT + 'REPLACE)) + else (if (AND (NEQ CharacterCode (CHARCODE FF)) + (if (MEMB (IMAGESTREAMTYPE Stream) + '(DISPLAY INTERPRESS)) + then (OR (AND (IGREATERP CharacterCode 31) + (ILESSP CharacterCode 127)) + (AND (IGREATERP CharacterCode 160) + (ILESSP CharacterCode 255))) + else T)) + then (PRINTCCODE CCode Stream] + (SETQ CharacterCode (ADD1 CharacterCode))) + (printout T ".")) + (MOVETO (FTIMES 0.75 InchesToPrinterUnits) + (FTIMES 0.75 InchesToPrinterUnits) + Stream) + (DSPFONT TitleFont Stream) + (printout Stream Title .I0.8 CharacterSet) + (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream) + (TIMES -0.4 (FONTHEIGHT TitleFont))) + Stream) + (printout Stream "8") + [if (EQ (FILENAMEFIELD (FULLNAME Stream) + 'HOST) + 'LPT) + then (MOVETO (FTIMES 0.75 InchesToPrinterUnits) + (FTIMES 0.5 InchesToPrinterUnits) + Stream) + (printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream) + 'DEVICE) + (FILENAMEFIELD (FULLNAME Stream) + 'NAME)) + T) + ", " + (GDATE NIL (DATEFORMAT NO.TIME SPACES] + (if FormFeed + then (DSPNEWPAGE Stream)) + (printout T " done." T]) ) (RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241)) (DECLARE%: EVAL@COMPILE DONTCOPY + (FILESLOAD (LOADCOMP) FONT) ) -(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987)) +(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987 2025)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763)) + (FILEMAP (NIL (706 8566 (FontSample 716 . 2171) (FontSampleFaked 2173 . 2982) (FontTable 2984 . 8564)) ))) STOP diff --git a/lispusers/FONTSAMPLER.LCOM b/lispusers/FONTSAMPLER.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..1288e31544aef520aa83c6c4abf1d8e8e7f359f6 GIT binary patch literal 4995 zcmbtY+ix3b6}OXYo4U8SDF{W~aMqNSU9BU}#d9&J%Ge$!lZ-#)wQG)N=WC8@=N+%+(|ll6R;?wQGL9G74c7^S49z!es~TBl_Y}Kqg*HirTq>1i zD^wsB*;UGroUgU+=jDQ2Bv~#MwUVM{D4TiE+uG@LTbtC|hEVGJ)o}F(UvKxeS~s_v zgTYN_d(hhLcKSOvw_2Os*5jLu{;1#D?cc2VUKCpOz_l9-Uz2l~Egf$msU=x0DMp6w z@3uyJSguQ*ZAxWoYoNyE7Zw&WwAmcsAaATwEENiw+~?j$#(nBGecSQZ!h97Pri^Unt)1Pxp)>WW zN=Y^U4|Php6x%9nZtZkiRH_=OY(OSe+RfeO16U+%4JaUkp9h3SZnHl)HCj9&-iMgV z#n{4lQOMbT&~EjkUa;F?R$klg449Nm;b6Db+yW`_4ctzjO(;;*8FX8Gx`XLLDtf%r zA_tS=RX|IpHg+(T&FbeU@w-$aG1cx~_;v!nhn4;5@;OFbe24v~)5*on$)C69J}pNhfT<@<6l^*oX=h%4LyA zI@KEuFsNvfE-xSj9J^4h`3R8}`_X@H`8TXS^o`i+(wNnSjjcZO78v@cQ;Edn$k65e zY3rn+t+KFi``=mkn@s(qxqJa`{f$j-n8oDP2}e*9$*WUCaw5qkuby$Z$E>u6h7@+6 zfelq-WHnVDH>a%9U8c^ORk4v1$P;Rp$&d+&*;;cWHca{nGcc8pOsJ~=tqCQm$Zc4) z!%D*mBEJF8ftO*UF_!rTM>FW-smYUK%qza~F~Kbvf6OZ+MW$>aM@4zeJ9sX$3Wb6s zoWrx~Hib^9bYsn1cf4voX!wy`iEh9Xbh;Dt`kg@sm4c<5O7A0sRLviR%7s8%4!b zVxFN6S&~EztLofgp*^CIXLQOJ7K*refeH(1ku(`k6mtxi;L8SHwW0`mZq{MAV>f3j z?0l~UOUVUV>OS6SgOpHCD!om{MdG@1Y)xdCaYMs5M}=i5uhPbt{7Hke^E0c25i5&W z{7qAVYZ8Moca|OGKUT=t7AR_sR<}9me5X}y^&hl&nbLkhX?G;)s~Yq}7 zh>7#}E_wc?=l@72r&q;B2Ygpc%n&c}K!=Cj`UmOv&hu^fEB~8j$2z!vCOOL|+t1$m zXqWk|_}sF%%3I}P=3B(wUoMI@4!W1S=j>+>H`7y>{cHZ0Uj6uK;#Hgmz)nwI@vr;D zxWBcwlZn6j^Uu@CSwG{?l|{(Adlmov#n>!Y{cKzC)5$OR*@v5DCh6ap@MoU=#lMjR z#ShK@F7ipUvrjC4zI);5*CnBNerP_l_pU#`+5Pg%PY$|2^ygpx3SvKdxi{N=jh7#F zKJnj=uQ2P+KYD&|{=m<~7e2g~Iq1$hPGS<95HxijU@UKDS+SAt;Vr9P& zV=u%Fs$%ukcoRNmiJ@4boK=ne;Mt)Nk?iI_a@fx-b%;tka#fFxigGSpF)RU}rYJ$pT1{gi=dWME1nL(*u8 z<9GvwSMYRmII0^!YWWK5taJmRjJ}E$%9>-lRUiRy(9ZDEsUs_&8b-Z69!B1d7e|4P zYk*!r^*^zsW`Z+ZQZvkWj;3>fxe@rG6EPsE6?Jx+VwK2KtN+qlwk`}ao_T4*@?<-M5=5O$hs8>G3P@F zpnxpd5n88)7$OxnjQ3PjZUKH21&E~Du-09)yQH8rjUbe46pu$_T^SpJ-WY7)B}QNr zo*)C~2$e{&R=K7mAn};3m~>Y_K6ZYTF~Iu58#*vG zj;;WXP`iL|e6L~w6G}rb0UV6|ML~}S9L6PqEk`sK9nvWDx?UvVKg^(yq0EDh|8Fv&WR%Ym!qa4d?pm4X$ zF{q+Gnt9wx#UD;6rzo?-7%G!u-#u`$DB7s_b>^cH_ksAk3wR*}8i94|)@eRvM_(-B z&j_d6!BL##D0>^uPT3n=6KFiqtmb3a04C3-ZmppWK>NV@3PmM&HS8qgA+sl1P+667 z_(7+3#kCstS4(8yw%kQ_YUDPm!f`8pu)(z8+StnVttuPL@pH4e!+ZRzLwwHW(9;@^ zGkm3Cosal3h1d)>cuS6NU3Xf$z3-wQ+1=^w0%rEMVHgvs27j