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>
This commit is contained in:
Matt Heffron
GitHub
@@ -1,21 +1,26 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "29-Apr-87 22:43:49" {ERIS}<LISPUSERS>LYRIC>FONTSAMPLER.;4 7992
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS FontSample)
|
||||
(FILECREATED " 2-Feb-2025 22:56:24" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 8799
|
||||
|
||||
previous date%: "29-Apr-87 22:41:24" {ERIS}<LISPUSERS>KOTO>FONTSAMPLER.;6)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FontTable)
|
||||
|
||||
:PREVIOUS-DATE "29-Apr-87 22:43:49" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
|
||||
)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1987, 2025 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTSAMPLERCOMS)
|
||||
|
||||
(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable)
|
||||
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
FONT))))
|
||||
(RPAQQ FONTSAMPLERCOMS
|
||||
((FNS FontSample FontSampleFaked FontTable)
|
||||
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
FONT))))
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
@@ -55,94 +60,113 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
|
||||
(* ; "Edited 2-Feb-2025 22:50 by mth")
|
||||
(* edited%: "29-Apr-87 22:36")
|
||||
(LET* ((Family (FONTPROP Font 'FAMILY))
|
||||
(Face (FONTPROP Font 'FACE))
|
||||
(Size (FONTPROP Font 'SIZE))
|
||||
(Title (CONCAT " " Size "pt " (L-CASE Family T)
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set ")))
|
||||
(printout T Title |.I0.8| CharacterSet "Q")
|
||||
(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))
|
||||
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
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(TIMES 8.0 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 9.7 InchesToPrinterUnits)
|
||||
(TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 1.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DSPFONT Font Stream)
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
|
||||
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
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS))
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)
|
||||
Stream))
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 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")
|
||||
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
|
||||
'HOST)
|
||||
'LPT)
|
||||
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.5 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
|
||||
'DEVICE)
|
||||
(FILENAMEFIELD (FULLNAME Stream)
|
||||
'NAME))
|
||||
T)
|
||||
", "
|
||||
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
|
||||
(if FormFeed
|
||||
then (DSPNEWPAGE Stream))
|
||||
(printout T " done." T])
|
||||
(LET*
|
||||
[(Family (FONTPROP Font 'FAMILY))
|
||||
(Face (FONTPROP Font 'FACE))
|
||||
(Size (FONTPROP Font 'SIZE))
|
||||
(Title (CONCAT " " Size "pt " (L-CASE Family T)
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set "))
|
||||
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
|
||||
'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]
|
||||
(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))
|
||||
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))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(TIMES 8.0 InchesToPrinterUnits)
|
||||
(TIMES 9.25 InchesToPrinterUnits)
|
||||
(DSPSCALE NIL Stream)
|
||||
'PAINT Stream)
|
||||
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 9.7 InchesToPrinterUnits)
|
||||
(TIMES 0.6 InchesToPrinterUnits)
|
||||
(TIMES 1.25 InchesToPrinterUnits)
|
||||
(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)
|
||||
do
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits)
|
||||
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))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS))
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 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")
|
||||
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
|
||||
'HOST)
|
||||
'LPT)
|
||||
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.5 InchesToPrinterUnits)
|
||||
Stream)
|
||||
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
|
||||
'DEVICE)
|
||||
(FILENAMEFIELD (FULLNAME Stream)
|
||||
'NAME))
|
||||
T)
|
||||
", "
|
||||
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
|
||||
(if FormFeed
|
||||
then (DSPNEWPAGE Stream))
|
||||
(printout T " done." T])
|
||||
)
|
||||
|
||||
(RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
FONT)
|
||||
)
|
||||
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987))
|
||||
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987 2025))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763))
|
||||
(FILEMAP (NIL (706 8566 (FontSample 716 . 2171) (FontSampleFaked 2173 . 2982) (FontTable 2984 . 8564))
|
||||
)))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/FONTSAMPLER.LCOM
Normal file
BIN
lispusers/FONTSAMPLER.LCOM
Normal file
Binary file not shown.
Reference in New Issue
Block a user