(FILECREATED "19-Aug-86 20:58:44" {ERIS}<LISPCORE>LIBRARY>CHARCODETABLES.;3 11905
changes to: (FNS CODETABLE SHOWCSET SHOWCSETRANGE CENTERPRINT SHOWCSETLIST SHOWCOMMONCSETS)
(VARS CHARCODETABLESCOMS)
previous date: " 6-Nov-85 01:34:22" {ERIS}<LISPCORE>LIBRARY>CHARCODETABLES.;1)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHARCODETABLESCOMS)
(RPAQQ CHARCODETABLESCOMS ((FNS CENTERPRINT CODETABLE SHOWCOMMONCSETS SHOWCSET SHOWCSETLIST
SHOWCSETRANGE)))
(DEFINEQ
(CENTERPRINT
[LAMBDA (TEXT FONT X Y STREAM) (* jds "19-Aug-86 18:00")
(* * Print TEXT onto STREAM in FONT, centered horizontally at X, with its
baseline at Y.)
(LET* [(WIDTH (STRINGWIDTH TEXT FONT))
(XLOC (DIFFERENCE X (FTIMES WIDTH .5]
(MOVETO (FIXR XLOC)
Y STREAM)
(DSPFONT FONT STREAM)
(PRIN1 TEXT STREAM])
(CODETABLE
[LAMBDA (STREAM FONT CHARSET XOFFSET) (* jds "19-Aug-86 20:50")
(* * Generates a font table for character set CHARSET of font FONT.
The table is printed on image stream STREAM, at horizontal offset XOFFSET.
The characters are printed using PRIN1.)
(LET* ((TitleFont (FONTCREATE (QUOTE MODERN)
10
(QUOTE BOLD)
NIL
(QUOTE INTERPRESS)))
(NUMBERFONT (FONTCREATE (QUOTE MODERN)
8
(QUOTE BOLD)
NIL
(QUOTE INTERPRESS)))
(SCALE (DSPSCALE NIL STREAM))
(InchesToPrinterUnits (FTIMES 72.0 SCALE))
(DDev (IMAGESTREAMTYPE STREAM))
(CHARSETNAME (OCTALSTRING CHARSET))
TITLE)
(SETQ FONT (FONTCREATE FONT NIL NIL NIL (QUOTE INTERPRESS)))
(* Get the interpress version of the
FONT we're making the table for.)
(* * Print the title over the table, showing font name, size, etc.)
(DSPFONT TitleFont STREAM)
(SETQ TITLE (CONCAT (FONTPROP FONT (QUOTE FAMILY))
" "
(FONTPROP FONT (QUOTE SIZE))
" "
(FONTPROP FONT (QUOTE WEIGHT))
"-"
(FONTPROP FONT (QUOTE SLOPE))
" Character Set " CHARSETNAME))
(CENTERPRINT TITLE TitleFont (PLUS XOFFSET (TIMES 2.75 InchesToPrinterUnits))
(FTIMES 7.5 InchesToPrinterUnits)
STREAM)
(* * Print out the lines for the table, and the character-code guide numbers
along the top and left edge.)
(DSPFONT NUMBERFONT STREAM)
[for X from (IPLUS XOFFSET InchesToPrinterUnits) by (FIXR (FTIMES SCALE 18)) as I
from 0 to 16 bind (Y0 ← (FIXR (FTIMES SCALE 72)))
(YSPAN ← (FIXR (FTIMES SCALE 24 16)))
do
(* * Draw thr vertical lines between the boxes in the code chart.)
(DRAWLINE X Y0 X (IPLUS Y0 YSPAN)
35
(QUOTE PAINT)
STREAM)
(COND
((ILEQ I 15) (* And if it's not the rightmost line,
print a number across the top as well,
for the high-order 4 bits of the
character code.)
(CENTERPRINT (OCTALSTRING (ITIMES I 16))
NUMBERFONT
(IPLUS X (FIXR (FTIMES SCALE 9)))
(IPLUS Y0 YSPAN 35)
STREAM]
[for Y from (FIXR (FTIMES SCALE 72)) by (FIXR (FTIMES SCALE 24)) as I from 0 to 16
bind [X0 ← (IPLUS XOFFSET (FIXR (FTIMES SCALE 72]
(XSPAN ← (FIXR (FTIMES SCALE 18 16)))
do
(* * Now print the horizontal lines between boxes in the code chart.)
(DRAWLINE X0 Y (IPLUS X0 XSPAN)
Y 35 (QUOTE PAINT)
STREAM)
(COND
((ILEQ I 15) (* And if it isn't the bottommost
line, print the low-order 4 bits of
character code along the left.)
(CENTERPRINT (OCTALSTRING (IDIFFERENCE 15 I))
NUMBERFONT
(IPLUS X0 (FIXR (FTIMES SCALE -9)))
(IPLUS Y (FIXR (FTIMES 6 SCALE)))
STREAM]
(* * Now go really print the characters in the table.)
(DSPFONT FONT STREAM)
(for YPosition from [FIXR (FTIMES SCALE (IPLUS 72 6 (ITIMES 15 24]
by (FIXR (FTIMES SCALE -24)) as LOWBITS from 0 to 15 bind CharacterCode
do
(* * Run down each column -- i.e., varying the low bits fastest --
printing the characters.)
[for XPosition from (IPLUS XOFFSET (FIXR (FTIMES SCALE 75)))
by (FIXR (FTIMES 18 SCALE)) as HIBITS from 0 to 15
do (SETQ CharacterCode (IPLUS (LLSH CHARSET 8)
(LLSH HIBITS 4)
LOWBITS))
(MOVETO XPosition YPosition STREAM)
(COND
((IEQP (LOGAND CharacterCode 255)
255) (* Can't print the charset-change
character!)
)
((NEQ CharacterCode (CHARCODE FF))
(COND
((EQ DDev (QUOTE DISPLAY))
(BLTCHAR CharacterCode STREAM))
(T (\OUTCHAR STREAM CharacterCode]
(printout T "."))
(printout T " done." T])
(SHOWCOMMONCSETS
[LAMBDA (FONT) (* jds "19-Aug-86 18:21")
(* * Create character-code charts for all the common character sets in
existence, namely 0, 41-50, and 356-361 (all octal, of course!) This explicitly
excludes the Japanese and Chinese character ranges, which mostly don't exist.)
(SHOWCSETRANGE 0 0 FONT)
(SHOWCSETLIST (CHARCODE (0,41 0,42 0,44 0,45 0,46 0,47 0,50))
FONT)
(SHOWCSETRANGE 238 241 FONT)
(PRINTOUT T "Done." T])
(SHOWCSET
[LAMBDA (FONT) (* jds "19-Aug-86 19:46")
(* * Create character-code charts for ALL the character sets in existence, as
of Xerox Character Code Standard XC1-2-2-0)
(SHOWCSETRANGE 0 0 FONT)
(SHOWCSETLIST (CHARCODE (0,41 0,42 0,43 0,44 0,45 0,46 0,47 0,50))
FONT)
(SHOWCSETRANGE 48 115 FONT)
(SHOWCSETLIST (CHARCODE 0,164 0,165 0,166 0,167 0,170 0,171 0,172))
(SHOWCSETRANGE 161 212 FONT)
(SHOWCSETLIST (CHARCODE 0,340 0,341 0,342 0,343 0,356 0,357 0,360 0,361 0,365 0,375 0,376))
(PRINTOUT T "Done." T])
(SHOWCSETLIST
[LAMBDA (CSETS FONT) (* jds "19-Aug-86 18:16")
(* * Produce character-code charts for the character sets in the list CSETS.
The charts appear two-up, landscape.)
(PROG [IPSTREAM (COUNT 0)
(XOFFSET 0)
(HALFPAGE (FIXR (FTIMES 5.5 72 35.27778]
[for CHARSET in CSETS do
(* * Print each code chart)
[COND
((NOT IPSTREAM)
(* W're sure to need an open file. Open one, if there isn't one already.
Doing it here assures that we'll never create an empty one at the end.)
(SETQ IPSTREAM (OPENIMAGESTREAM (QUOTE {LPT})
(QUOTE INTERPRESS)
(QUOTE (LANDSCAPE T]
(RESETLST (RESETSAVE (RADIX 8)))
(* Everything's in octal on these
charts.)
(PRINTOUT T "Listing Character set " CHARSET "." T)
(CODETABLE IPSTREAM [OR FONT (QUOTE (CLASSIC 12 (MEDIUM REGULAR
REGULAR]
CHARSET XOFFSET) (* Produce the code table.)
(DSPFONT (QUOTE (CLASSIC 12 (MEDIUM REGULAR REGULAR)))
IPSTREAM)
(* * Move to the other half of the page, or to the next page, depending.)
(COND
((ZEROP XOFFSET) (* This is the first one on the page.
Move over for the next chart.)
(SETQ XOFFSET HALFPAGE))
(T (* That was the second chart on this
page. Go to a new page for the next
one.)
(SETQ XOFFSET 0)
(COND
((IGEQ (SETQ COUNT (ADD1 COUNT))
5) (* But every 5 pages, start a new
file, to prevent overflow on the print
server.)
(CLOSEF IPSTREAM)
(SETQ IPSTREAM NIL)
(SETQ COUNT 0))
(T (DSPNEWPAGE IPSTREAM]
(AND IPSTREAM (CLOSEF IPSTREAM])
(SHOWCSETRANGE
[LAMBDA (FirstCSet LastCSet FONT) (* jds "19-Aug-86 19:23")
(* * Produce character-code charts for a given range of character sets, from
FirstCSet to LastCSet. They appear two-up, landscape.)
(SHOWCSETLIST (FOR CHARSET FROM FirstCSet TO LastCSet COLLECT CHARSET)
FONT])
)
(PUTPROPS CHARCODETABLES COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (579 11815 (CENTERPRINT 589 . 1043) (CODETABLE 1045 . 6919) (SHOWCOMMONCSETS 6921 . 7507
) (SHOWCSET 7509 . 8182) (SHOWCSETLIST 8184 . 11412) (SHOWCSETRANGE 11414 . 11813)))))
STOP