Make the layout orientation, ColumnMajor or not, be selectable.
Fix the row/column labels to correspond to ColumnMajor selection.
This commit is contained in:
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Dec-2025 11:09:30" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;6 12333
|
||||
(FILECREATED " 8-Dec-2025 22:17:11" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;7 13846
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FontSample FontTable)
|
||||
:CHANGES-TO (FNS FontSample FontTable FontSampleFaked)
|
||||
|
||||
:PREVIOUS-DATE " 4-Dec-2025 23:56:07" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;5
|
||||
:PREVIOUS-DATE " 5-Dec-2025 11:09:30" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;1
|
||||
)
|
||||
|
||||
|
||||
@@ -20,7 +20,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor)
|
||||
(* ; "Edited 8-Dec-2025 22:15 by mth")
|
||||
(* ; "Edited 5-Dec-2025 11:06 by mth")
|
||||
(* ; "Edited 5-Feb-2025 17:02 by mth")
|
||||
(* ; "Edited 29-Apr-87 22:03")
|
||||
@@ -72,11 +73,12 @@
|
||||
do (FontTable Font CharacterSet Stream
|
||||
(OR (NEQ Font LastFont)
|
||||
(NEQ CharacterSet LastCharacterSet))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal)))
|
||||
finally (CLOSEF Stream])
|
||||
TitleFont InchesToPrinterUnits Hexadecimal
|
||||
ColumnMajor))) finally (CLOSEF Stream])
|
||||
|
||||
(FontSampleFaked
|
||||
[LAMBDA (FontAsList Printer StreamType) (* N.H.Briggs "27-Apr-87 18:12")
|
||||
[LAMBDA (FontAsList Printer StreamType ColumnMajor) (* ; "Edited 8-Dec-2025 21:19 by mth")
|
||||
(* ; "Edited 27-Apr-87 18:12 by N.H.Briggs ")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(Font)
|
||||
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (LIST TitleFont]
|
||||
@@ -86,11 +88,12 @@
|
||||
(replace FONTSIZE of Font with (CADR FontAsList))
|
||||
(replace FONTFACE of Font with (\FONTFACE (CADDR FontAsList)))
|
||||
(FontTable Font '(0)
|
||||
Stream NIL TitleFont InchesToPrinterUnits)
|
||||
Stream NIL TitleFont InchesToPrinterUnits NIL ColumnMajor)
|
||||
(CLOSEF Stream])
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor)
|
||||
(* ; "Edited 8-Dec-2025 22:05 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")
|
||||
@@ -110,7 +113,8 @@
|
||||
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
|
||||
(FONTPROP Font 'HEIGHT]
|
||||
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits))
|
||||
ColLabelStep RowLabelStep)
|
||||
(printout T Title .I0.8 CharacterSet "Q" T)
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX (if Hexadecimal
|
||||
@@ -129,15 +133,31 @@
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
(if ColumnMajor
|
||||
then (SETQ ColLabelStep 16)
|
||||
(SETQ RowLabelStep 1)
|
||||
else (SETQ ColLabelStep 1)
|
||||
(SETQ RowLabelStep 16))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing 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 (MINUS YCellSpacing) as Counter
|
||||
from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
|
||||
from 0 to (ITIMES ColLabelStep 15) by ColLabelStep bind (YPosition _ (TIMES 9.5
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 1 8 NIL T)
|
||||
else '(FIX 2 8))
|
||||
Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
|
||||
from 0 to (ITIMES RowLabelStep 15) by RowLabelStep bind (XPosition _ (TIMES 0.25
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 2 8)
|
||||
else '(FIX 3 8))
|
||||
Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
@@ -154,33 +174,33 @@
|
||||
'PAINT Stream)
|
||||
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0
|
||||
to 15 bind (CharacterCode _ 0)
|
||||
[RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream)
|
||||
to 15 bind [RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS]
|
||||
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
|
||||
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))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if RangedCodesStreamType
|
||||
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)))
|
||||
do (LET* ((CharacterCode (IPLUS (ITIMES YCounter RowLabelStep)
|
||||
(ITIMES XCounter ColLabelStep)))
|
||||
(CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if RangedCodesStreamType
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
@@ -220,6 +240,6 @@
|
||||
FONT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (655 12170 (FontSample 665 . 4700) (FontSampleFaked 4702 . 5524) (FontTable 5526 . 12168
|
||||
(FILEMAP (NIL (671 13683 (FontSample 681 . 4890) (FontSampleFaked 4892 . 5850) (FontTable 5852 . 13681
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user