(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 4-Feb-93 19:47:50" |{PELE:MV:ENVOS}LIBRARY>CHARCODETABLES.;5| 11685 changes to%: (FNS SHOWCSETLIST) previous date%: "25-Aug-92 16:59:31" |{PELE:MV:ENVOS}LIBRARY>CHARCODETABLES.;4|) (* ; " Copyright (c) 1985, 1986, 1990, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT CHARCODETABLESCOMS) (RPAQQ CHARCODETABLESCOMS ( (* ;; "User-level entries:") (FNS SHOWCOMMONCSETS SHOWCSET SHOWCSETLIST SHOWCSETRANGE) (* ;; "Main printing functions:") (FNS CENTERPRINT CODETABLE))) (* ;; "User-level entries:") (DEFINEQ (SHOWCOMMONCSETS [LAMBDA (FONT) (* ; "Edited 25-Aug-92 16:55 by jds") (* ;; "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) (* ; "Edited 25-Aug-92 16:55 by jds") (* ;; "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) (* ; "Edited 4-Feb-93 19:35 by jds") (* ;; "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) [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 '{LPT} NIL '(LANDSCAPE T] (SETQ HALFPAGE (FIXR (FTIMES 5.5 72 (DSPSCALE NIL IPSTREAM] (RESETLST (RESETSAVE (RADIX 8))) (* ;  "Everything's in octal on these charts.") (PRINTOUT T "Listing Character set " CHARSET "." T) (CODETABLE IPSTREAM [OR FONT '(CLASSIC 12 (MEDIUM REGULAR REGULAR] CHARSET XOFFSET) (* ; "Produce the code table.") (DSPFONT '(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) (* ; "Edited 25-Aug-92 16:55 by jds") (* ;; "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]) ) (* ;; "Main printing functions:") (DEFINEQ (CENTERPRINT [LAMBDA (TEXT FONT X Y STREAM) (* ; "Edited 25-Aug-92 16:56 by jds") (* ;;; "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 0.5] (MOVETO (FIXR XLOC) Y STREAM) (DSPFONT FONT STREAM) (PRIN1 TEXT STREAM]) (CODETABLE [LAMBDA (STREAM FONT CHARSET XOFFSET) (* ; "Edited 25-Aug-92 16:57 by jds") (* ;; "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 'MODERN 10 'BOLD NIL STREAM)) (NUMBERFONT (FONTCREATE 'MODERN 8 'BOLD NIL STREAM)) (SCALE (DSPSCALE NIL STREAM)) (InchesToPrinterUnits (FTIMES 72.0 SCALE)) (DDev (IMAGESTREAMTYPE STREAM)) (CHARSETNAME (OCTALSTRING CHARSET)) TITLE) (SETQ FONT (FONTCREATE FONT NIL NIL NIL STREAM)) (* ;  "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 'FAMILY) " " (FONTPROP FONT 'SIZE) " " (FONTPROP FONT 'WEIGHT) "-" (FONTPROP FONT '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 '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 '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 'DISPLAY) (BLTCHAR CharacterCode STREAM)) (T (\OUTCHAR STREAM CharacterCode] (printout T ".")) (printout T " done." T]) ) (PUTPROPS CHARCODETABLES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990 1992 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (842 5920 (SHOWCOMMONCSETS 852 . 1403) (SHOWCSET 1405 . 2058) (SHOWCSETLIST 2060 . 5536) (SHOWCSETRANGE 5538 . 5918)) (5963 11571 (CENTERPRINT 5973 . 6404) (CODETABLE 6406 . 11569))))) STOP