|
1 | 1 | (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) |
2 | 2 |
|
3 | | -(FILECREATED " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 8777 |
| 3 | +(FILECREATED " 5-Feb-2025 17:03:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;11 9743 |
4 | 4 |
|
5 | 5 | :EDIT-BY "mth" |
6 | 6 |
|
7 | | - :CHANGES-TO (FNS FontTable) |
| 7 | + :CHANGES-TO (FNS FontSample FontTable) |
8 | 8 |
|
9 | | - :PREVIOUS-DATE " 3-Feb-2025 13:06:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;7 |
| 9 | + :PREVIOUS-DATE " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 |
10 | 10 | ) |
11 | 11 |
|
12 | 12 |
|
|
20 | 20 | (DEFINEQ |
21 | 21 |
|
22 | 22 | (FontSample |
23 | | - [LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03") |
| 23 | + [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal) |
| 24 | + (* ; "Edited 5-Feb-2025 17:02 by mth") |
| 25 | + (* edited%: "29-Apr-87 22:03") |
24 | 26 | (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer] |
25 | 27 | (FontList (if (LISTP Fonts) |
26 | 28 | else (CONS Fonts))) |
|
38 | 40 | (NEQ CharacterSet |
39 | 41 | LastCharacterSet |
40 | 42 | )) |
41 | | - TitleFont InchesToPrinterUnits)) |
| 43 | + TitleFont InchesToPrinterUnits Hexadecimal)) |
42 | 44 | finally (CLOSEF Stream]) |
43 | 45 |
|
44 | 46 | (FontSampleFaked |
|
55 | 57 | (CLOSEF Stream]) |
56 | 58 |
|
57 | 59 | (FontTable |
58 | | - [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits) |
| 60 | + [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal) |
| 61 | + (* ; "Edited 5-Feb-2025 17:03 by mth") |
59 | 62 | (* ; "Edited 3-Feb-2025 20:07 by mth") |
60 | 63 | (* edited%: "29-Apr-87 22:36") |
61 | 64 | (LET* |
|
76 | 79 | (YCellSpacing (TIMES 0.5 InchesToPrinterUnits))) |
77 | 80 | (printout T Title .I0.8 CharacterSet "Q" T) |
78 | 81 | (RESETLST |
79 | | - (RESETSAVE (RADIX 8)) |
| 82 | + (RESETSAVE (RADIX (if Hexadecimal |
| 83 | + then 16 |
| 84 | + else 8))) |
80 | 85 | (MOVETO (FTIMES 0.75 InchesToPrinterUnits) |
81 | 86 | (FTIMES 10 InchesToPrinterUnits) |
82 | 87 | Stream) |
83 | 88 | (DSPFONT TitleFont Stream) |
84 | | - (printout Stream Title .I0.8 CharacterSet) |
| 89 | + (if Hexadecimal |
| 90 | + then (printout Stream Title .I0.16 CharacterSet) |
| 91 | + else (printout Stream Title .I0.8 CharacterSet)) |
85 | 92 | (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream) |
86 | 93 | (TIMES -0.4 (FONTHEIGHT TitleFont))) |
87 | 94 | Stream) |
88 | | - (printout Stream "8") |
| 95 | + (printout Stream (if Hexadecimal |
| 96 | + then "16" |
| 97 | + else "8")) |
89 | 98 | (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter |
90 | 99 | from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits)) |
91 | 100 | do (MOVETO XPosition YPosition Stream) |
92 | 101 | (PRIN1 Counter Stream)) |
93 | 102 | (for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter |
94 | 103 | from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits)) |
95 | 104 | do (MOVETO XPosition YPosition Stream) |
96 | | - (PRIN1 Counter Stream))) |
| 105 | + (PRINTNUM (if Hexadecimal |
| 106 | + then '(FIX 2 16 T) |
| 107 | + else '(FIX 3 8)) |
| 108 | + Counter Stream))) |
97 | 109 | (DRAWLINE (TIMES 0.25 InchesToPrinterUnits) |
98 | 110 | (TIMES 9.3 InchesToPrinterUnits) |
99 | 111 | (TIMES 8.0 InchesToPrinterUnits) |
|
139 | 151 | (FTIMES 0.75 InchesToPrinterUnits) |
140 | 152 | Stream) |
141 | 153 | (DSPFONT TitleFont Stream) |
142 | | - (printout Stream Title .I0.8 CharacterSet) |
| 154 | + (if Hexadecimal |
| 155 | + then (printout Stream Title .I0.16 CharacterSet) |
| 156 | + else (printout Stream Title .I0.8 CharacterSet)) |
143 | 157 | (DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream) |
144 | 158 | (TIMES -0.4 (FONTHEIGHT TitleFont))) |
145 | 159 | Stream) |
146 | | - (printout Stream "8") |
| 160 | + (printout Stream (if Hexadecimal |
| 161 | + then "16" |
| 162 | + else "8")) |
147 | 163 | [if (EQ (FILENAMEFIELD (FULLNAME Stream) |
148 | 164 | 'HOST) |
149 | 165 | 'LPT) |
|
169 | 185 | FONT) |
170 | 186 | ) |
171 | 187 | (DECLARE%: DONTCOPY |
172 | | - (FILEMAP (NIL (645 8614 (FontSample 655 . 2106) (FontSampleFaked 2108 . 2917) (FontTable 2919 . 8612)) |
| 188 | + (FILEMAP (NIL (657 9580 (FontSample 667 . 2302) (FontSampleFaked 2304 . 3113) (FontTable 3115 . 9578)) |
173 | 189 | ))) |
174 | 190 | STOP |
0 commit comments