(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED "27-Sep-87 16:14:14" {DSK}<OST>ANSICHATFONT.;28 44240
changes to%: (VARS ANSICHATFONTCOMS)
(PROPS (ANSICHATFONT MAKEFILE-ENVIRONMENT))
(FNS ANSI-Chat-Build-Font-Descriptors ANSI-Chat-Copy-CharSet
ANSI-Chat-Copy-CharSet-DoubleHeight ANSI-Chat-Copy-CharSet-DoubleWide)
(FILES FONTDECLS)
previous date%: "26-Sep-87 15:20:54" {DSK}<OST>ANSICHATFONT.;27)
(PRETTYCOMPRINT ANSICHATFONTCOMS)
(RPAQQ ANSICHATFONTCOMS
((PROP MAKEFILE-ENVIRONMENT ANSICHATFONT)
(PROP FILETYPE ANSICHATFONT)
(FNS ANSI-Chat-Build-Font-Descriptors ANSI-Chat-Copy-CharSet
ANSI-Chat-Copy-CharSet-DoubleHeight ANSI-Chat-Copy-CharSet-DoubleWide
ANSI-Chat-Font-Initialize)
(INITVARS (ANSI-Chat-Font NIL))
(GLOBALVARS ANSI-Chat-Font-Descriptor-Cache ANSI-Chat-Font)
(ADDVARS (MISSINGDISPLAYFONTCOERCIONS ((ANSITERMINAL)
(TERMINAL)))
(ASCIITONSTRANSLATIONS (ANSITERMINAL NIL TERMINAL)))
(FNS ANSI-Chat-Initialize-Character-Translations ANSI-Chat-Build-Map)
(GLOBALVARS ANSI-ASCII-Graphics-Character-Set ANSI-Supplemental-Graphics-Character-Set
ANSI-Special-Graphics-Character-Set ANSI-British-NRC-Character-Set
ANSI-Dutch-NRC-Character-Set ANSI-Finnish-NRC-Character-Set
ANSI-French-NRC-Character-Set ANSI-French-Canadian-NRC-Character-Set
ANSI-German-NRC-Character-Set ANSI-Italian-NRC-Character-Set
ANSI-Norwegian/Danish-NRC-Character-Set ANSI-Spanish-NRC-Character-Set
ANSI-Swedish-NRC-Character-Set ANSI-Swiss-NRC-Character-Set)
(P (ANSI-Chat-Initialize-Character-Translations)
(ANSI-Chat-Font-Initialize))
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
FONTDECLS))))
(PUTPROPS ANSICHATFONT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(PUTPROPS ANSICHATFONT FILETYPE TCOMPL)
(DEFINEQ
(ANSI-Chat-Build-Font-Descriptors
[LAMBDA NIL
(DECLARE (GLOBALVARS PROMPTWINDOW ANSI-Chat-Font-Descriptor-Cache ANSI-Chat-Font)
(CONSTANTS \MAXCHARSET)) (* ; "Edited 27-Sep-87 15:22 by R.Beeman")
(* ;; "Need eight (8) FontDescriptors Normal (MRR), DoubleWide (MIR), DoubleHeightTop (MIE), DoubleHeightBottom (MIC), Bold (BRR), BoldDoubleWide (BIR), BoldDoubleHeightTop (BIE), BoldDoubleHeightBottom (BIC)")
(* ;;
"First get the Normal and Bold conventionally, then copy them to the VIDEOTERMINAL family")
(LET*
[[BaseFont (FONTCREATE (OR [AND (BOUNDP 'ANSI-Chat-Font)
ANSI-Chat-Font
(FONTUNPARSE (FONTCOPY ANSI-Chat-Font 'FACE 'MRR]
'(ANSITERMINAL 10]
(BaseBoldFont (FONTCOPY BaseFont 'WEIGHT 'BOLD]
(COND
((AND (BOUNDP 'ANSI-Chat-Font-Descriptor-Cache)
(EQP (LENGTH ANSI-Chat-Font-Descriptor-Cache)
3)
(EQ BaseFont (CAR ANSI-Chat-Font-Descriptor-Cache))
(EQ BaseBoldFont (CADR ANSI-Chat-Font-Descriptor-Cache)))
(* ; "Have already done the work")
NIL)
(T
(PROMPTPRINT "Building Font Descriptors ")
(* ;; "Force in the Character Sets")
(for CharacterSpecification
in '(0,040 41,142 42,041 46,163 50,043 356,176 357,344 360,270 361,41 375,320)
do (LET ((CharacterCode (APPLY* (FUNCTION CHARCODE)
CharacterSpecification)))
(CHARWIDTH CharacterCode BaseFont)
(PRINTOUT PROMPTWINDOW ".")
(CHARWIDTH CharacterCode BaseBoldFont)
(PRINTOUT PROMPTWINDOW ".")))
[LET
((CharSet0AverageWidth (\AVGCHARWIDTH BaseFont))
(SourceCharSet0 (\GETCHARSETINFO 0 BaseFont)))
(SETQ ANSI-Chat-Font-Descriptor-Cache
(LIST BaseFont BaseBoldFont
(COND
(SourceCharSet0
(* ;; "Create Font Descriptors")
(LET ((CharSet0Ascent (fetch (CHARSETINFO CHARSETASCENT) of SourceCharSet0))
(CharSet0Descent (fetch (CHARSETINFO CHARSETDESCENT) of SourceCharSet0))
(NormalFont (create FONTDESCRIPTOR))
(DoubleWideFont (create FONTDESCRIPTOR))
(DoubleHeightTopFont (create FONTDESCRIPTOR))
(DoubleHeightBottomFont (create FONTDESCRIPTOR))
(BoldFont (create FONTDESCRIPTOR))
(BoldDoubleWideFont (create FONTDESCRIPTOR))
(BoldDoubleHeightTopFont (create FONTDESCRIPTOR))
(BoldDoubleHeightBottomFont (create FONTDESCRIPTOR)))
(PRINTOUT PROMPTWINDOW ".")
[for FD in (LIST NormalFont DoubleWideFont DoubleHeightTopFont
DoubleHeightBottomFont BoldFont BoldDoubleWideFont
BoldDoubleHeightTopFont BoldDoubleHeightBottomFont)
as Face in '(MRR MIR MIE MIC BRR BIR BIE BIC)
bind (Size ← (FONTPROP BaseFont 'SIZE))
do (replace (FONTDESCRIPTOR FONTDEVICE) of FD with 'DISPLAY)
(replace (FONTDESCRIPTOR FONTFAMILY) of FD with 'VIDEOTERMINAL)
(replace (FONTDESCRIPTOR FONTSIZE) of FD with Size)
(replace (FONTDESCRIPTOR FONTFACE) of FD with Face)
(replace (FONTDESCRIPTOR \SFAscent) of FD with CharSet0Ascent)
(replace (FONTDESCRIPTOR \SFDescent) of FD with CharSet0Descent)
(replace (FONTDESCRIPTOR \SFHeight) of FD with (+ CharSet0Ascent
CharSet0Descent))
(replace (FONTDESCRIPTOR ROTATION) of FD with 0)
(replace (FONTDESCRIPTOR FONTDEVICESPEC) of FD
with (LIST 'VIDEOTERMINAL Size Face 0 'DISPLAY))
(replace (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FD
with (SELECTQ Face
((MRR BRR)
CharSet0AverageWidth)
(RSH CharSet0AverageWidth -1]
(PRINTOUT PROMPTWINDOW ".")
(* ;; "Copy Base Font Descriptors to ANSI-Chat Font Descriptors")
(for BFD in (LIST BaseFont BaseBoldFont) as SWFD
in (LIST NormalFont BoldFont)
do (for CharacterSet
in '(0 33 34 38 40 238 239 240 241 253)
do [LET ((SourceCharSet (\GETCHARSETINFO CharacterSet BFD)))
(COND
(SourceCharSet (\SETCHARSETINFO (fetch (FONTDESCRIPTOR
FONTCHARSETVECTOR
) of SWFD)
CharacterSet
(ANSI-Chat-Copy-CharSet
SourceCharSet
CharSet0Ascent
CharSet0Descent
CharSet0AverageWidth]
(PRINTOUT PROMPTWINDOW ".")))
(* ;; "Next create DoubleWides")
(for SWFD in (LIST NormalFont BoldFont) as DWFD
in (LIST DoubleWideFont BoldDoubleWideFont)
do (for CharacterSet
in '(0 33 34 38 40 238 239 240 241 253)
do [LET ((SourceCharSet (\GETCHARSETINFO CharacterSet SWFD)))
(COND
(SourceCharSet (\SETCHARSETINFO (fetch (FONTDESCRIPTOR
FONTCHARSETVECTOR
) of DWFD)
CharacterSet
(
ANSI-Chat-Copy-CharSet-DoubleWide
SourceCharSet
(RSH CharSet0AverageWidth -1]
(PRINTOUT PROMPTWINDOW ".")))
(* ;; "Finally create DoubleHeights")
[for DWFD in (LIST DoubleWideFont BoldDoubleWideFont) as DHTFD
in (LIST DoubleHeightTopFont BoldDoubleHeightTopFont) as DHBFD
in (LIST DoubleHeightBottomFont BoldDoubleHeightBottomFont)
do (for CharacterSet
in '(0 33 34 38 40 238 239 240 241 253)
do (LET ((SourceCharSet (\GETCHARSETINFO CharacterSet DWFD)))
(COND
(SourceCharSet (\SETCHARSETINFO (fetch (FONTDESCRIPTOR
FONTCHARSETVECTOR
) of DHTFD)
CharacterSet
(
ANSI-Chat-Copy-CharSet-DoubleHeight
SourceCharSet
(RSH CharSet0AverageWidth -1)
'Top))
(PRINTOUT PROMPTWINDOW ".")
(\SETCHARSETINFO (fetch (FONTDESCRIPTOR
FONTCHARSETVECTOR
) of DHBFD)
CharacterSet
(ANSI-Chat-Copy-CharSet-DoubleHeight
SourceCharSet
(RSH CharSet0AverageWidth -1)
'Bottom))
(PRINTOUT PROMPTWINDOW "."]
(LIST (LIST 3 DoubleHeightTopFont 4 DoubleHeightBottomFont 5 NormalFont 6
DoubleWideFont)
3 BoldDoubleHeightTopFont 4 BoldDoubleHeightBottomFont 5 BoldFont 6
BoldDoubleWideFont)))
(T
(* ;; " Things are terribly wrong, just supply BaseFont and BoldBaseFont ")
(LIST (LIST 5 BaseFont)
5 BaseBoldFont]
(PRINTOUT PROMPTWINDOW " Done" T)))
(CADDR ANSI-Chat-Font-Descriptor-Cache])
(ANSI-Chat-Copy-CharSet
[LAMBDA (Source Ascent Descent Width)
(DECLARE (CONSTANTS \MAXTHINCHAR WORDSPERCELL)) (* ; "Edited 27-Sep-87 15:21 by R.Beeman")
(LET* ((Height (+ Ascent Descent))
(SourceWidths (fetch (CHARSETINFO WIDTHS) of Source))
(SourceOffsets (fetch (CHARSETINFO OFFSETS) of Source))
(SourceCharSetBitMap (fetch (CHARSETINFO CHARSETBITMAP) of Source))
(SourceImageWidths (fetch (CHARSETINFO IMAGEWIDTHS) of Source))
(SourceCharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of Source))
(SourceCharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of Source))
(UnknownOffset (\FGETOFFSET SourceOffsets (ADD1 \MAXTHINCHAR)))
(CharSetInfo (create CHARSETINFO))
(DestinationWidths (fetch (CHARSETINFO WIDTHS) of CharSetInfo))
(DestinationOffsets (fetch (CHARSETINFO OFFSETS) of CharSetInfo))
(DestinationImageWidths (\CREATECSINFOELEMENT))
(DestinationOffset 0)
[DestinationUnknownOffset (ITIMES (ADD1 Width)
(for Index from 0 to \MAXTHINCHAR
count (NOT (EQ (\FGETOFFSET SourceOffsets Index)
UnknownOffset]
(DestinationCharSetBitMap (BITMAPCREATE (+ DestinationUnknownOffset Width)
Height 1)))
(replace (CHARSETINFO IMAGEWIDTHS) of CharSetInfo with DestinationImageWidths)
(replace (CHARSETINFO CHARSETBITMAP) of CharSetInfo with DestinationCharSetBitMap)
(replace (CHARSETINFO CHARSETASCENT) of CharSetInfo with Ascent)
(replace (CHARSETINFO CHARSETDESCENT) of CharSetInfo with Descent)
(\FSETWIDTH DestinationWidths (ADD1 \MAXTHINCHAR)
Width)
(\FSETOFFSET DestinationOffsets (ADD1 \MAXTHINCHAR)
DestinationUnknownOffset)
(\FSETIMAGEWIDTH DestinationImageWidths (ADD1 \MAXTHINCHAR)
Width)
[LET* [(SourceCharSetBitMapHeight (BITMAPHEIGHT SourceCharSetBitMap))
(SourceYOffset (IMAX 0 (- SourceCharSetDescent Descent)))
[DestinationYOffset (IMIN (SUB1 Height)
(IMAX 0 (- (+ SourceCharSetAscent Descent)
SourceCharSetBitMapHeight]
(BLTHeight (IMAX 0 (IMIN (- SourceCharSetBitMapHeight SourceYOffset)
(- Height DestinationYOffset]
(for Index from 0 to \MAXTHINCHAR
do (LET [(SourceOffset (\FGETOFFSET SourceOffsets Index))
(SourceImageWidth (IMIN Width (\FGETIMAGEWIDTH SourceImageWidths Index]
(\FSETWIDTH DestinationWidths Index Width)
(\FSETIMAGEWIDTH DestinationImageWidths Index Width)
(COND
((EQ SourceOffset UnknownOffset)
(\FSETOFFSET DestinationOffsets Index DestinationUnknownOffset))
(T (\FSETOFFSET DestinationOffsets Index DestinationOffset)
[COND
((NOT (ZEROP BLTHeight))
(BITBLT SourceCharSetBitMap SourceOffset SourceYOffset
DestinationCharSetBitMap DestinationOffset
DestinationYOffset SourceImageWidth BLTHeight
'INPUT
'REPLACE]
(SETQ DestinationOffset (+ DestinationOffset Width 1]
(BLTSHADE BLACKSHADE DestinationCharSetBitMap (ADD1 DestinationUnknownOffset)
Descent
(- Width 2)
Ascent
'REPLACE)
CharSetInfo])
(ANSI-Chat-Copy-CharSet-DoubleHeight
[LAMBDA (Source Width Half)
(DECLARE (CONSTANTS \MAXTHINCHAR WORDSPERCELL)) (* ; "Edited 27-Sep-87 15:22 by R.Beeman")
(LET* ((SourceWidths (fetch (CHARSETINFO WIDTHS) of Source))
(SourceOffsets (fetch (CHARSETINFO OFFSETS) of Source))
(SourceCharSetBitMap (fetch (CHARSETINFO CHARSETBITMAP) of Source))
(SourceImageWidths (fetch (CHARSETINFO IMAGEWIDTHS) of Source))
(SourceCharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of Source))
(SourceCharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of Source))
(Height (+ SourceCharSetAscent SourceCharSetDescent))
(UnknownOffset (\FGETOFFSET SourceOffsets (ADD1 \MAXTHINCHAR)))
(CharSetInfo (create CHARSETINFO))
(DestinationWidths (fetch (CHARSETINFO WIDTHS) of CharSetInfo))
(DestinationOffsets (fetch (CHARSETINFO OFFSETS) of CharSetInfo))
(DestinationImageWidths (\CREATECSINFOELEMENT))
(DestinationOffset 0)
(DestinationCharSetBitMap (BITMAPCOPY SourceCharSetBitMap)))
(replace (CHARSETINFO IMAGEWIDTHS) of CharSetInfo with DestinationImageWidths)
(replace (CHARSETINFO CHARSETBITMAP) of CharSetInfo with DestinationCharSetBitMap)
(replace (CHARSETINFO CHARSETASCENT) of CharSetInfo with SourceCharSetAscent)
(replace (CHARSETINFO CHARSETDESCENT) of CharSetInfo with SourceCharSetDescent)
(for Index from 0 to (ADD1 \MAXTHINCHAR) do (\FSETWIDTH DestinationWidths Index
(\FGETWIDTH SourceWidths Index))
(\FSETOFFSET DestinationOffsets Index
(\FGETOFFSET SourceOffsets Index))
(\FSETIMAGEWIDTH DestinationImageWidths Index
(\FGETIMAGEWIDTH SourceImageWidths Index
)))
(LET [(YsMiddle (IQUOTIENT Height 2))
(Top (SUB1 Height))
(Odd (NOT (ZEROP (IMOD Height 2]
(SELECTQ Half
(Top (if Odd
then (BITBLT SourceCharSetBitMap 0 YsMiddle DestinationCharSetBitMap 0 0
UnknownOffset 1 'SOURCE 'REPLACE))
(for Ys from Top to (ADD1 YsMiddle) by -1 as Yd from Top by -2
do (BITBLT SourceCharSetBitMap 0 Ys DestinationCharSetBitMap 0 Yd
UnknownOffset 1 'SOURCE 'REPLACE)
(BITBLT SourceCharSetBitMap 0 Ys DestinationCharSetBitMap 0
(SUB1 Yd)
UnknownOffset 1 'SOURCE 'REPLACE)))
(Bottom (if Odd
then (BITBLT SourceCharSetBitMap 0 YsMiddle DestinationCharSetBitMap 0
Top UnknownOffset 1 'SOURCE 'REPLACE))
(for Ys from 0 to (SUB1 YsMiddle) as Yd from 0 by 2
do (BITBLT SourceCharSetBitMap 0 Ys DestinationCharSetBitMap 0 Yd
UnknownOffset 1 'SOURCE 'REPLACE)
(BITBLT SourceCharSetBitMap 0 Ys DestinationCharSetBitMap 0
(ADD1 Yd)
UnknownOffset 1 'SOURCE 'REPLACE)))
NIL))
CharSetInfo])
(ANSI-Chat-Copy-CharSet-DoubleWide
[LAMBDA (Source Width)
(DECLARE (CONSTANTS \MAXTHINCHAR WORDSPERCELL)) (* ; "Edited 27-Sep-87 15:23 by R.Beeman")
(LET* ((SourceWidths (fetch (CHARSETINFO WIDTHS) of Source))
(SourceOffsets (fetch (CHARSETINFO OFFSETS) of Source))
(SourceCharSetBitMap (fetch (CHARSETINFO CHARSETBITMAP) of Source))
(SourceImageWidths (fetch (CHARSETINFO IMAGEWIDTHS) of Source))
(SourceCharSetAscent (fetch (CHARSETINFO CHARSETASCENT) of Source))
(SourceCharSetDescent (fetch (CHARSETINFO CHARSETDESCENT) of Source))
(Height (+ SourceCharSetAscent SourceCharSetDescent))
(UnknownOffset (\FGETOFFSET SourceOffsets (ADD1 \MAXTHINCHAR)))
(CharSetInfo (create CHARSETINFO))
(DestinationWidths (fetch (CHARSETINFO WIDTHS) of CharSetInfo))
(DestinationOffsets (fetch (CHARSETINFO OFFSETS) of CharSetInfo))
(DestinationImageWidths (\CREATECSINFOELEMENT))
(DestinationOffset 0)
[DestinationUnknownOffset (ITIMES (ADD1 Width)
(for Index from 0 to (ADD1 \MAXTHINCHAR)
count (NOT (EQ (\FGETOFFSET SourceOffsets Index)
UnknownOffset]
(DestinationCharSetBitMap (BITMAPCREATE (+ DestinationUnknownOffset Width)
Height 1)))
(replace (CHARSETINFO IMAGEWIDTHS) of CharSetInfo with DestinationImageWidths)
(replace (CHARSETINFO CHARSETBITMAP) of CharSetInfo with DestinationCharSetBitMap)
(replace (CHARSETINFO CHARSETASCENT) of CharSetInfo with SourceCharSetAscent)
(replace (CHARSETINFO CHARSETDESCENT) of CharSetInfo with SourceCharSetDescent)
(\FSETWIDTH DestinationWidths (ADD1 \MAXTHINCHAR)
Width)
(\FSETOFFSET DestinationOffsets (ADD1 \MAXTHINCHAR)
DestinationUnknownOffset)
(\FSETIMAGEWIDTH DestinationImageWidths (ADD1 \MAXTHINCHAR)
Width)
[for Index from 0 to \MAXTHINCHAR
do (LET ((SourceOffset (\FGETOFFSET SourceOffsets Index)))
(\FSETWIDTH DestinationWidths Index Width)
(\FSETIMAGEWIDTH DestinationImageWidths Index Width)
(COND
((EQ SourceOffset UnknownOffset)
(\FSETOFFSET DestinationOffsets Index DestinationUnknownOffset))
(T (\FSETOFFSET DestinationOffsets Index DestinationOffset)
(for X from 1 to (IMIN Width (\FGETIMAGEWIDTH SourceImageWidths Index))
as Xs from SourceOffset as Xd from DestinationOffset by 2
do (BITBLT SourceCharSetBitMap Xs 0 DestinationCharSetBitMap Xd 0 1
Height 'SOURCE 'REPLACE)
(BITBLT SourceCharSetBitMap Xs 0 DestinationCharSetBitMap
(ADD1 Xd)
0 1 Height 'SOURCE 'REPLACE))
(SETQ DestinationOffset (+ DestinationOffset Width 1]
(BLTSHADE BLACKSHADE DestinationCharSetBitMap (ADD1 DestinationUnknownOffset)
SourceCharSetDescent
(- Width 2)
SourceCharSetAscent
'REPLACE)
CharSetInfo])
(ANSI-Chat-Font-Initialize
[LAMBDA NIL
(DECLARE (GLOBALVARS ANSI-Chat-Font)) (* ; "Edited 25-Sep-87 20:06 by R.Beeman")
(* ;; "Force Character Sets into memory")
(PROMPTPRINT "Forcing Character Sets into memory ")
[LET* [[BaseFont (FONTCREATE (OR [AND (BOUNDP 'ANSI-Chat-Font)
ANSI-Chat-Font
(FONTUNPARSE (FONTCOPY ANSI-Chat-Font 'FACE 'MRR]
'(ANSITERMINAL 10]
(BoldFont (FONTCOPY BaseFont 'WEIGHT 'BOLD]
(for CharacterSpecification
in '(0,040 41,142 42,041 46,163 50,043 356,176 357,344 360,270 361,41 375,320)
do (LET ((CharacterCode (APPLY* (FUNCTION CHARCODE)
CharacterSpecification)))
(CHARWIDTH CharacterCode BaseFont)
(PRINTOUT PROMPTWINDOW ".")
(CHARWIDTH CharacterCode BoldFont)
(PRINTOUT PROMPTWINDOW "."]
(PRINTOUT PROMPTWINDOW " Done" T)
(* ;; "Now build Font Descriptors")
(ANSI-Chat-Build-Font-Descriptors])
)
(RPAQ? ANSI-Chat-Font NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ANSI-Chat-Font-Descriptor-Cache ANSI-Chat-Font)
)
(ADDTOVAR MISSINGDISPLAYFONTCOERCIONS ((ANSITERMINAL)
(TERMINAL)))
(ADDTOVAR ASCIITONSTRANSLATIONS (ANSITERMINAL NIL TERMINAL))
(DEFINEQ
(ANSI-Chat-Initialize-Character-Translations
[LAMBDA NIL
(DECLARE (GLOBALVARS ANSI-ASCII-Graphics-Character-Set ANSI-Supplemental-Graphics-Character-Set
ANSI-Special-Graphics-Character-Set ANSI-British-NRC-Character-Set
ANSI-Dutch-NRC-Character-Set ANSI-Finnish-NRC-Character-Set
ANSI-French-NRC-Character-Set ANSI-French-Canadian-NRC-Character-Set
ANSI-German-NRC-Character-Set ANSI-Italian-NRC-Character-Set
ANSI-Norwegian/Danish-NRC-Character-Set ANSI-Spanish-NRC-Character-Set
ANSI-Swedish-NRC-Character-Set ANSI-Swiss-NRC-Character-Set))
(* ; "Edited 22-Sep-87 20:07 by R.Beeman")
(LET [[ANSI-ASCII-Graphics-Exceptions '(($ 0,44]
[ANSI-Supplemental-Graphics-Exceptions '((! 0,241)
(%" 0,242)
(%# 0,243)
($ 0,40)
(%% 0,245)
(& 0,40)
(%' 0,247)
(%( 0,44)
(%) 0,323)(* 0,343)
(+ 0,253)
(%, 0,40)
(- 0,40)
(%. 0,40)
(/ 0,40)
(0 0,260)
(1 0,261)
(2 0,262)
(3 0,263)
(4 0,40)
(5 0,265)
(6 0,266)
(7 0,267)
(8 0,40)
(9 0,321)
(%: 0,353)
(; 0,273)
(< 0,274)
(= 0,275)
(> 0,40)
(? 0,277)
(@ 361,41)
(A 361,42)
(B 361,43)
(C 361,44)
(D 361,47)
(E 361,50)
(F 0,341)
(G 361,55)
(H 361,60)
(I 361,61)
(J 361,62)
(K 361,65)
(L 361,76)
(M 361,77)
(N 361,100)
(O 361,104)
(P 0,40)
(Q 361,114)
(R 361,117)
(S 361,120)
(T 361,121)
(U 361,122)
(V 361,124)
(W 0,352)
(X 0,351)
(Y 361,137)
(Z 361,140)
(%[ 361,141)
(\ 361,145)
(%] 361,155)
(↑ 0,40)
(← 0,373)
(%` 361,241)
(a 361,242)
(b 361,243)
(c 361,244)
(d 361,247)
(e 361,250)
(f 0,361)
(g 361,255)
(h 361,260)
(i 361,261)
(j 361,262)
(k 361,265)
(l 361,276)
(m 361,277)
(n 361,300)
(o 361,304)
(p 0,40)
(q 361,314)
(r 361,317)
(s 361,320)
(t 361,321)
(u 361,322)
(v 361,324)
(w 0,372)
(x 0,371)
(y 361,337)
(z 361,340)
({ 361,341)
(%| 361,345)
(} 361,355)
(~ 0,40]
[ANSI-Special-Graphics-Exceptions '(($ 0,44)
(← 0,040)
(%` 42,041)
(a 360,313)
(b 360,271)
(c 360,273)
(d 360,274)
(e 360,272)
(f 0,260)
(g 0,261)
(h 360,275)
(i 360,270)
(j 50,045)
(k 50,044)
(l 50,043)
(m 50,046)
(n 357,346)
(o 375,320)
(p 375,321)
(q 357,345)
(r 375,322)
(s 375,323)
(t 50,047)
(u 50,051)
(v 50,052)
(w 50,050)
(x 357,344)
(y 41,145)
(z 41,146)
({ 46,163)
(%| 41,142)
(} 0,243)
(~ 0,267]
[ANSI-British-NRC-Exceptions '((%# 0,243)
($ 0,44]
[ANSI-Dutch-NRC-Exceptions '((%# 0,243)
($ 0,44)
(@ 0,276)
(%[ 0,366)
(\ 0,275)
(%] 0,174)
({ 0,310)
(%| 357,242)
(} 0,274)
(~ 0,302]
[ANSI-Finnish-NRC-Exceptions '(($ 0,44)
(%[ 361,047)
(\ 361,124)
(%] 361,050)
(↑ 361,145)
(%` 361,261)
({ 361,247)
(%| 361,324)
(} 361,345)
(~ 0,373]
[ANSI-French-NRC-Exceptions '((%# 0,243)
($ 0,44)
(@ 361,241)
(%[ 0,312)
(\ 361,255)
(%] 0,247)
({ 361,261)
(%| 361,337)
(} 361,260)
(~ 0,310]
[ANSI-French-Canadian-NRC-Exceptions '(($ 0,44)
(@ 361,241)
(%[ 361,243)
(\ 361,255)
(%] 361,262)
(↑ 361,300)
(%` 361,321)
({ 361,261)
(%| 361,337)
(} 361,260)
(~ 361,341]
[ANSI-German-NRC-Exceptions '(($ 0,44)
(@ 0,247)
(%[ 361,047)
(\ 361,124)
(%] 361,145)
({ 361,247)
(%| 361,324)
(} 361,345)
(~ 0,373]
[ANSI-Italian-NRC-Exceptions '((%# 0,243)
($ 0,44)
(@ 0,247)
(%[ 0,312)
(\ 361,255)
(%] 361,262)
(%` 361,337)
({ 361,241)
(%| 361,317)
(} 361,260)
(~ 361,277]
[ANSI-Norwegian/Danish-NRC-Exceptions '(($ 0,44)
(@ 361,047)
(%[ 0,341)
(\ 0,351)
(%] 361,050)
(↑ 361,145)
(%` 361,247)
({ 0,361)
(%| 0,371)
(} 361,250)
(~ 361,345]
[ANSI-Spanish-NRC-Exceptions '((%# 0,243)
($ 0,44)
(@ 0,247)
(%[ 0,241)
(\ 361,114)
(%] 0,277)
({ 0,312)
(%| 361,314)
(} 361,255]
[ANSI-Swedish-NRC-Exceptions '(($ 0,44)
(@ 361,061)
(%[ 361,047)
(\ 361,124)
(%] 361,050)
(↑ 361,145)
(%` 361,261)
({ 361,247)
(%| 361,324)
(} 361,250)
(~ 361,345]
(ANSI-Swiss-NRC-Exceptions '((%# 361,337)
($ 0,44)
(@ 361,241)
(%[ 361,261)
(\ 361,255)
(%] 361,262)
(↑ 361,300)
(← 361,260)
(%` 361,321)
({ 361,247)
(%| 361,324)
(} 361,345)
(~ 361,341]
(SETQ ANSI-ASCII-Graphics-Character-Set (ANSI-Chat-Build-Map ANSI-ASCII-Graphics-Exceptions)
)
(SETQ ANSI-Supplemental-Graphics-Character-Set (ANSI-Chat-Build-Map
ANSI-Supplemental-Graphics-Exceptions)
)
(SETQ ANSI-Special-Graphics-Character-Set (ANSI-Chat-Build-Map
ANSI-Special-Graphics-Exceptions))
(SETQ ANSI-British-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-British-NRC-Exceptions))
(SETQ ANSI-Dutch-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Dutch-NRC-Exceptions))
(SETQ ANSI-Finnish-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Finnish-NRC-Exceptions))
(SETQ ANSI-French-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-French-NRC-Exceptions))
(SETQ ANSI-French-Canadian-NRC-Character-Set (ANSI-Chat-Build-Map
ANSI-French-Canadian-NRC-Exceptions))
(SETQ ANSI-German-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-German-NRC-Exceptions))
(SETQ ANSI-Italian-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Italian-NRC-Exceptions))
(SETQ ANSI-Norwegian/Danish-NRC-Character-Set (ANSI-Chat-Build-Map
ANSI-Norwegian/Danish-NRC-Exceptions))
(SETQ ANSI-Spanish-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Spanish-NRC-Exceptions))
(SETQ ANSI-Swedish-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Swedish-NRC-Exceptions))
(SETQ ANSI-Swiss-NRC-Character-Set (ANSI-Chat-Build-Map ANSI-Swiss-NRC-Exceptions])
(ANSI-Chat-Build-Map
[LAMBDA (Exceptions) (* ; "Edited 9-Sep-87 16:51 by R.Beeman")
(LET ((Table (ARRAY 95 'WORD 0 0)))
(for Index from 0 to 94 as CharacterCode from (CHARCODE SPACE)
do (SETA Table Index CharacterCode))
[for Exception in Exceptions do (SETA Table (- (APPLY* (FUNCTION CHARCODE)
(CAR Exception))
(CHARCODE SPACE))
(APPLY* (FUNCTION CHARCODE)
(CADR Exception]
Table])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ANSI-ASCII-Graphics-Character-Set ANSI-Supplemental-Graphics-Character-Set
ANSI-Special-Graphics-Character-Set ANSI-British-NRC-Character-Set
ANSI-Dutch-NRC-Character-Set ANSI-Finnish-NRC-Character-Set ANSI-French-NRC-Character-Set
ANSI-French-Canadian-NRC-Character-Set ANSI-German-NRC-Character-Set
ANSI-Italian-NRC-Character-Set ANSI-Norwegian/Danish-NRC-Character-Set
ANSI-Spanish-NRC-Character-Set ANSI-Swedish-NRC-Character-Set ANSI-Swiss-NRC-Character-Set)
)
(ANSI-Chat-Initialize-Character-Translations)
(ANSI-Chat-Font-Initialize)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
FONTDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2212 26462 (ANSI-Chat-Build-Font-Descriptors 2222 . 13337) (ANSI-Chat-Copy-CharSet
13339 . 17562) (ANSI-Chat-Copy-CharSet-DoubleHeight 17564 . 21481) (ANSI-Chat-Copy-CharSet-DoubleWide
21483 . 25219) (ANSI-Chat-Font-Initialize 25221 . 26460)) (26770 43515 (
ANSI-Chat-Initialize-Character-Translations 26780 . 42779) (ANSI-Chat-Build-Map 42781 . 43513)))))
STOP