github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Fixed unloaded charset didn't display.

Browse Source 
Checking for charset *known* to be EQ to the SLUG charset, didn't verify that the font *had* a SLUG charset, so was comparing to NIL, which excluded *all* unloaded charsets.
This commit is contained in:
Matt Heffron 2025-12-09 14:06:38 -08:00
parent fd7f50c56f
commit 32c52cd539
2 changed files with 30 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
lispusers/FONTSAMPLER
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Dec-2025 22:17:11" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;7 13846
(FILECREATED " 9-Dec-2025 14:00:20" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 14236
:EDIT-BY "mth"
:CHANGES-TO (FNS FontSample FontTable FontSampleFaked)
:CHANGES-TO (FNS FontTable FontSample)
:PREVIOUS-DATE " 5-Dec-2025 11:09:30" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
:PREVIOUS-DATE " 8-Dec-2025 22:17:11" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
)
@ -21,7 +21,7 @@
(FontSample
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor)
(* ; "Edited 8-Dec-2025 22:15 by mth")
(* ; "Edited 9-Dec-2025 13:48 by mth")
(* ; "Edited 5-Dec-2025 11:06 by mth")
(* ; "Edited 5-Feb-2025 17:02 by mth")
(* ; "Edited 29-Apr-87 22:03")
@ -31,12 +31,10 @@
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList]
(InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream)))
(LastFont (CAR (LAST FontList)))
[CharacterSets (if (LISTP CharacterSets)
then CharacterSets
elseif (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING))
then CharacterSets
else (LIST (OR CharacterSets 0]
(AllCharacterSets (CONSTANT (for CS from 0 to 255 collect CS]
(CL:UNLESS [OR (LISTP CharacterSets)
(MEMB CharacterSets '(T :INCORE :ALL :INTERESTING]
(SETQ CharacterSets (LIST (OR CharacterSets 0))))
(DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream))
Stream)
(for Font in FontList do
@ -63,11 +61,24 @@
(* ;;
 "Exclude any CharacterSet known to reference the SlugCharsetInfo")
(SETQ FontCharacterSets (for CS in FontCharacterSets
unless (EQ SlugCharsetInfo
(\GETCHARSETINFO Font
CS))
collect CS))
(CL:WHEN SlugCharsetInfo
(* ;;
 "Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset")
(SETQ FontCharacterSets
(for CS in FontCharacterSets
unless (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS))
collect CS)))
(* ;;
 "Probably ought to report charsets eliminated by the above.")
(* ;; " At least report if NO charsets remain for this font.")
(CL:UNLESS FontCharacterSets (printout T
"All requested character sets are empty for this font: "
Font T))
(for CharacterSet in FontCharacterSets
bind (LastCharacterSet _ (CAR (LAST FontCharacterSets)))
do (FontTable Font CharacterSet Stream
@ -93,7 +104,7 @@
(FontTable
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor)
(* ; "Edited 8-Dec-2025 22:05 by mth")
(* ; "Edited 9-Dec-2025 13:23 by mth")
(* ; "Edited 5-Dec-2025 11:09 by mth")
(* ; "Edited 5-Feb-2025 17:03 by mth")
(* ; "Edited 3-Feb-2025 20:07 by mth")
@ -106,10 +117,10 @@
" "
(L-CASE Face T)
" Character set "))
(StreamType (IMAGESTREAMTYPE Stream))
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
'DISPLAY)
(NOT (EQ (IMAGESTREAMTYPE Stream)
'DISPLAY]
(NOT (EQ StreamType 'DISPLAY]
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
(FONTPROP Font 'HEIGHT]
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
@ -174,8 +185,7 @@
'PAINT Stream)
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0
to 15 bind [RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream)
'(DISPLAY INTERPRESS]
to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS]
do
[for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
from 0 to 15
@ -240,6 +250,6 @@
FONT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (671 13683 (FontSample 681 . 4890) (FontSampleFaked 4892 . 5850) (FontTable 5852 . 13681
(FILEMAP (NIL (655 14073 (FontSample 665 . 5357) (FontSampleFaked 5359 . 6317) (FontTable 6319 . 14071
)))))
STOP

BIN
lispusers/FONTSAMPLER.LCOM
View File

Binary file not shown.