diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER index c409c92bb..f3563427e 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 1288e3154..251ae9355 100644 Binary files a/lispusers/FONTSAMPLER.LCOM and b/lispusers/FONTSAMPLER.LCOM differ