Skip to content

Commit 1f317d3

Browse files
MattHeffronrmkaplan
MattHeffron
and
rmkaplan
authored
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 <ron.kaplan@post.harvard.edu>
1 parent 86f5aad commit 1f317d3

File tree

5 files changed

+114
-90
lines changed

5 files changed

+114
-90
lines changed

‎lispusers/FONTSAMPLER‎

Lines changed: 114 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,26 @@
1-
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
2-
(FILECREATED "29-Apr-87 22:43:49" {ERIS}<LISPUSERS>LYRIC>FONTSAMPLER.;4 7992
1+
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
32

4-
changes to%: (FNS FontSample)
3+
(FILECREATED " 2-Feb-2025 22:56:24" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 8799
54

6-
previous date%: "29-Apr-87 22:41:24" {ERIS}<LISPUSERS>KOTO>FONTSAMPLER.;6)
5+
:EDIT-BY "mth"
76

7+
:CHANGES-TO (FNS FontTable)
88

9-
(* "
10-
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
9+
:PREVIOUS-DATE "29-Apr-87 22:43:49" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
10+
)
11+
12+
13+
(* ; "
14+
Copyright (c) 1985, 1987, 2025 by Xerox Corporation.
1115
")
1216

1317
(PRETTYCOMPRINT FONTSAMPLERCOMS)
1418

15-
(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable)
16-
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
17-
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
18-
FONT))))
19+
(RPAQQ FONTSAMPLERCOMS
20+
((FNS FontSample FontSampleFaked FontTable)
21+
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
22+
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
23+
FONT))))
1924
(DEFINEQ
2025

2126
(FontSample
@@ -55,94 +60,113 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
5560

5661
(FontTable
5762
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
63+
(* ; "Edited 2-Feb-2025 22:50 by mth")
5864
(* edited%: "29-Apr-87 22:36")
59-
(LET* ((Family (FONTPROP Font 'FAMILY))
60-
(Face (FONTPROP Font 'FACE))
61-
(Size (FONTPROP Font 'SIZE))
62-
(Title (CONCAT " " Size "pt " (L-CASE Family T)
63-
" "
64-
(L-CASE Face T)
65-
" Character set ")))
66-
(printout T Title |.I0.8| CharacterSet "Q")
67-
(RESETLST (RESETSAVE (RADIX 8))
68-
(for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45
69-
InchesToPrinterUnits
70-
) as Counter
71-
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
72-
do (MOVETO XPosition YPosition Stream)
73-
(PRIN1 Counter Stream))
74-
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5
75-
InchesToPrinterUnits)
76-
as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits
77-
))
78-
do (MOVETO XPosition YPosition Stream)
79-
(PRIN1 Counter Stream)))
80-
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
81-
(TIMES 9.25 InchesToPrinterUnits)
82-
(TIMES 8.0 InchesToPrinterUnits)
83-
(TIMES 9.25 InchesToPrinterUnits)
84-
(DSPSCALE NIL Stream)
85-
'PAINT Stream)
86-
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
87-
(TIMES 9.7 InchesToPrinterUnits)
88-
(TIMES 0.6 InchesToPrinterUnits)
89-
(TIMES 1.25 InchesToPrinterUnits)
90-
(DSPSCALE NIL Stream)
91-
'PAINT Stream)
92-
(DSPFONT Font Stream)
93-
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
94-
as YCounter from 0 to 15 bind (CharacterCode _ 0)
95-
do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45
96-
InchesToPrinterUnits)
97-
as XCounter from 0 to 15
98-
do (MOVETO XPosition YPosition Stream)
99-
(if (AND (NEQ CharacterCode (CHARCODE FF))
100-
(if (MEMB (IMAGESTREAMTYPE Stream)
101-
'(DISPLAY INTERPRESS))
102-
then (OR (AND (IGREATERP CharacterCode 31)
103-
(ILESSP CharacterCode 127))
104-
(AND (IGREATERP CharacterCode 160)
105-
(ILESSP CharacterCode 255)))
106-
else T))
107-
then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256)
108-
CharacterCode)
109-
Stream))
110-
(SETQ CharacterCode (ADD1 CharacterCode)))
111-
(printout T "."))
112-
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
113-
(FTIMES 0.75 InchesToPrinterUnits)
114-
Stream)
115-
(DSPFONT TitleFont Stream)
116-
(printout Stream Title |.I0.8| CharacterSet)
117-
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
118-
(TIMES -0.4 (FONTHEIGHT TitleFont)))
119-
Stream)
120-
(printout Stream "8")
121-
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
122-
'HOST)
123-
'LPT)
124-
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
125-
(FTIMES 0.5 InchesToPrinterUnits)
126-
Stream)
127-
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
128-
'DEVICE)
129-
(FILENAMEFIELD (FULLNAME Stream)
130-
'NAME))
131-
T)
132-
", "
133-
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
134-
(if FormFeed
135-
then (DSPNEWPAGE Stream))
136-
(printout T " done." T])
65+
(LET*
66+
[(Family (FONTPROP Font 'FAMILY))
67+
(Face (FONTPROP Font 'FACE))
68+
(Size (FONTPROP Font 'SIZE))
69+
(Title (CONCAT " " Size "pt " (L-CASE Family T)
70+
" "
71+
(L-CASE Face T)
72+
" Character set "))
73+
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
74+
'DISPLAY)
75+
(NOT (EQ (IMAGESTREAMTYPE Stream)
76+
'DISPLAY]
77+
(CharSetInfo (\GETCHARSETINFO CharacterSet Font T))
78+
(CharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of CharSetInfo))
79+
(CharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of CharSetInfo))
80+
(CharSetRelativeDescent (FQUOTIENT CharSetDescent (IPLUS CharSetAscent CharSetDescent]
81+
(printout T Title .I0.8 CharacterSet "Q" T)
82+
(RESETLST
83+
(RESETSAVE (RADIX 8))
84+
(for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits)
85+
as Counter from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
86+
do (MOVETO XPosition YPosition Stream)
87+
(PRIN1 Counter Stream))
88+
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
89+
as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
90+
do (MOVETO XPosition YPosition Stream)
91+
(PRIN1 Counter Stream)))
92+
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
93+
(TIMES 9.25 InchesToPrinterUnits)
94+
(TIMES 8.0 InchesToPrinterUnits)
95+
(TIMES 9.25 InchesToPrinterUnits)
96+
(DSPSCALE NIL Stream)
97+
'PAINT Stream)
98+
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
99+
(TIMES 9.7 InchesToPrinterUnits)
100+
(TIMES 0.6 InchesToPrinterUnits)
101+
(TIMES 1.25 InchesToPrinterUnits)
102+
(DSPSCALE NIL Stream)
103+
'PAINT Stream)
104+
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
105+
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
106+
as YCounter from 0 to 15 bind (CharacterCode _ 0)
107+
do
108+
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits)
109+
as XCounter from 0 to 15
110+
do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
111+
CharacterCode)))
112+
(MOVETO XPosition YPosition Stream)
113+
(if UseDisplayFontBitmaps
114+
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
115+
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream)))
116+
(BITBLT Glyph 0 0 Stream XPosition (- YPosition (TIMES (CDR ImSize)
117+
118+
CharSetRelativeDescent
119+
))
120+
(CAR ImSize)
121+
(CDR ImSize)
122+
'INPUT
123+
'REPLACE))
124+
else (if (AND (NEQ CharacterCode (CHARCODE FF))
125+
(if (MEMB (IMAGESTREAMTYPE Stream)
126+
'(DISPLAY INTERPRESS))
127+
then (OR (AND (IGREATERP CharacterCode 31)
128+
(ILESSP CharacterCode 127))
129+
(AND (IGREATERP CharacterCode 160)
130+
(ILESSP CharacterCode 255)))
131+
else T))
132+
then (PRINTCCODE CCode Stream]
133+
(SETQ CharacterCode (ADD1 CharacterCode)))
134+
(printout T "."))
135+
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
136+
(FTIMES 0.75 InchesToPrinterUnits)
137+
Stream)
138+
(DSPFONT TitleFont Stream)
139+
(printout Stream Title .I0.8 CharacterSet)
140+
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
141+
(TIMES -0.4 (FONTHEIGHT TitleFont)))
142+
Stream)
143+
(printout Stream "8")
144+
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
145+
'HOST)
146+
'LPT)
147+
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
148+
(FTIMES 0.5 InchesToPrinterUnits)
149+
Stream)
150+
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
151+
'DEVICE)
152+
(FILENAMEFIELD (FULLNAME Stream)
153+
'NAME))
154+
T)
155+
", "
156+
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
157+
(if FormFeed
158+
then (DSPNEWPAGE Stream))
159+
(printout T " done." T])
137160
)
138161

139162
(RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241))
140163
(DECLARE%: EVAL@COMPILE DONTCOPY
164+
141165
(FILESLOAD (LOADCOMP)
142166
FONT)
143167
)
144-
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987))
168+
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987 2025))
145169
(DECLARE%: DONTCOPY
146-
(FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763))
170+
(FILEMAP (NIL (706 8566 (FontSample 716 . 2171) (FontSampleFaked 2173 . 2982) (FontTable 2984 . 8564))
147171
)))
148172
STOP

‎lispusers/FONTSAMPLER.LCOM‎

4.88 KB
Binary file not shown.

‎library/FONTSAMPLE‎ renamed to ‎obsolete/library/IPFONTSAMPLE‎

File renamed without changes.

‎library/FONTSAMPLE.LCOM‎ renamed to ‎obsolete/library/IPFONTSAMPLE.LCOM‎

File renamed without changes.

‎library/FONTSAMPLE.TEDIT‎ renamed to ‎obsolete/library/IPFONTSAMPLE.TEDIT‎

File renamed without changes.

0 commit comments

Comments
 (0)