From 87d3abc6328b034cd123ac0faa54f7da256427cf Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 4 Feb 2025 17:22:54 -0800 Subject: [PATCH] Yet another attempt to make a clean PR (compared with broken PRs #2007 & #2008 & #2013) --- lispusers/FONTSAMPLER | 70 +++++++++++++++++++------------------ lispusers/FONTSAMPLER.LCOM | Bin 4995 -> 5211 bytes 2 files changed, 36 insertions(+), 34 deletions(-) diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER index c409c92b..f3563427 100644 --- a/lispusers/FONTSAMPLER +++ b/lispusers/FONTSAMPLER @@ -1,19 +1,15 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Feb-2025 22:56:24" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 8799 +(FILECREATED " 3-Feb-2025 20:08:40" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 8777 :EDIT-BY "mth" :CHANGES-TO (FNS FontTable) - :PREVIOUS-DATE "29-Apr-87 22:43:49" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;1 + :PREVIOUS-DATE " 3-Feb-2025 13:06:38" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;7 ) -(* ; " -Copyright (c) 1985, 1987, 2025 by Xerox Corporation. -") - (PRETTYCOMPRINT FONTSAMPLERCOMS) (RPAQQ FONTSAMPLERCOMS @@ -24,7 +20,7 @@ Copyright (c) 1985, 1987, 2025 by Xerox Corporation. (DEFINEQ (FontSample - [LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03") + [LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03") (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer] (FontList (if (LISTP Fonts) else (CONS Fonts))) @@ -60,10 +56,10 @@ Copyright (c) 1985, 1987, 2025 by Xerox Corporation. (FontTable [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits) - (* ; "Edited 2-Feb-2025 22:50 by mth") + (* ; "Edited 3-Feb-2025 20:07 by mth") (* edited%: "29-Apr-87 22:36") (LET* - [(Family (FONTPROP Font 'FAMILY)) + ((Family (FONTPROP Font 'FAMILY)) (Face (FONTPROP Font 'FACE)) (Size (FONTPROP Font 'SIZE)) (Title (CONCAT " " Size "pt " (L-CASE Family T) @@ -74,25 +70,34 @@ Copyright (c) 1985, 1987, 2025 by Xerox Corporation. '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] + [RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT) + (FONTPROP Font 'HEIGHT] + (XCellSpacing (TIMES 0.45 InchesToPrinterUnits)) + (YCellSpacing (TIMES 0.5 InchesToPrinterUnits))) (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)) + (MOVETO (FTIMES 0.75 InchesToPrinterUnits) + (FTIMES 10 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") + (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing 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)) + (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) 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 9.3 InchesToPrinterUnits) (TIMES 8.0 InchesToPrinterUnits) - (TIMES 9.25 InchesToPrinterUnits) + (TIMES 9.3 InchesToPrinterUnits) (DSPSCALE NIL Stream) 'PAINT Stream) (DRAWLINE (TIMES 0.6 InchesToPrinterUnits) @@ -102,25 +107,23 @@ Copyright (c) 1985, 1987, 2025 by Xerox Corporation. (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) + (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) 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 + (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing 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)) + (ImSize (BITMAPIMAGESIZE Glyph NIL Stream)) + (ImWidth (CAR ImSize)) + (ImHeight (CDR ImSize))) + (BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition + (FTIMES ImHeight + RelativeDescent)) + ImWidth ImHeight 'INPUT 'REPLACE)) else (if (AND (NEQ CharacterCode (CHARCODE FF)) (if (MEMB (IMAGESTREAMTYPE Stream) '(DISPLAY INTERPRESS)) @@ -165,8 +168,7 @@ Copyright (c) 1985, 1987, 2025 by Xerox Corporation. (FILESLOAD (LOADCOMP) FONT) ) -(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987 2025)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (706 8566 (FontSample 716 . 2171) (FontSampleFaked 2173 . 2982) (FontTable 2984 . 8564)) + (FILEMAP (NIL (645 8614 (FontSample 655 . 2106) (FontSampleFaked 2108 . 2917) (FontTable 2919 . 8612)) ))) STOP diff --git a/lispusers/FONTSAMPLER.LCOM b/lispusers/FONTSAMPLER.LCOM index 1288e31544aef520aa83c6c4abf1d8e8e7f359f6..251ae93558ed604f2114978b74a1b6222c23d746 100644 GIT binary patch delta 2303 zcmZuzOK%%h6pq`pX_kGu& zzV>tG%ef>wS#qvSG8DrDL**zb$5ESWGy7<2^ZT=-@uk{gW5wAxn}brb(Xtn>xDM1C zu=z{z@dKH|G0)#12rjDg&q_jtI%_G)A#2KQf_ezNsS(*4tIAFiJ0&kPy*ldW`Z zSepr#>RybtpjA)xez>^SyL|IUa;zMsjVN7St&TqE-8J0d-n%#N3}hIF0<)qSG%$E} zWpYWi3DA-p25E`%f^9!ai&2!~p=g=&Cb2YIBL+y!USH(=O52z%10T)BQ(jSt7&dUb zOVLnKirUt+XdRF}-2W?u0 zDYyOMHLr@6pipQo`(Y8G(tO`TpqCI}&TMYfTlHqcbNi4L)w77i-Fn1je?0{i)lzNC zR%{i=%V24_+=L%1kxJQ8Con33u36^Xv}W1piF=W40&bxXyI8?P#c>x~^$(n)v$5nf zS{>!^H^c1iEaR|Wd#Urs;p>^ifeQgT4~OsgZ+Cqhs@sX!!5wR;^L0Ekm`$9HckabM zZyzILWaP03_= zNx#2(P((&o$*~8$h0!hXixAN1T>WufWa-vSrOlq=f{EJISjDCa3V-q3g1-V;|&p96$rQV qTWO$ipSxEAjl;Y)XwG|c*pJu#&R+r8!2bg2+kYqWu|Y%AEm_7_Qf9>(a3`%?c>m!aHk>q^y#dLuoL3E1KKhn0TT4e#DzntCXf)ExooNsLI{o5c9M;)hx+~ApYQ#DzWkE? z;FXUnDQ>n@JwMAaoCqA37o|Ke+}K*CxEo)+Jg!+5)Ebbu@n>=R89h#*q5C_f?B_s{ zRkiyO_4*X2&T3a$vx*$vCGdGc?fy!=MzMF(`~Ds4(g$AXsNlC-)%D9z0+s>a%;#r3 z!#9Ew@oax42P2=3kB(4pjo@E>{9yRmOs6-~<)i5fN9#wLA)`FGduc!<$3~YH_j<=u z^#}EX{}&u^ti4`#bJAQcPfdh&+e_uCP9mbrf&I?cOItf zxe;<%1uA;;?MA!W3Qsar+~(C+RY*)nfJPg=(XXA~_blT5Uh(Ndt9lpcMy+ z7nqHU&F;0tXOrAx2RRrGp6_NSu5;Ab{Jo6!+mH7~zD#KIwWzzv69?@5VROGveAg!? z)($)5@cloM)Oh!YiR{?vx)(uH_@te#Fz%}2A5q>hs8X3S4g(%Ux+3-ny1LVcbsH4>MuRKxn1v&%)>88rvCZEUaI~G5AWA*l2e6v1XColb$>0h zP3Xwh*xgy9x5>$^owbv99vP{KS&LOkdZ?1#CdW|a*quj*y4Rokrz5Bk7#@x-D8g`5 zc@~Pk>lkHMTQET3xWNpw5-b$Mo-2&d=gI0oDk~CLv%2ORAS(=%Ov`XI+bEfaRRmc^ z&WdG)9FTFcV{vCF7m+oTP|^T&cH@e)V_@*D`EJnF7eI4Bo0WT z{4^up)WGSi*dXD4#oi>`V6-d|C&1+!dKTru)gmuNs)4SPq5*;`gKgLa5D?W&8;j)! zo}t;ns*6I*xUgI>gMt-+z^Q;nfcL`{fd;du^< zo>sO@#{eET9E0?A%`y-Z#K#g&=AV#YmWKL*sDkOZD*>j8bD){n4Gw$Srx41X z&WlB7aS+pi>68et0>VukRe0{+O3oj_F4M5lY*goHP*}G6cQVsa6`)TeTgGH)KrloS zeTFD3qaS7t(~%S&Xobe8xe%WPkOV#f*^*fS29z8~2%oVcRxct%oQ4R=MQjL-?nE5! z2+;*xmTVDG(b85i$IH>`8NQzbUQ%OY9-jv`LVa8@#QOwrIA!V_KAURzE=a&(t<+G1 z!?cw-2ER<7fh!!n7%XlE{RWM&kNyUc_EKePDT{S=J>vRN2Yk(TEyDwyxT~JIuoys= ku2fsicR_Eqt~6T+)XfH7qvDw1Ka2r?3*>SM$Fvgv0pC0o$^ZZW