github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-05 15:44:25 +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
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) (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" :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 (FontSample
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor) [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-Dec-2025 11:06 by mth")
(* ; "Edited 5-Feb-2025 17:02 by mth") (* ; "Edited 5-Feb-2025 17:02 by mth")
(* ; "Edited 29-Apr-87 22:03") (* ; "Edited 29-Apr-87 22:03")
@@ -31,12 +31,10 @@
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList] [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList]
(InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream))) (InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream)))
(LastFont (CAR (LAST FontList))) (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] (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)) (DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream))
Stream) Stream)
(for Font in FontList do (for Font in FontList do
@@ -63,11 +61,24 @@
(* ;; (* ;;
 "Exclude any CharacterSet known to reference the SlugCharsetInfo")  "Exclude any CharacterSet known to reference the SlugCharsetInfo")
(SETQ FontCharacterSets (for CS in FontCharacterSets (CL:WHEN SlugCharsetInfo
unless (EQ SlugCharsetInfo
(\GETCHARSETINFO Font (* ;;
CS))  "Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset")
collect CS))
(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 (for CharacterSet in FontCharacterSets
bind (LastCharacterSet _ (CAR (LAST FontCharacterSets))) bind (LastCharacterSet _ (CAR (LAST FontCharacterSets)))
do (FontTable Font CharacterSet Stream do (FontTable Font CharacterSet Stream
@@ -93,7 +104,7 @@
(FontTable (FontTable
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor) [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-Dec-2025 11:09 by mth")
(* ; "Edited 5-Feb-2025 17:03 by mth") (* ; "Edited 5-Feb-2025 17:03 by mth")
(* ; "Edited 3-Feb-2025 20:07 by mth") (* ; "Edited 3-Feb-2025 20:07 by mth")
@@ -106,10 +117,10 @@
" " " "
(L-CASE Face T) (L-CASE Face T)
" Character set ")) " Character set "))
(StreamType (IMAGESTREAMTYPE Stream))
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE) [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
'DISPLAY) 'DISPLAY)
(NOT (EQ (IMAGESTREAMTYPE Stream) (NOT (EQ StreamType 'DISPLAY]
'DISPLAY]
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT) [RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
(FONTPROP Font 'HEIGHT] (FONTPROP Font 'HEIGHT]
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits)) (XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
@@ -174,8 +185,7 @@
'PAINT Stream) 'PAINT Stream)
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream)) (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0 (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0
to 15 bind [RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream) to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS]
'(DISPLAY INTERPRESS]
do do
[for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter [for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
from 0 to 15 from 0 to 15
@@ -240,6 +250,6 @@
FONT) FONT)
) )
(DECLARE%: DONTCOPY (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 STOP

BIN
lispusers/FONTSAMPLER.LCOM
View File

Binary file not shown.