diff --git a/library/FONTSAMPLE b/library/FONTSAMPLE index 24b19802a..ded376dbf 100644 --- a/library/FONTSAMPLE +++ b/library/FONTSAMPLE @@ -1,30 +1,38 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Jun-90 15:51:10" {DSK}local>lde>lispcore>library>FONTSAMPLE.;2 16609 - changes to%: (VARS FONTSAMPLECOMS) +(FILECREATED " 1-Feb-2025 11:29:39" {LIB}FONTSAMPLE.;2 17665 - previous date%: "10-Jan-87 15:47:00" {DSK}local>lde>lispcore>library>FONTSAMPLE.;1) + :EDIT-BY "mth" + + :CHANGES-TO (FNS FNT.DISPLOOK) + + :PREVIOUS-DATE " 1-Feb-2025 10:22:33" {LIB}FONTSAMPLE.;1) (* ; " -Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1985-1987, 1990, 2025 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT FONTSAMPLECOMS) -(RPAQQ FONTSAMPLECOMS ((MACROS IDIVUP) - (VARS FNT.PANEL FNT.FNAME FNT.INFOFONT FNT.OUTFTEXT) - (FNS FNT.MAKEBOOK FNT.LESSP FNT.SORTP FNT.DISPLOOK FNT.DISPTBLE - FNT.DISPDSCR FNT.NARRDSCR FNT.DISPINIT FNT.FACEMAP FNT.SIZEMAP - FNT.MAKENAME FNT.MAKEWIND FNT.FILEMAP FNT.FINDALL FNT.FLST))) +(RPAQQ FONTSAMPLECOMS + ((MACROS IDIVUP) + (VARS FNT.PANEL FNT.FNAME FNT.INFOFONT FNT.OUTFTEXT) + (FNS FNT.MAKEBOOK FNT.LESSP FNT.SORTP FNT.DISPLOOK FNT.DISPTBLE FNT.DISPDSCR FNT.NARRDSCR + FNT.DISPINIT FNT.FACEMAP FNT.SIZEMAP FNT.MAKENAME FNT.MAKEWIND FNT.FILEMAP FNT.FINDALL + FNT.FLST) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) + EXPORTS.ALL)) + (PROP (MAKEFILE-ENVIRONMENT) + FONTSAMPLE))) (DECLARE%: EVAL@COMPILE (PUTPROPS IDIVUP DMACRO ((INUMEXPR IDENEXPR) - (LET (INUM IDEN) - (SETQ INUM INUMEXPR) - (SETQ IDEN IDENEXPR) - (IQUOTIENT (IPLUS INUM IDEN -1) - IDEN)))) + (LET (INUM IDEN) + (SETQ INUM INUMEXPR) + (SETQ IDEN IDENEXPR) + (IQUOTIENT (IPLUS INUM IDEN -1) + IDEN)))) ) (RPAQQ FNT.PANEL @@ -42,7 +50,7 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (RPAQQ FNT.FNAME {DSK}FONTBOOK.IP) (RPAQQ FNT.INFOFONT (TERMINAL 8 (MEDIUM REGULAR REGULAR) - 0)) + 0)) (RPAQQ FNT.OUTFTEXT "abcdefghijkl ABCDEFGHIJKL") (DEFINEQ @@ -131,10 +139,11 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (RETURN (ALPHORDER KEY1 KEY2]) (FNT.DISPLOOK - [LAMBDA (FILEDSC FONTDSC) (* FS "24-Jan-86 18:19") - - (* * uses "private" global vars fnt.infofont and fnt.outftext to generate - sample string) + [LAMBDA (FILEDSC FONTDSC) (* ; "Edited 1-Feb-2025 11:29 by mth") + (* FS "24-Jan-86 18:19") + + (* * uses "private" global vars fnt.infofont and fnt.outftext to generate sample + string) (LET NIL (DSPFONT FNT.INFOFONT FILEDSC) (TERPRI FILEDSC) @@ -146,14 +155,21 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (printout FILEDSC FNT.OUTFTEXT]) (FNT.DISPTBLE - [LAMBDA (Stream FONTDSC) (* FS "17-Mar-86 17:37") - - (* * generates a font table using prin1) + [LAMBDA (Stream FONTDSC CHARSET) (* ; "Edited 1-Feb-2025 09:59 by mth") + (* FS "17-Mar-86 17:37") + + (* * generates a font table using prin1) (LET* ((TitleFont (FONTCREATE FNT.INFOFONT)) (FontList (LIST FONTDSC)) (InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream))) - (DDev (IMAGESTREAMTYPE Stream))) + (DDev (IMAGESTREAMTYPE Stream)) + (CHARSET (OR (AND (FIXP CHARSET) + (<= 0 CHARSET 255) + CHARSET) + 0))) + (if (WINDOWP Stream) + then (CLEARW Stream)) (for Font in FontList do (DSPRIGHTMARGIN (TIMES 100.0 InchesToPrinterUnits) Stream) (* Let clip on right *) @@ -161,13 +177,13 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (FTIMES 10.0 InchesToPrinterUnits) Stream) (DSPFONT TitleFont Stream) - (FNT.NARRDSCR Stream FontList) + (FNT.NARRDSCR Stream FontList CHARSET) (DSPFONT FONTDSC Stream) (printout Stream FNT.OUTFTEXT) (DSPFONT Font Stream) (for YPosition from (TIMES 9 InchesToPrinterUnits) to (TIMES 1.5 InchesToPrinterUnits ) - by (TIMES -0.5 InchesToPrinterUnits) bind (CharacterCode _ 0) + by (TIMES -0.5 InchesToPrinterUnits) bind (CharacterCode _ (LLSH CHARSET 8)) do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) to (TIMES 7.5 InchesToPrinterUnits) by (TIMES 0.45 InchesToPrinterUnits) do (MOVETO XPosition YPosition Stream) @@ -226,12 +242,17 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (RETURN NIL]) (FNT.NARRDSCR - [LAMBDA (OUTF FONTLIST) (* ; "Edited 9-Jan-87 18:57 by FS") - - (* * Prints a list of fontlists with narrow formatting appropriate for 8 pt. - terminal) + [LAMBDA (OUTF FONTLIST CHARSET) (* ; "Edited 1-Feb-2025 10:14 by mth") + (* ; "Edited 9-Jan-87 18:57 by FS") + + (* * Prints a list of fontlists with narrow formatting appropriate for 8 pt. + terminal) - (PROG (NAME SIZE FACE NUMB STRM TEMP OFFX UNITS T0 T1 T2 T3 T4 T5 DESCR) + (PROG (NAME SIZE FACE NUMB STRM TEMP OFFX UNITS T0 T1 T2 T3 T4 T5 T6 DESCR + (CHARSET (OR (AND (FIXP CHARSET) + (<= 0 CHARSET 255) + CHARSET) + 0))) (if (EQ FONTLIST NIL) then (RETURN NIL)) (if (TYPENAMEP FONTLIST 'FONTDESCRIPTOR) @@ -245,38 +266,45 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (SETQ T3 (PLUS OFFX (TIMES 28 UNITS))) (SETQ T4 (PLUS OFFX (TIMES 33 UNITS))) (SETQ T5 (PLUS OFFX (TIMES 48 UNITS))) - - (* * (MAPC FONTLIST (QUOTE (LAMBDA (DESCR) - (SETQ NAME (CAR DESCR)) (SETQ SIZE (CADR DESCR)) - (SETQ FACE (FNT.FACEMAP (CADDR DESCR))) (SETQ TEMP - (CDDDR DESCR)) (SETQ NUMB (CAR TEMP)) (SETQ STRM - (CADR TEMP)) (DSPXPOSITION T0 OUTF) (printout OUTF NAME) - (DSPXPOSITION T1 OUTF) (printout OUTF |.I3| SIZE) - (DSPXPOSITION T2 OUTF) (printout OUTF FACE) - (DSPXPOSITION T3 OUTF) (printout OUTF NUMB) - (DSPXPOSITION T4 OUTF) (printout OUTF STRM) - (DSPXPOSITION T5 OUTF))))) - - (for I in FONTLIST do (if (type? FONTDESCRIPTOR I) - then (SETQ DESCR (FNT.FLST I)) - else (SETQ DESCR I)) - (SETQ NAME (CAR DESCR)) - (SETQ SIZE (CADR DESCR)) - (SETQ FACE (FNT.FACEMAP (CADDR DESCR))) - (SETQ TEMP (CDDDR DESCR)) - (SETQ NUMB (CAR TEMP)) - (SETQ STRM (CADR TEMP)) - (DSPXPOSITION T0 OUTF) - (printout OUTF NAME) - (DSPXPOSITION T1 OUTF) - (printout OUTF |.I3| SIZE) - (DSPXPOSITION T2 OUTF) - (printout OUTF FACE) - (DSPXPOSITION T3 OUTF) - (printout OUTF NUMB) - (DSPXPOSITION T4 OUTF) - (printout OUTF STRM) - (DSPXPOSITION T5 OUTF)) + (SETQ T6 (PLUS OFFX (TIMES 63 UNITS))) + + (* * (MAPC FONTLIST (QUOTE (LAMBDA (DESCR) + (SETQ NAME (CAR DESCR)) (SETQ SIZE (CADR DESCR)) + (SETQ FACE (FNT.FACEMAP (CADDR DESCR))) (SETQ TEMP + (CDDDR DESCR)) (SETQ NUMB (CAR TEMP)) (SETQ STRM + (CADR TEMP)) (DSPXPOSITION T0 OUTF) (printout OUTF NAME) + (DSPXPOSITION T1 OUTF) (printout OUTF .I3 SIZE) + (DSPXPOSITION T2 OUTF) (printout OUTF FACE) + (DSPXPOSITION T3 OUTF) (printout OUTF NUMB) + (DSPXPOSITION T4 OUTF) (printout OUTF STRM) + (DSPXPOSITION T5 OUTF))))) + + (for I in FONTLIST + do (if (type? FONTDESCRIPTOR I) + then (SETQ DESCR (FNT.FLST I)) + else (SETQ DESCR I)) + (SETQ NAME (CAR DESCR)) + (SETQ SIZE (CADR DESCR)) + (SETQ FACE (FNT.FACEMAP (CADDR DESCR))) + (SETQ TEMP (CDDDR DESCR)) + (SETQ NUMB (CAR TEMP)) + (SETQ STRM (CADR TEMP)) + (DSPXPOSITION T0 OUTF) + (if NIL + then (printout OUTF NAME) + (DSPXPOSITION T1 OUTF) + (printout OUTF .I3 SIZE) + (DSPXPOSITION T2 OUTF) + (printout OUTF FACE) + (DSPXPOSITION T3 OUTF) + (printout OUTF NUMB) + (DSPXPOSITION T4 OUTF) + (printout OUTF STRM) + (DSPXPOSITION T5 OUTF) + (printout OUTF "CS=" .I1 CHARSET) + (DSPXPOSITION T6 OUTF) + else (printout OUTF NAME -2 "size=" .I1 SIZE -2 FACE -2 "rot=" .I1 NUMB -2 "C" + .I1.8 CHARSET -2 STRM -3))) (RETURN NIL]) (FNT.DISPINIT @@ -381,11 +409,18 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r ((LISTP FONTOBJ) FONTOBJ]) ) -(PUTPROPS FONTSAMPLE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990)) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +) + +(PUTPROPS FONTSAMPLE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT :XCCS)) +(PUTPROPS FONTSAMPLE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 2025)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1964 16504 (FNT.MAKEBOOK 1974 . 3779) (FNT.LESSP 3781 . 4575) (FNT.SORTP 4577 . 5343) ( -FNT.DISPLOOK 5345 . 5862) (FNT.DISPTBLE 5864 . 7867) (FNT.DISPDSCR 7869 . 9976) (FNT.NARRDSCR 9978 . -12722) (FNT.DISPINIT 12724 . 13136) (FNT.FACEMAP 13138 . 13525) (FNT.SIZEMAP 13527 . 13863) ( -FNT.MAKENAME 13865 . 14549) (FNT.MAKEWIND 14551 . 15105) (FNT.FILEMAP 15107 . 15737) (FNT.FINDALL -15739 . 16082) (FNT.FLST 16084 . 16502))))) + (FILEMAP (NIL (1973 17356 (FNT.MAKEBOOK 1983 . 3788) (FNT.LESSP 3790 . 4584) (FNT.SORTP 4586 . 5352) ( +FNT.DISPLOOK 5354 . 5964) (FNT.DISPTBLE 5966 . 8319) (FNT.DISPDSCR 8321 . 10428) (FNT.NARRDSCR 10430 + . 13574) (FNT.DISPINIT 13576 . 13988) (FNT.FACEMAP 13990 . 14377) (FNT.SIZEMAP 14379 . 14715) ( +FNT.MAKENAME 14717 . 15401) (FNT.MAKEWIND 15403 . 15957) (FNT.FILEMAP 15959 . 16589) (FNT.FINDALL +16591 . 16934) (FNT.FLST 16936 . 17354))))) STOP diff --git a/library/FONTSAMPLE.LCOM b/library/FONTSAMPLE.LCOM index 2301a55a7..c8c013f55 100644 Binary files a/library/FONTSAMPLE.LCOM and b/library/FONTSAMPLE.LCOM differ diff --git a/library/FONTSAMPLE.TEDIT b/library/FONTSAMPLE.TEDIT index 12d3aa87e..f5a1db92c 100644 Binary files a/library/FONTSAMPLE.TEDIT and b/library/FONTSAMPLE.TEDIT differ