From 2993b4a030f114882c5a5c34fe487004fe5ba799 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 6 Apr 2026 10:08:35 -0700 Subject: [PATCH] FONT--STRIKE moved away, MAXCHARSET etc. --- sources/FONT | 1890 ++++++++++++++++++--------------------------- sources/FONT.LCOM | Bin 68484 -> 65846 bytes 2 files changed, 734 insertions(+), 1156 deletions(-) diff --git a/sources/FONT b/sources/FONT index 1a92ec84..d5ff75d5 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,57 +1,59 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "26-Feb-2026 17:01:47" {WMEDLEY}FONT.;677 278005 +(FILECREATED " 5-Apr-2026 11:55:11" {WMEDLEY}FONT.;779 256335 :EDIT-BY rmk - :CHANGES-TO (FNS MOVEFONTCHARS) + :CHANGES-TO (FNS COMPLETE.FONT COMPLETE.CHARSET \CREATECHARSET.DISPLAY \SFROTATECSINFO + FAKEFACE.CHARSET \CREATEFONT FLUSHFONTCACHE) - :PREVIOUS-DATE "20-Feb-2026 12:54:44" {WMEDLEY}FONT.;675) + :PREVIOUS-DATE " 4-Apr-2026 18:04:16" {WMEDLEY}FONT.;771) (PRETTYCOMPRINT FONTCOMS) (RPAQQ FONTCOMS [ - (* ;; "font functions ") + (* ;; "Font functions ") (FNS CHARWIDTH CHARWIDTHY STRINGWIDTH \CHARWIDTH.DISPLAY \STRINGWIDTH.DISPLAY \STRINGWIDTH.GENERIC) (COMS (FNS DEFAULTFONT FONTCLASS FONTCLASSUNPARSE FONTCLASSCOMPONENT SETFONTCLASSCOMPONENT GETFONTCLASSCOMPONENT) (MACROS \GETFONTCLASSCOMPONENT \SETFONTCLASSCOMPONENT)) - (VARS NSFONTFAMILIES ALTOFONTFAMILIES) - (INITVARS MCCSFONTFAMILIES) (COMS (* ;; "Creation: ") (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS1 \FONTCREATE1.NOFN - FONTFILEP \READCHARSET) + FONTFILEP \READCHARSET FONTCHARSETS) (FNS \FONT.CHECKARGS \CHARSET.CHECK) (FNS COERCEFONTSPEC COERCEFONTSPEC.TARGETFACE) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET)) (MACROS SPREADFONTSPEC) - (FNS MAKEFONTSPEC) + (FNS MAKEFONTSPEC FONTSPEC.TO.FONTDESCRIPTOR) (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNESLUGCSINFOS MONOSPACEFONTP)) (COMS (* ;; "Property extraction:") (FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH) (EXPORT (OPTIMIZERS FONTPROP)) - (FNS FONTDEVICEPROP)) + (FNS FONTDEVICEPROP) + (PROP ARGNAMES FONTDEVICEPROP)) (COMS (* ; "Moving character information") (FNS EDITCHAR) (* ; "Should this be on EDITFONT ?") (FNS GETCHARBITMAP PUTCHARBITMAP \GETCHARBITMAP.CSINFO \PUTCHARBITMAP.CSINFO) (FNS MOVECHARBITMAP MOVEFONTCHARS \MOVEFONTCHAR \MOVEFONTCHARS.SOURCEDATA \MAKESLUGCHAR - SLUGCHARP.DISPLAY) + SLUGCHARP) + [DECLARE%: DONTCOPY (EXPORT (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR] + (* ; "At the end of each csinfo") (MACROS UPDATEINFOELEMENT)) (FNS FONTFILES \FINDFONTFILE \FONTFILENAMES \FONTFILENAME FONTSPECFROMFILENAME) (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING ) (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FINDFONTFILES SORTFONTSPECS) - (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM) + (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM FONTFACE.STARS) (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \FONTSAVAILABLEFILECACHE \DEFAULTDEVICEFONTS) (* ;; "The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts") @@ -62,15 +64,14 @@ (INITVARS \UNITWIDTHSVECTOR) (FNS \UNITWIDTHSVECTOR) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR] - (DECLARE%: DONTCOPY [EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) + (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH - \FGETIMAGEWIDTH \FSETIMAGEWIDTH) + \FGETIMAGEWIDTH \FSETIMAGEWIDTH MAXCHARSET) (MACROS \GETCHARSETINFO \SETCHARSETINFO \INSURECHARSETINFO - \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP) - (PROP ARGNAMES CHARSETPROP) - (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET] + \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP + SLUGCSINFO) + (PROP ARGNAMES CHARSETPROP)) (MACROS INDIRECTCHARSETP)) (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT) (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO) @@ -80,8 +81,6 @@ (DECLARE%: DONTCOPY (MACROS FIRSTCHARSETCODE LASTCHARSETCODE)) (FNS \FONTRESETCHARWIDTHS) (MACROS \FGETCHARIMAGEWIDTH) - (LOCALVARS . T) - (PROP FILETYPE FONT) (* ;; "") @@ -90,115 +89,31 @@ (COMS (* ;  "Functions for DISPLAY IMAGESTREAMTYPES ") - (FNS \CREATEDISPLAYFONT \CREATECHARSET.DISPLAY \FONTEXISTS?.DISPLAY)) - (FNS STRIKEFONT.FILEP STRIKEFONT.GETCHARSET WRITESTRIKEFONTFILE STRIKECSINFO) + (FNS \CREATEDISPLAYFONT \CREATECHARSET.DISPLAY \FONTEXISTS?.DISPLAY) + (FNS FAKEFACE.CHARSET MAKEBOLD.CHAR MAKEITALIC.CHAR)) (COMS (* ; "Bitmap faking") - (FNS MAKEBOLD.CHARSET MAKEBOLD.CHAR MAKEITALIC.CHARSET MAKEITALIC.CHAR \SFMAKEBOLD - \SFMAKEITALIC) - (FNS \SFMAKEROTATEDFONT \SFROTATECSINFO \SFROTATEFONTCHARACTERS \SFROTATECSINFOOFFSETS) + (FNS \SFROTATECSINFO \SFROTATEFONTCHARACTERS \SFROTATECSINFOOFFSETS) (FNS \SFMAKECOLOR)) - (EXPORT (GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS - DISPLAYFONTCOERCIONS DISPLAYCHARSETFNS)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES NIL)) - (ADDVARS (DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))) + [DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES NIL)) (* ; "The loadup might have fewer") - (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT DISPLAYFONT))) - (INITVARS [DISPLAYFONTCOERCIONS '(((HELVETICA (<= * 2)) - (HELVETICA 4)) - ((MODERN (<= 15 * 16)) - (* 14)) - ((MODERN (<= 17 * 21)) - (* 18)) - ((MODERN (<= 22 * 28)) - (* 24)) - ((MODERN (<= 29 * 33)) - (* 30)) - ((MODERN (<= 34 * 40)) - (* 36)) - ((MODERN (<= 41 * 65)) - (* 48)) - ((MODERN (<= 66 *)) - (* 72)) - ((PALATINO 9) - (PALATINO 12)) - ((PALATINO (<= * 8)) - (PALATINO 10)) - ((TITAN (<= * 9) - BOLD) - (MODERN 10)) - ((TITAN (<= * 9) - ITALIC) - (MODERN 10)) - ((TITAN (<= * 9)) - (TITAN 10)) - (LPT AMTEX] - [DISPLAYCHARCOERCIONS '((GACHA TERMINAL) - (MODERN CLASSIC) - (TIMESROMAN CLASSIC) - (HELVETICA MODERN) - (TERMINAL MODERN) - (HIPPO CLASSIC) - (CYRILLIC CLASSIC) - (MATH CLASSIC) - (SIGMA MODERN) - (SYMBOL MODERN) - (TITAN CLASSIC) - (PALATINO CLASSIC) - (OPTIMA MODERN) - (BOLDPS CLASSIC) - (PCTERMINAL CLASSIC) - (TITANLEGAL CLASSIC] - (\DEFAULTCHARSET 0)) - - (* ;; "") - - - (* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") - - [COMS (INITVARS [ADOBEDISPLAYFONTCOERCIONS '(((HELVETICABLACK 16) - (HELVETICABLACK 18)) - ((SYMBOL) - (ADOBESYMBOL)) - ((SYMBOL 11) - (ADOBESYMBOL 10)) - ((AVANTGARDE-DEMI) - (AVANTGARDE)) - ((AVANTGARDE-BOOK) - (AVANTGARDE)) - ((NEWCENTURYSCHLBK) - (CENTURYSCHOOLBOOK)) - ((BOOKMAN-LIGHT) - (BOOKMAN)) - ((BOOKMAN-DEMI) - (BOOKMAN)) - ((HELVETICA-NARROW) - (HELVETICANARROW)) - ((HELVETICA 24) - (ADOBEHELVETICA 24] - (*DISPLAY-FONT-NAME-MAP* '((TIMESROMAN . TR) - (HELVETICA . HV) - (TIMESROMAND . TD) - (HELVETICAD . HD) - (MODERN . MD) - (CLASSIC . CL) - (GACHA . GC) - (TITAN . TI) - (LETTERGOTHIC . LG) - (BOLDPS . BP) - (TERMINAL . TM) - (CLASSICTHIN . CT) - (HIPPO . HP) - (LOGO . LG) - (MATH . MA) - (OLDENGLISH . OE) - (SYMBOL . SY] + (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)) + (INITVARS (DISPLAYFACECOERCIONS '(((* * (BOLD * *)) + (* * (MEDIUM * *))) + ((* * (* ITALIC *)) + (* * (* REGULAR *))) + ((* * (* * COMPRESSED)) + (* * (* * REGULAR] + (INITVARS (\DEFAULTCHARSET 0)) + (LOCALVARS . T) + (PROP FILETYPE FONT) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) - (LAMA FONTCOPY]) + (LAMA FONTCOPY + FONTDEVICEPROP]) -(* ;; "font functions ") +(* ;; "Font functions ") (DEFINEQ @@ -484,13 +399,6 @@ DEVICE NEWFONT)))) ) -(RPAQQ NSFONTFAMILIES (CLASSIC MODERN TERMINAL OPTIMA TITAN BOLDPS PCTERMINAL)) - -(RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM - OLDENGLISH)) - -(RPAQ? MCCSFONTFAMILIES NIL) - (* ;; "Creation: ") @@ -544,7 +452,8 @@ (GO RETRY]) (FONTCREATE1 - [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 25-Sep-2025 18:41 by rmk") + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 17-Mar-2026 23:41 by rmk") + (* ; "Edited 25-Sep-2025 18:41 by rmk") (* ; "Edited 30-Aug-2025 23:13 by rmk") (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 26-Aug-2025 23:45 by rmk") @@ -567,8 +476,7 @@ (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) (LET (FONT) (CL:WHEN (if (SETQ FONT (FETCHMULTI \FONTSINCORE FONTSPEC T)) - elseif (AND (FONTEXISTS? FONTSPEC) - (SETQ FONT (\CREATEFONT FONTSPEC))) + elseif (SETQ FONT (\CREATEFONT FONTSPEC)) then (* ;; "Storing stops internal charset recursions") @@ -581,30 +489,37 @@ FONT)]) (FONTCREATE.SLUGFD - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET) (* ; "Edited 31-Aug-2025 14:36 by rmk") + [LAMBDA (FONTSPEC SOURCEFONT) (* ; "Edited 21-Mar-2026 09:20 by rmk") + (* ; "Edited 19-Mar-2026 20:47 by rmk") + (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 14-Jun-2025 23:25 by rmk") (* ; "Edited 13-Jun-2025 09:44 by rmk") (* ; "Edited 11-Jun-2025 10:59 by rmk") - (* ;; "For the REMEMBER case, dummy font descriptor completely fillled with a slug charsetinfo") + (* ;; + "Makes an empty fontdescriptor for FONTSPEC, with parameters taken from SOURCEFONT if given") - (LET* ([FONTDESC (create FONTDESCRIPTOR - FONTDEVICE ← DEVICE - FONTFAMILY ← FAMILY - FONTSIZE ← SIZE - FONTFACE ← FACE - \SFAscent ← SIZE - \SFDescent ← 0 - \SFHeight ← SIZE - ROTATION ← ROTATION - FONTDEVICESPEC ← (LIST FAMILY SIZE FACE ROTATION DEVICE) - FONTCHARENCODING ← 'MCCS - FONTAVGCHARWIDTH ← (FIXR (FTIMES SIZE 0.75] - (SLUGCSINFO (\BUILDSLUGCSINFO FONTDESC))) - (if CHARSET - then (\SETCHARSETINFO FONTDESC CHARSET SLUGCSINFO) - else (for CS from 0 to (ADD1 \MAXCHARSET) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO))) - FONTDESC]) + (LET ((FONTDESC (if SOURCEFONT + then (create FONTDESCRIPTOR using SOURCEFONT FONTFAMILY ← (fetch (FONTSPEC + FSFAMILY) + of FONTSPEC) + FONTSIZE ← (fetch (FONTSPEC FSSIZE) + of FONTSPEC) + FONTFACE ← (fetch (FONTSPEC FSFACE) + of FONTSPEC) + ROTATION ← (fetch (FONTSPEC FSROTATION) + of FONTSPEC) + FONTDEVICE ← (fetch (FONTSPEC FSDEVICE) + of FONTSPEC) + FONTDEVICESPEC ← FONTSPEC FONTCHARSETVECTOR + ← NIL) + else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC))) + SLUGCSINFO) + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONTDESC with (\CREATEFONTCHARSETVECTOR + FONTDESC)) + (SETQ SLUGCSINFO (\BUILDSLUGCSINFO)) + (for CS from 0 to (ADD1 (MAXCHARSET FONTDESC)) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO)) + FONTDESC]) (\FONT.CHECKARGS1 [LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 19-Feb-2026 00:03 by rmk") @@ -705,7 +620,12 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 14-Feb-2026 09:47 by rmk") + [LAMBDA (FONTSPEC CHARSET FONT CHARSETFNS) (* ; "Edited 2-Apr-2026 15:52 by rmk") + (* ; "Edited 28-Mar-2026 07:51 by rmk") + (* ; "Edited 17-Mar-2026 08:57 by rmk") + (* ; "Edited 12-Mar-2026 13:39 by rmk") + (* ; "Edited 8-Mar-2026 21:41 by rmk") + (* ; "Edited 14-Feb-2026 09:47 by rmk") (* ; "Edited 6-Feb-2026 00:03 by rmk") (* ; "Edited 11-Nov-2025 14:30 by rmk") (* ; "Edited 2-Sep-2025 23:57 by rmk") @@ -726,8 +646,8 @@ do (* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit. We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.") - (for FNS FAMILY in [OR (FONTDEVICEPROP FONTSPEC 'CHARSETFNS) - '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] + (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONTSPEC 'CHARSETFNS) + '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF? OLDVALUE] (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS) @@ -742,20 +662,10 @@ (* ;; "The file didn't know its own encoding") - (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTSPEC)) (CHARSETPROP CSINFO 'CSCHARENCODING - (if (OR (NEQ CHARSET 0) - (MEMB FAMILY MCCSFONTFAMILIES)) - then 'MCCS - elseif (MEMB FAMILY NSFONTFAMILIES) - then 'XCCS$ - elseif (MEMB FAMILY ALTOFONTFAMILIES) - then 'ALTOTEXT - else FAMILY))) - - (* ;; "Remember the file that this basic charset information came from, before any character coercions, for informational purposes. Path and version won't be valid if sysout moves, or if PSEUDOFILENAME's aren't aligned. Don't want files to be new atoms, for loadup.") - - (CHARSETPROP CSINFO 'FILE (MKSTRING (PSEUDOFILENAME FILE))) + (APPLY* (OR (FONTDEVICEPROP FONTSPEC 'ENCODINGFN) + (FUNCTION NILL)) + FONTSPEC))) (CL:UNLESS (CHARSETPROP CSINFO 'SOURCE) (CHARSETPROP CSINFO 'SOURCE (create FONTSPEC using FONTSPEC))) (replace (CHARSETINFO CHARSETNO) of CSINFO with CHARSET) @@ -765,6 +675,14 @@ (CLOSEF? STRM)) (CL:WHEN CSINFO (RETURN CSINFO)))))]) + +(FONTCHARSETS + [LAMBDA (FONT) (* ; "Edited 26-Mar-2026 12:46 by rmk") + + (* ;; "Returns a list of the charset numbers for nonempty instantiated charsets.") + + (for CSNO CSINFO from 0 to (MAXCHARSET FONT) when (SETQ CSINFO (\GETCHARSETINFO FONT CSNO)) + unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CSNO]) ) (DEFINEQ @@ -886,7 +804,9 @@ (DEFINEQ (COERCEFONTSPEC - [LAMBDA (FONTSPEC COERCIONS ALL) (* ; "Edited 22-Dec-2025 22:56 by rmk") + [LAMBDA (FONTSPEC COERCIONS ALL MISSINGOK) (* ; "Edited 2-Apr-2026 00:08 by rmk") + (* ; "Edited 11-Mar-2026 10:18 by rmk") + (* ; "Edited 22-Dec-2025 22:56 by rmk") (* ; "Edited 18-Dec-2025 16:06 by rmk") (* ; "Edited 2-Dec-2025 17:24 by rmk") (* ; "Edited 25-Nov-2025 20:37 by rmk") @@ -947,20 +867,12 @@ (EQUAL FACE TFACE) (EQ ROTATION TROTATION] (MAKEFONTSPEC TFAMILY TSIZE TFACE TROTATION DEVICE] - unless (MEMBER COERCED RESULT) - when (SETQ COERCED (if (FONTEXISTS? COERCED NIL NIL NIL NIL T) - then (CONS COERCED) - elseif ALL - then (COERCEFONTSPEC COERCED COERCIONS T) - elseif (SETQ COERCED (COERCEFONTSPEC COERCED COERCIONS)) - then (CONS COERCED))) do + unless (MEMBER COERCED RESULT) when (OR MISSINGOK (FONTEXISTS? COERCED T)) + do + (* ;; "If COERCED exists, it's a singleton whether or not ALL. We always inflate it to a list, to simplify code") - (* ;; "If COERCED exists, it's a singleton whether or not ALL. We always inflate it to a list, to simplify code") - - (for C in COERCED - unless (MEMBER C RESULT) - do (push RESULT C)) - finally (RETURN (DREVERSE RESULT]) + (for C in (CONS COERCED (CL:IF ALL (COERCEFONTSPEC COERCED COERCIONS ALL MISSINGOK))) + unless (MEMBER C RESULT) do (push RESULT C)) finally (RETURN (DREVERSE RESULT]) (COERCEFONTSPEC.TARGETFACE [LAMBDA (TFACE FFACE) (* ; "Edited 22-Dec-2025 22:54 by rmk") @@ -1037,50 +949,77 @@ FSFACE ← (OR FACE (fetch (FONTSPEC FSFACE) of BASE)) FSROTATION ← (OR ROTATION (fetch (FONTSPEC FSROTATION) of BASE)) FSDEVICE ← (OR DEVICE (fetch (FONTSPEC FSDEVICE) of BASE]) + +(FONTSPEC.TO.FONTDESCRIPTOR + [LAMBDA (FONTSPEC MAXCHARSET) (* ; "Edited 29-Mar-2026 10:29 by rmk") + (* ; "Edited 28-Mar-2026 09:29 by rmk") + (* ; "Edited 20-Mar-2026 23:57 by rmk") + (* ; "Edited 19-Mar-2026 10:24 by rmk") + (* ; "Edited 12-Mar-2026 13:29 by rmk") + (if (NULL MAXCHARSET) + then (SETQ MAXCHARSET 255) + elseif (<= 0 MAXCHARSET \MAXCHARSET) + else (\ILLEGAL.ARG MAXCHARSET)) + (LET ((FONT (create FONTDESCRIPTOR + FONTFAMILY ← (fetch (FONTSPEC FSFAMILY) of FONTSPEC) + FONTSIZE ← (fetch (FONTSPEC FSSIZE) of FONTSPEC) + FONTFACE ← (fetch (FONTSPEC FSFACE) of FONTSPEC) + ROTATION ← (fetch (FONTSPEC FSROTATION) of FONTSPEC) + FONTDEVICE ← (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + \SFAscent ← 0 + \SFDescent ← 0 + \SFHeight ← 0 + FONTDEVICESPEC ← (create FONTSPEC using FONTSPEC) + MAXCHARSET ← MAXCHARSET + FONTCHARSETVECTOR ← NIL))) + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT with (\CREATEFONTCHARSETVECTOR FONT)) + FONT]) ) (DEFINEQ (COMPLETE.FONT - [LAMBDA (FONTSPEC EVENIFCOMPLETE) (* ; "Edited 7-Oct-2025 17:01 by rmk") - (* ; "Edited 2-Sep-2025 22:59 by rmk") - (* ; "Edited 29-Aug-2025 23:51 by rmk") - (* ; "Edited 27-Aug-2025 10:51 by rmk") + [LAMBDA (FONT EVENIFCOMPLETE) (* ; "Edited 5-Apr-2026 01:01 by rmk") + (* ; "Edited 24-Mar-2026 22:35 by rmk") + (* ; "Edited 22-Mar-2026 22:32 by rmk") + (* ; "Edited 21-Mar-2026 09:20 by rmk") + (* ; "Edited 19-Mar-2026 09:30 by rmk") + (* ; "Edited 16-Mar-2026 09:30 by rmk") + (* ; "Edited 7-Oct-2025 17:01 by rmk") (* ; "Edited 21-Jun-2025 11:37 by rmk") - (* ; "Edited 19-Jun-2025 14:42 by rmk") - (* ; "Edited 12-Jun-2025 22:06 by rmk") - (* ; "Edited 8-Jun-2025 15:57 by rmk") - (* ; "Edited 7-Jun-2025 15:18 by rmk") (* ; "Edited 23-May-2025 22:57 by rmk") - (* ; "Edited 20-May-2025 19:57 by rmk") (* ; "Edited 16-May-2025 21:26 by rmk") - (* ;; "This returns a FONTDESCRIPTOR for FONTSPEC that is complete with respect to all known character sources. A caller that wants to insure that only files sources are considered should reset \FONTSINCORE and \FONTEXISTS?-CACHE. If reset, we still get the benefit of previous completions/coercions in this run if medleyfont files have been created for them.") + (* ;; "This completes FONT with respect to all currently known character sources. A caller that wants to insure that only file sources are considered should reset \FONTSINCORE and \FONTEXISTS?-CACHE. ") - (LET ((FONT (FONTCREATE FONTSPEC))) - (SETQ FONTSPEC (FONTPROP FONT 'SPEC)) (* ; "Normalized version") - (CL:WHEN (OR EVENIFCOMPLETE (NOT (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT))) - (for CHARSET CSINFO from 0 to \MAXCHARSET - do (if (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET)) - then (CL:WHEN EVENIFCOMPLETE - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with NIL)) - else (SETQ CSINFO (\CREATECHARSET CHARSET FONT))) - (COMPLETE.CHARSET CSINFO FONTSPEC CHARSET FONT)) - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with T)) - (PRUNESLUGCSINFOS FONT) - FONT]) + (* ;; "This assumes that all of the fonts in the coercion chain are already complete. ") + + (LET (CHANGED) + (CL:WHEN (AND (OR EVENIFCOMPLETE (NOT (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT))) + (COERCEFONTSPEC (FONTPROP FONT 'SPEC) + 'CHARCOERCIONS NIL T)) + (for CHARSET from 0 to (MAXCHARSET FONT) when (COMPLETE.CHARSET FONT CHARSET) + do (SETQ CHANGED T))) + (CL:UNLESS (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with T) + (SETQ CHANGED T)) + CHANGED]) (COMPLETEFONTP - [LAMBDA (FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (FONT) (* ; "Edited 18-Mar-2026 23:10 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 24-May-2025 20:55 by rmk") (* ; "Edited 20-May-2025 14:37 by rmk") (* ;; "A font is incomplete if there is a NIL in any charset slot. Completing will install a charset everywhere, even if it is a slug charset.") (SETQ FONT (FONTCREATE FONT)) - (for CS from 0 to \MAXCHARSET always (\GETCHARSETINFO FONT CS]) + (for CS from 0 to (MAXCHARSET FONT) always (\GETCHARSETINFO FONT CS]) (COMPLETE.CHARSET - [LAMBDA (CSINFO FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 11:23 by rmk") + [LAMBDA (FONT CHARSET) (* ; "Edited 5-Apr-2026 11:33 by rmk") + (* ; "Edited 15-Mar-2026 17:20 by rmk") + (* ; "Edited 6-Mar-2026 21:42 by rmk") + (* ; "Edited 7-Sep-2025 11:23 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 20:46 by rmk") (* ; "Edited 27-Aug-2025 12:37 by rmk") @@ -1093,39 +1032,62 @@ (* ; "Edited 8-Jun-2025 20:20 by rmk") (* ; "Edited 7-Jun-2025 13:52 by rmk") - (* ;; "CSINFO has some characters for this charset in FONT, but others may fill in from the FONTSPEC of later fonts in the coercion chain. We assume that CSINFO is or will be the charsetinfo for the charset/font described by FONTSPEC. For each missing code we look through all the possible coercions to find the first font with real information about that character. We copy that character up to CSINFO.") + (* ;; "Return T if anything changed.") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (CL:UNLESS (fetch (CHARSETINFO CSCOMPLETEP) of CSINFO) - (for CODE SOURCEFONT from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - when [AND (SLUGCHARP.DISPLAY CODE FONT) - (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE] - collect (LIST (LIST CODE SOURCEFONT) - CODE) finally (CL:WHEN $$VAL (* ; "The source is now here") - (MOVEFONTCHARS $$VAL FONT) - (CHARSETPROP CSINFO 'SOURCE FONTSPEC))) - (CL:WHEN (FONTDEVICEPROP FONT 'CHARCOERCIONS) (* ; + (LET ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) + (CSINFO (\GETCHARSETINFO FONT CHARSET)) + CHANGED) + (CL:UNLESS CSINFO + (SETQ CSINFO (SLUGCSINFO FONT)) + (SETQ CHANGED T)) + (CL:UNLESS (fetch (CHARSETINFO CSCOMPLETEP) of CSINFO) + [if (fetch (CHARSETINFO CSSLUGP) of CSINFO) + then + (* ;; "If CSINFO is a slug and there is a non-slug down the coercion chain, copy that in. Presumably that gets filed as an indirect.") + + [SETQ CSINFO (CADR (\COERCECHARSET FONTSPEC CHARSET NIL 'CHARCOERCIONS] + (CL:WHEN (AND CSINFO (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) + (\INSTALLCHARSETINFO FONT (COPYALL CSINFO) + CHARSET) + (SETQ CHANGED T)) + else + (* ;; "CSINFO in FONT has some characters for this charset, but others may fill in from later fonts in the coercion chain. We assume that CSINFO is or will be the charsetinfo for the charset/font described by FONTSPEC. For each missing code we look through all the possible coercions to find the first font with real information about that character. We copy that character up to CSINFO.") + + (for CODE SOURCEFONT from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) + when [AND (SLUGCHARP CODE FONT) + (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE] + collect (LIST CODE (LIST CODE SOURCEFONT)) + finally (CL:WHEN $$VAL + (MOVEFONTCHARS $$VAL FONT)(* ; "The source is now here") + (CHARSETPROP CSINFO 'SOURCE FONTSPEC)) + (CL:UNLESS (FONTDEVICEPROP FONT 'CHARCOERCIONS) + (* ;  "Maybe coercions are just being delayed") - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T))) - CSINFO]) + (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T)) + (CL:WHEN $$VAL (SETQ CHANGED T]) + CHANGED]) (PRUNESLUGCSINFOS - [LAMBDA (FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (FONT) (* ; "Edited 22-Mar-2026 18:21 by rmk") + (* ; "Edited 19-Mar-2026 09:29 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 17-Aug-2025 19:44 by rmk") (* ; "Edited 9-Jun-2025 15:02 by rmk") (* ; "Edited 24-May-2025 21:11 by rmk") - (* ;; "Replaces slug csinfos in FONT with NIL") + (* ;; "Replaces slug csinfos in FONT with NIL, returns the number of non-slug charsets") (SETQ FONT (FONTCREATE FONT)) - (for CS CSINFO from 0 to \MAXCHARSET when (AND (SETQ CSINFO (\GETCHARSETINFO FONT CS)) - (fetch (CHARSETINFO CSSLUGP) of CSINFO)) - do (\SETCHARSETINFO FONT CS NIL)) - FONT]) + (for CS CSINFO CHANGED (NREAL ← 0) from 0 to (MAXCHARSET FONT) when (SETQ CSINFO (\GETCHARSETINFO + FONT CS)) + do (CL:IF (fetch (CHARSETINFO CSSLUGP) of CSINFO) + (\SETCHARSETINFO FONT CS NIL) + (add NREAL 1)) finally (RETURN NREAL]) (MONOSPACEFONTP - [LAMBDA (FONT CODES SKIPSLUGS RETURNVARIABLES) (* ; "Edited 12-Oct-2025 21:13 by rmk") + [LAMBDA (FONT CODES SKIPSLUGS RETURNVARIABLES) (* ; "Edited 15-Mar-2026 14:24 by rmk") + (* ; "Edited 12-Oct-2025 21:13 by rmk") (* ;; "Returns T if all the CODES are the same width. Skips slugs if SKIPSLUGHTS, returns the list of variable width characters if RETURNVARIABLES (instead of NIL).") @@ -1141,7 +1103,7 @@ (LIST (FIRSTCHARSETCODE CODES) (LASTCHARSETCODE CODES] (for CODE WIDTH from (CAR CODES) to (CADR CODES) - unless (OR (AND SKIPSLUGS (SLUGCHARP.DISPLAY CODE FONT)) + unless (OR (AND SKIPSLUGS (SLUGCHARP CODE FONT)) (EQ (OR WIDTH (SETQ WIDTH (CHARWIDTH CODE FONT))) (CHARWIDTH CODE FONT))) collect CODE finally (RETURN (if (NULL $$VAL) @@ -1175,7 +1137,9 @@ (fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC]) (FONTPROP - [LAMBDA (FONT PROP) (* ; "Edited 25-Jan-2026 20:08 by rmk") + [LAMBDA (FONT PROP) (* ; "Edited 28-Mar-2026 07:51 by rmk") + (* ; "Edited 18-Mar-2026 23:11 by rmk") + (* ; "Edited 25-Jan-2026 20:08 by rmk") (* ; "Edited 2-Dec-2025 16:01 by rmk") (* ; "Edited 2-Sep-2025 22:21 by rmk") (* ; "Edited 12-Aug-2025 21:10 by rmk") @@ -1249,10 +1213,22 @@ (fetch (FONTSPEC FSFACE) of (ffetch FONTDEVICESPEC of FONT)) (ffetch FONTFACE of FONT)))) (SCALE (ffetch FONTSCALE of FONT)) - (CHARSETS (for CS CSINFO (CSVECTOR ← (ffetch FONTCHARSETVECTOR of FONT)) from 0 to - \MAXCHARSET - eachtime (SETQ CSINFO (\GETBASEPTR CSVECTOR (UNFOLD CS 2))) when CSINFO - unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)) + (CHARSETS (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO + FONT CS)) + when CSINFO unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)) + (MAXCHARSET (MAXCHARSET FONT)) + (NEMPTYCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + when CSINFO count (fetch (CHARSETINFO CSSLUGP) of CSINFO))) + (NINSTANTIATEDCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + when CSINFO count (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO)))) + (NUNINSTANTIATEDCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + count (NULL CSINFO))) (AVGCHARWIDTH (ffetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FONT)) (FONTTOMCCSFN (ffetch FONTTOMCCSFN of FONT)) (\ILLEGAL.ARG PROP]) @@ -1282,6 +1258,7 @@ (HEIGHT `(FONTHEIGHT ,(CAR ARGS))) (FONTTOMCCSFN `(fetch (FONTDESCRIPTOR FONTTOMCCSFN) of ,(CAR ARGS))) + (MAXCHARSET `(MAXCHARSET ,(CAR ARGS))) 'IGNOREMACRO)) (* "END EXPORTED DEFINITIONS") @@ -1289,23 +1266,43 @@ (DEFINEQ (FONTDEVICEPROP - [LAMBDA (FONTDEVICE PROP) (* ; "Edited 25-Aug-2025 21:23 by rmk") + [LAMBDA NARGS (* ; "Edited 8-Mar-2026 21:48 by rmk") + (* ; "Edited 2-Mar-2026 13:14 by rmk") + (* ; "Edited 1-Mar-2026 12:22 by rmk") + (* ; "Edited 25-Aug-2025 21:23 by rmk") (* ;; "Returns the value of the PROP property of the FONTDEVICE. E.g. if FONTDEVICE is DISPLAY and PROP is %"FONTCOERCIONS%", returns the value of DISPLAYFONTCOERCIONS ((HELVETICA 1)(HELVETICA 4)...)") - [if (LITATOM FONTDEVICE) - then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE)) - else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE)) - (SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE) - (FONTPROP FONTDEVICE 'DEVICE) - (fetch (FONTSPEC FSDEVICE) of FONTDEVICE))] - (CL:UNLESS FONTDEVICE - (SETQ FONTDEVICE 'DISPLAY)) - (LET ((VAR (PACK* FONTDEVICE PROP))) - (CL:WHEN (BOUNDP VAR) - (GETATOMVAL VAR]) + (CL:WHEN (ILESSP NARGS 2) + (ERROR "DEVICE/PROP not specified")) + (LET ((FONTDEVICE (ARG NARGS 1)) + (PROP (ARG NARGS 2)) + VAR) + [if (LITATOM FONTDEVICE) + then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE)) + else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE)) + (SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE) + (FONTPROP FONTDEVICE 'DEVICE) + (fetch (FONTSPEC FSDEVICE) of FONTDEVICE))] + (CL:UNLESS FONTDEVICE + (SETQ FONTDEVICE 'DISPLAY)) + (SETQ VAR (PACK* FONTDEVICE PROP)) + (if (EQ PROP 'ENCODINGFN) + then + (* ;; "The name of a function") + + (PROG1 (CL:IF (GETD VAR) + VAR) + (CL:WHEN (IGEQ NARGS 3) + (PUTD VAR (ARG NARGS 3)))) + else (PROG1 (CL:WHEN (BOUNDP VAR) + (GETATOMVAL VAR)) + (CL:WHEN (IGEQ NARGS 3) + (SETATOMVAL VAR (ARG NARGS 3))))]) ) +(PUTPROPS FONTDEVICEPROP ARGNAMES (FONTDEVICE PROP NEWVALUE)) + (* ; "Moving character information") @@ -1550,7 +1547,11 @@ NEWDESCENT]) (MOVEFONTCHARS - [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 26-Feb-2026 16:59 by rmk") + [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 9-Mar-2026 23:00 by rmk") + (* ; "Edited 7-Mar-2026 11:41 by rmk") + (* ; "Edited 4-Mar-2026 10:33 by rmk") + (* ; "Edited 1-Mar-2026 09:40 by rmk") + (* ; "Edited 26-Feb-2026 16:59 by rmk") (* ; "Edited 4-Sep-2025 11:07 by rmk") (* ; "Edited 30-Aug-2025 23:20 by rmk") (* ; "Edited 26-Aug-2025 23:10 by rmk") @@ -1566,9 +1567,13 @@ (* ;; "The character information for schar in sfont replaces the information for the destination character in the destination font.") - (* ;; "Pairs is a list of (SOURCE DEST) pairs where each source is a list of the form (schar/code sfont) or just a character, and each DEST is a destination character/code. If a pair is a character code C, it is treated as (C C).") + (* ;; "Pairs is either") - (* ;; "If a pair does not contain its own source font, then information is extracted from the DEFAULTSOURCEFONT. If the DEFAULTSOURCEFONT is not provided, thenSFONT it is assumed that the source is the DESTFONT (which must always be provided).") + (* ;; " a hasharray that maps destination codes to source codes") + + (* ;; " a list of (DEST SOURCE) pairs where each source is a list of the form (schar/scode sfont) or just a schar/scode, and each DEST is a destination character/code. An schar/scode of NIL designates a slug source.") + + (* ;; "If a pair does not contain its own source font, then information is extracted from the DEFAULTSOURCEFONT. If the DEFAULTSOURCEFONT is not provided, then it is assumed that the source is the DESTFONT (which must always be provided).") (* ;; "This collects the source information for all the pairs before it starts, to make sure that it doesn't step on itself when source and destination are the same font.") @@ -1578,41 +1583,42 @@ (FONTCREATE DEFAULTSOURCEFONT NIL NIL NIL (FONTPROP DESTFONT 'DEVICE)) DESTFONT)) - [if (HARRAYP PAIRS) - then - (* ;; "E.g. *UNICODETOMCCS*") + (LET (PAIRINFO) - [MAPHASH PAIRS (FUNCTION (LAMBDA (VAL KEY) - (CL:UNLESS (EQ VAL KEY) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA KEY - DEFAULTSOURCEFONT) - VAL DESTFONT))] - else (LET (PAIRINFO) + (* ;; "Collect and execute at the end, so that we have validated all of the source information before making any changes. ") - (* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.") + [if (HARRAYP PAIRS) + then + (* ;; "E.g. *UNICODETOMCCS*") - (SETQ PAIRINFO (for P S DCODE in PAIRS collect (CL:WHEN (SMALLP P) - (SETQ P (LIST P P))) - (SETQ DCODE (CADR P)) - (CL:UNLESS (CHARCODEP DCODE) - (SETQ DCODE (CHARCODE.DECODE - DCODE))) - (\INSURECHARSETINFO DESTFONT - (\CHARSET DCODE)) - (LIST (\MOVEFONTCHARS.SOURCEDATA - (CAR P) - DEFAULTSOURCEFONT) - DCODE))) + [MAPHASH PAIRS (FUNCTION (LAMBDA (SCODE DCODE) + (\INSURECHARSETINFO DESTFONT (\CHARSET DCODE)) + (LET ((SD (\MOVEFONTCHARS.SOURCEDATA SCODE + DEFAULTSOURCEFONT DESTFONT DCODE + DESTFONT))) + (CL:WHEN (push PAIRINFO (LIST SD DCODE] + else (for P DCODE SD in PAIRS do (CL:WHEN (SMALLP P) + (SETQ P (LIST P P))) + (SETQ DCODE (CAR P)) + (CL:UNLESS (CHARCODEP DCODE) + (SETQ DCODE (CHARCODE.DECODE DCODE))) + (\INSURECHARSETINFO DESTFONT (\CHARSET DCODE)) + (SETQ SD (\MOVEFONTCHARS.SOURCEDATA (CADR P) + DEFAULTSOURCEFONT DCODE DESTFONT)) + (CL:WHEN SD + (push PAIRINFO (LIST SD DCODE)))] - (* ;; "Install source character information into the destination font. ") + (* ;; + "Arguments checked out. install source character information into destfont slots. ") - (for P in PAIRINFO do (\MOVEFONTCHAR (CAR P) - (CADR P) - DESTFONT]) + (for P in PAIRINFO do (\MOVEFONTCHAR (CAR P) + (CADR P) + DESTFONT)))) DESTFONT]) (\MOVEFONTCHAR - [LAMBDA (SOURCEDATA DCODE DFONT) (* ; "Edited 25-Sep-2025 21:25 by rmk") + [LAMBDA (SOURCEDATA DCODE DFONT) (* ; "Edited 4-Mar-2026 11:03 by rmk") + (* ; "Edited 25-Sep-2025 21:25 by rmk") (* ; "Edited 4-Sep-2025 12:37 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 20:50 by rmk") @@ -1660,7 +1666,6 @@ (UPDATEINFOELEMENT YWIDTHS) (CL:WHEN (GETMULTI SOURCEDATA 'LEFTKERN) (\FSETLEFTKERN DCSINFO DTHINCODE (GETMULTI SOURCEDATA 'LEFTKERN))) - (replace (CHARSETINFO CSSLUGP) of DCSINFO with NIL) (CHARSETPROP DCSINFO 'SOURCE (FONTPROP DFONT 'SPEC)))] (SETQ DESCENT (IMAX (GETMULTI SOURCEDATA 'DESCENT) (fetch (CHARSETINFO CHARSETDESCENT) of DCSINFO))) @@ -1677,7 +1682,10 @@ DCSINFO]) (\MOVEFONTCHARS.SOURCEDATA - [LAMBDA (SOURCE DEFAULTSOURCEFONT) (* ; "Edited 6-Sep-2025 12:59 by rmk") + [LAMBDA (SOURCE DEFAULTSOURCEFONT DCODE DESTFONT) (* ; "Edited 15-Mar-2026 14:24 by rmk") + (* ; "Edited 9-Mar-2026 23:00 by rmk") + (* ; "Edited 7-Mar-2026 11:41 by rmk") + (* ; "Edited 6-Sep-2025 12:59 by rmk") (* ; "Edited 4-Sep-2025 11:01 by rmk") (* ; "Edited 2-Sep-2025 13:28 by rmk") (* ; "Edited 30-Aug-2025 23:20 by rmk") @@ -1695,6 +1703,8 @@ (* ;; " a list of the form (sourcechar sourcefont) where sourcechar is a name or code and sourcefont is a full or partial font specification with defaults taken from the DEFAULTSOURCE FONT. E.g. if the defaultsource font is GACHA 10 then the pair (94 TERMINAL) is interpreted as (TERMINAL 10).") + (* ;; "DCODE and DESTFONT provided so that we can avoid vacuous translations") + (LET (SCODE CHAR8CODE SFONT CSINFO TEMP) (if (LISTP SOURCE) then (SETQ SFONT (CADR SOURCE)) @@ -1729,34 +1739,36 @@ else (SETQ SFONT DEFAULTSOURCEFONT))) (CL:UNLESS (CHARCODEP SCODE) (SETQ SCODE (CHARCODE.DECODE SCODE))) - (CL:WHEN (AND SCODE (SLUGCHARP.DISPLAY SCODE SFONT)) - (SETQ SCODE NIL)) - (if SCODE - then (SETQ CSINFO (\INSURECHARSETINFO SFONT (\CHARSET SCODE))) - (SETQ CHAR8CODE (\CHAR8CODE SCODE)) - else - (* ;; "NIL SCODE means replace with slug. We calculate the source-slug information, but that should be ignored later in favor of the slug information from the destination's character set. ") + (CL:UNLESS (AND (EQ DCODE SCODE) + (EQ SFONT DESTFONT)) (* ; "Nothing to do") + (CL:WHEN (AND SCODE (SLUGCHARP SCODE SFONT)) + (SETQ SCODE NIL)) + (if SCODE + then (SETQ CSINFO (\INSURECHARSETINFO SFONT (\CHARSET SCODE))) + (SETQ CHAR8CODE (\CHAR8CODE SCODE)) + else + (* ;; "NIL SCODE means replace with slug. We calculate the source-slug information, but that should be ignored later in favor of the slug information from the destination's character set. ") - (SETQ CSINFO (\INSURECHARSETINFO SFONT 0)) - (SETQ CHAR8CODE SLUGCHARINDEX)) + (SETQ CSINFO (\INSURECHARSETINFO SFONT 0)) + (SETQ CHAR8CODE SLUGCHARINDEX)) - (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT. Don't know if the CHAR8CODE is useful, but...") + (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT. Don't know if the CHAR8CODE is useful, but...") - `((CHAR8CODE \, CHAR8CODE) - (ASCENT \, (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (DESCENT \, (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (WIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO WIDTHS) of CSINFO)) - (\FGETWIDTH TEMP CHAR8CODE))) - (YWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO YWIDTHS) of CSINFO)) - (\FGETWIDTH TEMP CHAR8CODE))) - (IMAGEWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + `((CHAR8CODE \, CHAR8CODE) + (ASCENT \, (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) + (DESCENT \, (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) + (WIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO WIDTHS) of CSINFO)) + (\FGETWIDTH TEMP CHAR8CODE))) + (YWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO YWIDTHS) of CSINFO)) (\FGETWIDTH TEMP CHAR8CODE))) - (LEFTKERN \, (CL:WHEN (ARRAYP (fetch (CHARSETINFO LEFTKERN) of CSINFO)) - (ELT (fetch (CHARSETINFO LEFTKERN) of CSINFO) - CHAR8CODE))) - (BITMAP \, (CL:WHEN (SETQ TEMP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (\GETCHARBITMAP.CSINFO CHAR8CODE CSINFO))) - (SLUG \, (NOT SCODE]) + (IMAGEWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + (\FGETWIDTH TEMP CHAR8CODE))) + (LEFTKERN \, (CL:WHEN (ARRAYP (fetch (CHARSETINFO LEFTKERN) of CSINFO)) + (ELT (fetch (CHARSETINFO LEFTKERN) of CSINFO) + CHAR8CODE))) + (BITMAP \, (CL:WHEN (SETQ TEMP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) + (\GETCHARBITMAP.CSINFO CHAR8CODE CSINFO))) + (SLUG \, (NOT SCODE))))]) (\MAKESLUGCHAR [LAMBDA (CODE FONT/CSINFO) (* ; "Edited 30-Aug-2025 23:20 by rmk") @@ -1800,7 +1812,7 @@ SLUGCHARINDEX)))) CSINFO]) -(SLUGCHARP.DISPLAY +(SLUGCHARP [LAMBDA (CODE FONT/CHARSETINFO) (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 28-Aug-2025 22:56 by rmk") (* ; "Edited 6-Jun-2025 10:24 by rmk") @@ -1818,6 +1830,23 @@ (\FGETOFFSET (fetch (CHARSETINFO OFFSETS) of CSINFO) (ADD1 \MAXTHINCHAR]) ) +(DECLARE%: DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQ SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) + + +(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))) +) + +(* "END EXPORTED DEFINITIONS") + +) + + + +(* ; "At the end of each csinfo") + (DECLARE%: EVAL@COMPILE (PUTPROPS UPDATEINFOELEMENT MACRO [(FIELD) @@ -2212,7 +2241,8 @@ (SHOULDNT]) (\COERCECHARSET - [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 17-Dec-2025 21:51 by rmk") + [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 15-Mar-2026 14:23 by rmk") + (* ; "Edited 17-Dec-2025 21:51 by rmk") (* ; "Edited 7-Oct-2025 17:25 by rmk") (* ; "Edited 31-Aug-2025 00:00 by rmk") (* ; "Edited 28-Aug-2025 23:07 by rmk") @@ -2243,8 +2273,7 @@ (SETQ CFONT (FONTCREATE1 CFS CHARSET)) - when (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)) unless (AND CODE (SLUGCHARP.DISPLAY - CODE CFONT)) + when (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)) unless (AND CODE (SLUGCHARP CODE CFONT)) do (CL:WHEN FONT (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR FONTCHARENCODING) @@ -2254,7 +2283,8 @@ (RETURN (LIST CFONT CSINFO]) (\BUILDSLUGCSINFO - [LAMBDA (FONT SLUGWIDTH) (* ; "Edited 17-Aug-2025 12:46 by rmk") + [LAMBDA (FONT SLUGWIDTH) (* ; "Edited 15-Mar-2026 23:39 by rmk") + (* ; "Edited 17-Aug-2025 12:46 by rmk") (* ; "Edited 10-Aug-2025 12:43 by rmk") (* ; "Edited 6-Aug-2025 22:42 by rmk") (* ; "Edited 3-Aug-2025 16:11 by rmk") @@ -2291,8 +2321,7 @@ (SETQ CSINFO (create CHARSETINFO CHARSETASCENT ← (IDIFFERENCE SLUGHEIGHT DESCENT) CHARSETDESCENT ← DESCENT - CSSLUGP ← T - CSCOMPLETEP ← T)) + CSSLUGP ← T)) (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) (for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I SLUGWIDTH)) (replace IMAGEWIDTHS OF CSINFO with WIDTHS) @@ -2678,7 +2707,10 @@ then FILEFONTS)))]) (FONTEXISTS? - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 22-Jan-2026 09:07 by rmk") + [LAMBDA (FONTSPEC NOCOERCIONS) (* ; "Edited 4-Apr-2026 12:27 by rmk") + (* ; "Edited 2-Apr-2026 23:52 by rmk") + (* ; "Edited 17-Mar-2026 23:04 by rmk") + (* ; "Edited 22-Jan-2026 09:07 by rmk") (* ; "Edited 18-Dec-2025 13:10 by rmk") (* ; "Edited 25-Nov-2025 20:18 by rmk") (* ; "Edited 26-Sep-2025 10:10 by rmk") @@ -2689,14 +2721,14 @@ (* ; "Edited 9-Aug-2025 00:08 by rmk") (* ; "Edited 5-Aug-2025 17:54 by rmk") - (* ;; "Do we have any way of finding or creating the font, even by coercion from other fonts? The DEVICE can have a FONTEXISTS? function for the case where we can't find a file--presumably returns the file for a coercion to a different font specification.") + (* ;; "Do we have any way of finding or creating the font, even by coercion from other fonts? The IMAGESTREAM DEVICE can have a FONTEXISTS? function for the case where we can't find a file--presumably returns the file for a coercion to a different font specification.") (* ;; - "Tries device specific coercions if the original request can't be satisfied and NOCOERCIONS is NIL.") + "Tries device-specific coercions if the original request can't be satisfied and NOCOERCIONS is NIL.") (DECLARE (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE IMAGESTREAMTYPES)) - (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) - VAL DEVICE) + (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + (LET (VAL DEVICE COERCED) (* ;; "SASSOC everywhere because of face") @@ -2705,30 +2737,30 @@ then (CL:UNLESS (EQ VAL 'NO) VAL) else (* ; - "Only 0 really exists. Cache just the first file") + "Only 0 really exists--but is that true only for the display? Cache just the first file") (SETQ DEVICE (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) - (SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) of FONTSPEC) + [SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) of FONTSPEC) '(90 270)) (create FONTSPEC using FONTSPEC FSROTATION ← 0) FONTSPEC))) (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTEXISTS?)) (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTSAVAILABLE)) (FUNCTION NILL)) - FONTSPEC))) - (if VAL - then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) - elseif [AND (NOT NOCOERCIONS) - (SETQ VAL (COERCEFONTSPEC FONTSPEC (FONTDEVICEPROP DEVICE - 'FONTCOERCIONS] - then - (* ;; "It's coerceable...even though coercion may not yet be instantiated") + FONTSPEC NOCOERCIONS) + (AND (NOT NOCOERCIONS) + (SETQ COERCED (CAR (OR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS) + (COERCEFONTSPEC FONTSPEC 'FACECOERCIONS] - (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) - else (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO 'SASSOC) - NIL]) + (* ;; "Don't cache NO if the font isn't found and coercion is suppressed. A later coercive call might produce a different result.") + + (CL:WHEN (OR VAL COERCED) + (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC (OR VAL 'NO) + 'SASSOC)) + VAL]) (\SEARCHFONTFILES - [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 14:47 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 4-Mar-2026 00:14 by rmk") + (* ; "Edited 28-Aug-2025 14:47 by rmk") (* ; "Edited 25-Aug-2025 10:23 by rmk") (* ; "Edited 23-Aug-2025 12:36 by rmk") (* ; "Edited 21-Jul-2025 08:57 by rmk") @@ -2762,8 +2794,8 @@ (* ;;  "make sure the face, size, and family really match.") - when (AND (OR (EQ FAMILY '*) - (EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT))) + when (AND THISFONT (OR (EQ FAMILY '*) + (EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT))) (OR (EQ SIZE '*) (EQ SIZE (fetch (FONTSPEC FSSIZE) of THISFONT))) (MATCHFONTFACE FACE (fetch (FONTSPEC FSFACE) of THISFONT))) unless (MEMBER THISFONT @@ -2771,47 +2803,44 @@ do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) (FLUSHFONTCACHE - [LAMBDA (TYPE FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 27-Nov-2025 10:02 by rmk") + [LAMBDA (CACHES FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 4-Apr-2026 23:04 by rmk") + (* ; "Edited 27-Nov-2025 10:02 by rmk") (* ; "Edited 22-Nov-2025 15:52 by rmk") - (* ;; - "Removes information for font(s) from the TYPE cache, if TYPE is NIL, all caches are flushed") + (* ;; "Removes information for font(s) from the caches in CACHES, if CACHES is NIL, all caches are flushed") - (CL:UNLESS TYPE - (SETQ TYPE '(:INCORE :EXISTS :AVAILABLE))) - (if (LISTP TYPE) - then (for TY in TYPE collect (FLUSHFONTCACHE TY FAMILY SIZE FACE ROTATION DEVICE)) - else - (* ;; "If all NILs, don't want the default font") - - (SPREADFONTSPEC (\FONT.CHECKARGS (OR FAMILY '*) - (OR SIZE '*) - (OR FACE '*) - (OR ROTATION '*) - (OR DEVICE '*) - T)) - (LET ((NFLUSHED 0) - FONTX) - (DECLARE (SPECVARS NFLUSHED)) - [MAPMULTI (SELECTQ TYPE - (:INCORE \FONTSINCORE) - (:EXISTS \FONTEXISTS?-CACHE) - (:AVAILABLE \FONTSAVAILABLEFILECACHE) - (\ILLEGAL.ARG TYPE)) - (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD NFLUSHED 1) - (RPLACD DPAIR))] - (LIST TYPE NFLUSHED]) + (for CACHE NFLUSHED inside (OR CACHES '(:INCORE :EXISTS :AVAILABLE)) declare (SPEVARS NFLUSHED) + first (CL:WHEN (type? FONTSPEC FAMILY) + (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T))) + (CL:UNLESS FAMILY + (SETQ FAMILY '*)) + (CL:UNLESS SIZE + (SETQ SIZE '*)) + (CL:UNLESS FACE + (SETQ FACE '*)) + (CL:UNLESS ROTATION + (SETQ ROTATION '*)) + (CL:UNLESS DEVICE + (SETQ DEVICE '*)) eachtime (SETQ NFLUSHED 0) + collect [MAPMULTI (SELECTQ CACHE + (:INCORE \FONTSINCORE) + (:EXISTS \FONTEXISTS?-CACHE) + (:AVAILABLE \FONTSAVAILABLEFILECACHE) + (\ILLEGAL.ARG CACHE)) + (FUNCTION (LAMBDA (FM S FC R DPAIR) + (CL:WHEN (AND (OR (EQ FAMILY FM) + (EQ FAMILY '*)) + (OR (EQ SIZE S) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE (CAR DPAIR)) + (EQ DEVICE '*)) + (CDR DPAIR)) + (ADD NFLUSHED 1) + (RPLACD DPAIR))] + (LIST CACHE NFLUSHED]) (FINDFONTFILES [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:45 by rmk") @@ -2862,10 +2891,11 @@ ) finally (RETURN (DREVERSE FONTSFOUND]) (SORTFONTSPECS - [LAMBDA (FONTSPECS) (* ; "Edited 30-Aug-2025 15:12 by rmk") + [LAMBDA (FONTSPECS) (* ; "Edited 22-Mar-2026 12:44 by rmk") + (* ; "Edited 13-Mar-2026 11:33 by rmk") + (* ; "Edited 30-Aug-2025 15:12 by rmk") - (* ;; - "Sort FONTSPECS by alphabetically by family, then by smaller sizes, then by medium/regular faces") + (* ;; "Sort FONTSPECS by alphabetically by family, then by smaller sizes, then by faces. For faces the order is MRR MIR BRR BIR and any others, so that coercions from earlier fonts are possible.") (SORT FONTSPECS @@ -2878,8 +2908,10 @@ (fetch (FONTSPEC FSSIZE) of FS2)) (CL:WHEN (EQ (fetch (FONTSPEC FSSIZE) of FS1) (fetch (FONTSPEC FSSIZE) of FS2)) - [LET ((FACE1 (fetch (FONTSPEC FSFACE) of FS1)) - (FACE2 (fetch (FONTSPEC FSFACE) of FS2))) + [LET [(FACE1 (\FONTFACE (fetch (FONTSPEC FSFACE) + of FS1))) + (FACE2 (\FONTFACE (fetch (FONTSPEC FSFACE) + of FS2] (OR (EQUAL FACE1 FACE2) (AND (EQ 'MEDIUM (fetch (FONTFACE WEIGHT) of FACE1)) @@ -2897,21 +2929,24 @@ (DEFINEQ (MATCHFONTFACE - [LAMBDA (PATTERN FACE) (* ; "Edited 21-Jun-2025 11:57 by rmk") + [LAMBDA (PATTERN FACE) (* ; "Edited 18-Mar-2026 13:39 by rmk") + (* ; "Edited 21-Jun-2025 11:57 by rmk") (* ;; "Does FACE match a PATTERN that may contain stars?") - (OR (EQ PATTERN '*) - (EQUAL PATTERN FACE) - (LET ((PWEIGHT (fetch (FONTFACE WEIGHT) of PATTERN)) - (PSLOPE (fetch (FONTFACE SLOPE) of PATTERN)) - (PEXPANSION (fetch (FONTFACE EXPANSION) of PATTERN))) - (AND (OR (EQ PWEIGHT (fetch (FONTFACE WEIGHT) of FACE)) - (EQ PWEIGHT '*)) - (OR (EQ PSLOPE (fetch (FONTFACE SLOPE) of FACE)) - (EQ PSLOPE '*)) - (OR (EQ PEXPANSION (fetch (FONTFACE EXPANSION) of FACE)) - (EQ PEXPANSION '*]) + (if (EQ PATTERN '*) + elseif (EQUAL PATTERN FACE) + else (CL:WHEN (AND PATTERN (LITATOM PATTERN)) + (SETQ PATTERN (\FONTFACE PATTERN))) + (LET ((PWEIGHT (fetch (FONTFACE WEIGHT) of PATTERN)) + (PSLOPE (fetch (FONTFACE SLOPE) of PATTERN)) + (PEXPANSION (fetch (FONTFACE EXPANSION) of PATTERN))) + (AND (OR (EQ PWEIGHT (fetch (FONTFACE WEIGHT) of FACE)) + (EQ PWEIGHT '*)) + (OR (EQ PSLOPE (fetch (FONTFACE SLOPE) of FACE)) + (EQ PSLOPE '*)) + (OR (EQ PEXPANSION (fetch (FONTFACE EXPANSION) of FACE)) + (EQ PEXPANSION '*]) (MAKEFONTFACE [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 7-Nov-2025 08:50 by rmk") @@ -2971,6 +3006,27 @@ then FACE elseif (NOT NOERROR) then (\ILLEGAL.ARG FACE]) + +(FONTFACE.STARS + [LAMBDA (FACE) (* ; "Edited 19-Mar-2026 23:31 by rmk") + + (* ;; "Produces a list of font faces formed by expanding eacy of the starred components of FACE") + + (CL:WHEN (EQ FACE '*) + (SETQ FACE (create FONTFACE + WEIGHT ← '* + SLOPE ← '* + EXPANSION ← '*))) + (for W VAL inside (CL:IF (EQ '* (fetch (FONTFACE WEIGHT) of FACE)) + '(BOLD MEDIUM) + (fetch (FONTFACE WEIGHT) of FACE)) + do [for S inside (CL:IF (EQ '* (fetch (FONTFACE SLOPE) of FACE)) + '(ITALIC REGULAR) + (fetch (FONTFACE SLOPE) of FACE)) + do (for E inside (CL:IF (EQ '* (fetch (FONTFACE EXPANSION) of FACE)) + '(COMPRESSED REGULAR) + (fetch (FONTFACE EXPANSION) of FACE)) + do (push VAL (MAKEFONTFACE W S E] finally (RETURN VAL]) ) (RPAQ? \FONTSINCORE NIL) @@ -3019,6 +3075,8 @@ (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTCOMPLETEP FLAG) + (FONTCOERCEDP FLAG) (* ; + "Indirects to another font via FONTCOERCIONS") (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -3027,8 +3085,8 @@ (\SFHeight WORD) (ROTATION WORD) (FONTSLUGWIDTH WORD) (* ; "Was FBBOX. The width of the slug character in the font, used by the generic \BUILDSLUGCSINFO to create the slug charsetinfo") - (NIL SIGNEDWORD) (* ; - "Was FBBOY. Can be removed if all references are recompiled.") + (MAXCHARSET WORD) (* ; + "Maximum number of charsets, usually \MAXCHARSET but maybe more for Unicode fonts.") (NIL SIGNEDWORD) (* ; "Was FBBDX") (NIL SIGNEDWORD) (* ; "Was FBBDY") (FONTTOMCCSFN POINTER) (* ; "Was \SFLKerns. Function that translates codes in the font's pre-MCCS encoding into MCCS (e.g. Hippo A to Greek,Alpha) ") @@ -3042,11 +3100,11 @@ (FONTAVGCHARWIDTH WORD) (* ;  "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTCHARENCODING POINTER) (* ; "Was FONTIMAGEWIDTHS: This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.") - (FONTCHARSETVECTOR POINTER) (* ; "A 257-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset. The last cell if not NIL is the %"slug%" charsetinfo that can be shared as the dummy entry for otherwise NIL charsets") + (FONTCHARSETVECTOR POINTER) (* ; "A MAXCHARSET+1-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset. The last cell if not NIL is the %"slug%" charsetinfo that can be shared as the dummy entry for otherwise NIL charsets") (FONTHASLEFTKERNS FLAG) (* ;  "T if at least one character set has an entry for left kerns") (FONTEXTRAFIELD2 POINTER)) - FONTCHARSETVECTOR ← (\CREATEFONTCHARSETVECTOR) + MAXCHARSET ← \MAXCHARSET FONTCHARSETVECTOR ← (\CREATEFONTCHARSETVECTOR) (INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT)))) (RECORD FONTFACE (WEIGHT SLOPE EXPANSION) @@ -3095,7 +3153,14 @@ CHARSETNO ← MAX.SMALLP) (RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE) - (TYPE? LISTP)) + (RECORD FSFACE (FSWEIGHT FSSLOPE FSEXPANSION)) + FSROTATION ← 0 [TYPE? (AND (LISTP DATUM) + (AND (fetch (FONTSPEC FSFAMILY) of DATUM) + (LITATOM (fetch (FONTSPEC FSFAMILY) of DATUM))) + (OR (AND (SMALLP (fetch (FONTSPEC FSSIZE) of DATUM)) + (IGEQ (fetch (FONTSPEC FSSIZE) of DATUM) + 1)) + (EQ '* (fetch (FONTSPEC FSSIZE) of DATUM]) ) (/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER) @@ -3110,11 +3175,12 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) (FONTDESCRIPTOR 0 (FLAGBITS . 0)) + (FONTDESCRIPTOR 0 (FLAGBITS . 16)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -3123,7 +3189,7 @@ (FONTDESCRIPTOR 10 (BITS . 15)) (FONTDESCRIPTOR 11 (BITS . 15)) (FONTDESCRIPTOR 12 (BITS . 15)) - (FONTDESCRIPTOR 13 (SIGNEDBITS . 15)) + (FONTDESCRIPTOR 13 (BITS . 15)) (FONTDESCRIPTOR 14 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 15 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 16 POINTER) @@ -3197,22 +3263,31 @@ (PUTPROPS \FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\PUTBASE WIDTHSBLOCK INDEX WIDTH))) + +(PUTPROPS MAXCHARSET MACRO ((FONT) + + (* ;; "0 test until all old files are gone") + + (LET ((MAX (fetch (FONTDESCRIPTOR MAXCHARSET) of FONT))) + (CL:IF (EQ MAX 0) + \MAXCHARSET + MAX)))) ) (DECLARE%: EVAL@COMPILE -(PUTPROPS \GETCHARSETINFO MACRO ((FONTDESC CHARSET) +(PUTPROPS \GETCHARSETINFO MACRO (OPENLAMBDA (FONTDESC CHARSET) - (* ;; + (* ;;  "Temporary until other callers of \GETCHARSETINFO are changes to \INSURECHARSETINFO") - (* ;; + (* ;;  "Fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. ") - (* ;; + (* ;;  "NOTE Current \GETCHARSETINFO takes the vector, not the font, as does current \SETCHARSETINFO") - (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC) - (UNFOLD CHARSET 2)))) + (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC) + (UNFOLD CHARSET 2)))) (PUTPROPS \SETCHARSETINFO MACRO ((FONTDESC CHARSET CSINFO) (\RPLPTR (fetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONTDESC) @@ -3223,19 +3298,23 @@ (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates and installs the required charset, maybe a slug (with CSSLUGP T).") - (OR (\GETCHARSETINFO FONTDESC CHARSET) - (\SETCHARSETINFO FONTDESC CHARSET (\CREATECHARSET CHARSET - FONTDESC]) + (CL:IF (IGREATERP CHARSET (MAXCHARSET FONTDESC)) + (SLUGCSINFO FONTDESC) + (OR (\GETCHARSETINFO FONTDESC CHARSET) + (\SETCHARSETINFO FONTDESC CHARSET (\CREATECHARSET + CHARSET + FONTDESC))))]) (PUTPROPS \CREATECSINFOELEMENT MACRO (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3) WORDSPERCELL)))) -(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (NIL +(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (OPENLAMBDA (FONT) - (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo") + (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo") - (\ALLOCBLOCK (IPLUS 2 \MAXCHARSET) - T))) + (\ALLOCBLOCK (IPLUS 2 (OR (AND FONT (MAXCHARSET FONT)) + \MAXCHARSET)) + T))) (PUTPROPS CHARSETPROP MACRO [ARGS (if (CDDR ARGS) then `(PUTMULTI (fetch (CHARSETINFO CSINFOPROPS) @@ -3245,19 +3324,14 @@ else `(GETMULTI (fetch (CHARSETINFO CSINFOPROPS) of ,(CAR ARGS)) ,(CADR ARGS]) + +(PUTPROPS SLUGCSINFO MACRO [(FONT) + (OR (\GETCHARSETINFO FONT (ADD1 (MAXCHARSET FONT))) + (\SETCHARSETINFO FONT (ADD1 (MAXCHARSET FONT)) + (\BUILDSLUGCSINFO FONT]) ) (PUTPROPS CHARSETPROP ARGNAMES (CSINFO PROP NEWVALUE)) -(DECLARE%: EVAL@COMPILE - -(RPAQ SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - -(RPAQ SLUGCHARSET (ADD1 \MAXCHARSET)) - - -(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET))) -) (* "END EXPORTED DEFINITIONS") @@ -3270,8 +3344,12 @@ (LET [(SOURCE (CL:UNLESS (fetch (CHARSETINFO CSSLUGP) of CSINFO) (CHARSETPROP CSINFO 'SOURCE))] - (CL:WHEN SOURCE - [NOT (EQUAL SOURCE (FONTPROP FONT 'DEVICESPEC])]) + (CL:WHEN [AND SOURCE (NOT (EQUAL SOURCE (FONTPROP FONT + 'DEVICESPEC] + (create FONTSPEC using SOURCE FSFACE ← + (FONTFACETOATOM (fetch (FONTSPEC + FSFACE) + of SOURCE))))]) ) ) (DEFINEQ @@ -3333,11 +3411,12 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) (FONTDESCRIPTOR 0 (FLAGBITS . 0)) + (FONTDESCRIPTOR 0 (FLAGBITS . 16)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -3346,7 +3425,7 @@ (FONTDESCRIPTOR 10 (BITS . 15)) (FONTDESCRIPTOR 11 (BITS . 15)) (FONTDESCRIPTOR 12 (BITS . 15)) - (FONTDESCRIPTOR 13 (SIGNEDBITS . 15)) + (FONTDESCRIPTOR 13 (BITS . 15)) (FONTDESCRIPTOR 14 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 15 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 16 POINTER) @@ -3386,6 +3465,7 @@ (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTCOMPLETEP FLAG) + (FONTCOERCEDP FLAG) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -3394,7 +3474,7 @@ (\SFHeight WORD) (ROTATION WORD) (FONTSLUGWIDTH WORD) - (NIL SIGNEDWORD) + (MAXCHARSET WORD) (NIL SIGNEDWORD) (NIL SIGNEDWORD) (FONTTOMCCSFN POINTER) @@ -3462,100 +3542,83 @@ (DEFINEQ (\CREATEFONT - [LAMBDA (FONTSPEC) (* ; "Edited 26-Jan-2026 15:24 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 4-Apr-2026 23:29 by rmk") + (* ; "Edited 2-Apr-2026 23:01 by rmk") + (* ; "Edited 31-Mar-2026 22:55 by rmk") + (* ; "Edited 18-Mar-2026 22:44 by rmk") + (* ; "Edited 26-Jan-2026 15:24 by rmk") (* ; "Edited 25-Dec-2025 10:58 by rmk") (* ; "Edited 25-Sep-2025 21:24 by rmk") (* ; "Edited 28-Aug-2025 14:30 by rmk") - (* ; "Edited 18-Aug-2025 00:17 by rmk") - (* ; "Edited 16-Aug-2025 20:52 by rmk") - (* ; "Edited 12-Aug-2025 23:36 by rmk") (* ; "Edited 24-Jul-2025 19:51 by rmk") (* ; "Edited 20-May-2025 21:10 by rmk") - (* ;; "Generic font creation. Uses fontcreate method from device to build the font fontdescriptor but doesn't call SETFONTDESCRIPTOR to install it and doesn't instantiate a charset. That's deferred to FONTCREATE1. ") + (* ;; "Generic font creation. Uses fontcreate method from device to build the font fontdescriptor with font-level properties but doesn't call SETFONTDESCRIPTOR to install it and doesn't instantiate a charset. That's deferred to \CREATECHARSET. ") (* ;; "") - (LET ([FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) - 'FONTCREATE] - FONT) - [if FN - then (SETQ FONT (if (EQ (NARGS FN) - 1) - then (APPLY* FN FONTSPEC) - else (* ; "Old form: spreading FONTSPEC") - (APPLY FN FONTSPEC))) - (CL:UNLESS FONT - (CL:WHEN (SETQ FONTSPEC (COERCEFONTSPEC FONTSPEC)) - (SETQ FONT (if (EQ (NARGS FN) - 1) - then (APPLY* FN FONTSPEC) - else (APPLY FN FONTSPEC))))) - else (SETQ FONT (create FONTDESCRIPTOR - FONTFAMILY ← (fetch (FONTSPEC FSFAMILY) of FONTSPEC) - FONTSIZE ← (fetch (FONTSPEC FSSIZE) of FONTSPEC) - FONTFACE ← (fetch (FONTSPEC FSFACE) of FONTSPEC) - ROTATION ← (fetch (FONTSPEC FSROTATION) of FONTSPEC) - FONTDEVICE ← (fetch (FONTSPEC FSDEVICE) of FONTSPEC) - \SFAscent ← 0 - \SFDescent ← 0 - \SFHeight ← 0 - FONTDEVICESPEC ← (create FONTSPEC using FONTSPEC] - FONT]) + (LET (FN COERCIONSPEC FONT) + (if (FONTEXISTS? FONTSPEC T) + then [SETQ FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + 'FONTCREATE] + (if FN + then (APPLY* FN FONTSPEC) + elseif (MEDLEYFONT.READ.FONT FONTSPEC NIL T) + else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC)) + elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS] + then + (* ;; "(Re)load the target font, change its spec labeling. Maybe the DEVICESPEC should also change, in case this is dumped? But \CREATECHARSET needs to know the device name so it doesn't keep coercing.") + + (SETQ FONT (\CREATEFONT COERCIONSPEC)) + (replace (FONTDESCRIPTOR FONTCOERCEDP) of FONT with T) + (replace (FONTDESCRIPTOR FONTFAMILY) of FONT with (fetch (FONTSPEC FSFAMILY) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTSIZE) of FONT with (fetch (FONTSPEC FSSIZE) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTFACE) of FONT with (fetch (FONTSPEC FSFACE) + of FONTSPEC)) + (replace (FONTDESCRIPTOR ROTATION) of FONT with (fetch (FONTSPEC FSROTATION) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTDEVICESPEC) of FONT with COERCIONSPEC) + FONT + elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FACECOERCIONS] + then (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC (MAXCHARSET (\CREATEFONT COERCIONSPEC]) (\CREATECHARSET - [LAMBDA (CHARSET FONT) (* ; "Edited 14-Feb-2026 13:12 by rmk") + [LAMBDA (CHARSET FONT GETCHARSETFN) (* ; "Edited 4-Apr-2026 14:39 by rmk") + (* ; "Edited 31-Mar-2026 17:44 by rmk") + (* ; "Edited 29-Mar-2026 10:33 by rmk") + (* ; "Edited 27-Mar-2026 07:52 by rmk") + (* ; "Edited 18-Mar-2026 23:11 by rmk") + (* ; "Edited 16-Mar-2026 12:35 by rmk") + (* ; "Edited 13-Mar-2026 10:06 by rmk") + (* ; "Edited 14-Feb-2026 13:12 by rmk") (* ; "Edited 25-Sep-2025 21:24 by rmk") (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 14:31 by rmk") - (* ; "Edited 27-Aug-2025 12:55 by rmk") - (* ; "Edited 25-Aug-2025 22:51 by rmk") - (* ; "Edited 16-Aug-2025 21:06 by rmk") - (* ; "Edited 12-Aug-2025 23:36 by rmk") - (* ; "Edited 5-Aug-2025 22:29 by rmk") - (* ; "Edited 3-Aug-2025 17:41 by rmk") - (* ; "Edited 29-Jul-2025 12:10 by rmk") - (* ; "Edited 22-Jul-2025 22:48 by rmk") (* ; "Edited 9-Jul-2025 11:12 by rmk") - (* ; "Edited 15-Jun-2025 14:50 by rmk") - (* ; "Edited 13-Jun-2025 20:00 by rmk") - (* ; "Edited 10-Jun-2025 13:55 by rmk") - (* ; "Edited 7-Jun-2025 15:10 by rmk") (* ; "Edited 18-May-2025 21:40 by rmk") - (* ; "Edited 16-May-2025 21:37 by rmk") (* ; "Edited 12-Jul-2022 14:37 by rmk") (* ; "Edited 8-May-93 23:42 by rmk:") (* ; "Edited 4-Dec-92 11:43 by jds") - (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in fonts FONTCHARSETVECTOR") + (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in FONT's FONTCHARSETVECTOR") - (CL:UNLESS (<= 0 CHARSET \MAXCHARSET) - (\ILLEGAL.ARG CHARSET)) - (LET [(CSINFO (if (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) - then (\GETCHARSETINFO FONT CHARSET) - else (APPLY* [OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR - FONTDEVICE) - of FONT) - 'CREATECHARSET)) - (FUNCTION (LAMBDA (FONTSPEC FONT CHARSET) - (* ; - "No function: read or read-coerced-font") - (OR (\READCHARSET FONTSPEC CHARSET FONT) - (\READCHARSET (COERCEFONTSPEC FONTSPEC) - CHARSET FONT] - (create FONTSPEC using (FONTPROP FONT 'DEVICESPEC)) - FONT CHARSET] - - (* ;; "Create a descriptor of info for that charset. If we got one, the subfunction may have ignored NOSLUG?. But if not, we store it in the vector so that we don't search later. ") - - (if (AND CSINFO (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - then (\INSTALLCHARSETINFO FONT CSINFO CHARSET) - elseif (SETQ CSINFO (\GETCHARSETINFO FONT SLUGCHARSET)) - else (SETQ CSINFO (\BUILDSLUGCSINFO FONT)) - (\SETCHARSETINFO FONT SLUGCHARSET CSINFO) - (\SETCHARSETINFO FONT CHARSET CSINFO)) - CSINFO]) + (OR (\GETCHARSETINFO FONT CHARSET) + (LET ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) + CSINFO) (* ; + "Use DEVICESPEC in case it was coerced") + (SETQ CSINFO (if [OR GETCHARSETFN (SETQ GETCHARSETFN (CAR (GETMULTI IMAGESTREAMTYPES + (fetch (FONTDESCRIPTOR + FONTDEVICE) + of FONT) + 'CREATECHARSET] + then (APPLY* GETCHARSETFN FONTSPEC FONT CHARSET) + else (\READCHARSET FONTSPEC CHARSET FONT))) + (CL:WHEN CSINFO (* ; + "CSINFO could be a slug, an instantiated charset, or NIL meaning uninstantiated") + (\INSTALLCHARSETINFO FONT CSINFO CHARSET))]) (\INSTALLCHARSETINFO [LAMBDA (FONT CSINFO CHARSET) (* ; "Edited 31-Aug-2025 14:36 by rmk") @@ -3652,12 +3715,6 @@ ) (\CHAR8CODE CHARCODE)))) ) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(LOCALVARS . T) -) - -(PUTPROPS FONT FILETYPE :FAKE-COMPILE-FILE) @@ -3676,7 +3733,9 @@ (DEFINEQ (\CREATEDISPLAYFONT - [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 16:00 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 29-Mar-2026 10:23 by rmk") + (* ; "Edited 16-Mar-2026 12:39 by rmk") + (* ; "Edited 28-Aug-2025 16:00 by rmk") (* ; "Edited 18-Aug-2025 11:32 by rmk") (* ; "Edited 16-Aug-2025 18:46 by rmk") (* ; "Edited 10-Aug-2025 13:24 by rmk") @@ -3687,93 +3746,56 @@ (* ; "Edited 22-May-2025 09:52 by rmk") (* ; "gbn: 25-Jan-86 18:02") - (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists in at least some character sets, d FONTCREATED1 tells us that the font descriptor is not yet availabe.") + (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists in at least some character sets.") - (create FONTDESCRIPTOR - FONTFAMILY ← (fetch (FONTSPEC FSFAMILY) of FONTSPEC) - FONTSIZE ← (fetch (FONTSPEC FSSIZE) of FONTSPEC) - FONTFACE ← (fetch (FONTSPEC FSFACE) of FONTSPEC) - ROTATION ← (fetch (FONTSPEC FSROTATION) of FONTSPEC) - FONTDEVICE ← (fetch (FONTSPEC FSDEVICE) of FONTSPEC) - \SFAscent ← 0 - \SFDescent ← 0 - \SFHeight ← 0 - FONTDEVICESPEC ← (create FONTSPEC using FONTSPEC]) + (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC]) (\CREATECHARSET.DISPLAY - [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 7-Oct-2025 17:05 by rmk") - (* ; "Edited 2-Sep-2025 23:42 by rmk") - (* ; "Edited 30-Aug-2025 19:42 by rmk") - (* ; "Edited 28-Aug-2025 23:08 by rmk") - (* ; "Edited 26-Aug-2025 23:29 by rmk") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 10:02 by rmk") + (* ; "Edited 1-Apr-2026 10:32 by rmk") + (* ; "Edited 29-Mar-2026 10:30 by rmk") + (* ; "Edited 17-Mar-2026 16:11 by rmk") + (* ; "Edited 14-Mar-2026 12:26 by rmk") + (* ; "Edited 7-Oct-2025 17:05 by rmk") (* ; "Edited 18-Aug-2025 09:12 by rmk") (* ; "Edited 31-Jul-2025 10:14 by rmk") (* ; "Edited 13-Jul-2025 11:44 by rmk") - (* ; "Edited 20-May-2025 15:00 by rmk") (* ; "Edited 18-May-2025 23:31 by rmk") (* ; "Edited 14-Jan-88 23:42 by FS") - (* ;; "The first case is simple: A DISPLAYFONTCOERCIONS substitution for one font for another. E.g. Use the information derived for HELVETICA 4 to construct the fontdescriptor for Helvetic 3. ") + (* ;; "If the CHARSETINFO can be read from a file, then any appropriate charset or character coercions (complete, rotated, faked) are assumed to have already taken place.") - (* ;; "After that, it uses requested source files and/or DISPLAYCHARCOERCIONS to produce and complete the CHARSETINFO:") - - (* ;; "This first tries to find a source file that exactly matches the characteristics of the requested charset. The charset is %"completed%" by filling in any missing characters from further down the coercion chain. Thus, the missing characters for e.g. TERMINAL 357 will be filled in from MODERN357, and then perhaps CLASSIC357.") - - (* ;; "If an exact match file cannot be found for a requested rotation, the rotation 0 charset is obtained and rotated.") - - (* ;; "If a non-existent Kanji or Chinese charset is requested for a non-MRR face, the MRR charset is used unmodified. We don't try to boldify or italicize Kanji or Chinese.") - - (* ;; "When all coercions have been exhausted and FACE is bold and/or italic, the search process repeats with bold/italice changed to Regular, and algorithmic transformations are applied to the first result, if any.") - - (* ;; "If all else fails, it looks for the next charset in the coercion list, and fills that in with further coercions for missing characters.") + (* ;; "But if it doesn't exist on a file, it may be that face-faking or rotation can be applied to a character set that can be retrieved from an existing complete file.") (* ;; "") - (LET ((ROTATION (fetch (FONTSPEC FSROTATION) of FONTSPEC)) - (FACE (fetch (FONTSPEC FSFACE) of FONTSPEC)) - CSINFO) + (if (\READCHARSET FONTSPEC CHARSET FONT) + else + (* ;; "Successful transformations must set the CSINFO so that it can be returned.") - (* ;; - "If no COERCIONS, skip that first \COERCECHARSET call--easier debugging of the other cases.") + (CL:UNLESS (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC)) + (\SFROTATECSINFO FONTSPEC FONT CHARSET)) + (COMPLETE.CHARSET FONT CHARSET) + (CL:WHEN (FONTDEVICEPROP FONTSPEC 'FACECOERCIONS) (* ; + "Suppresses face-faking in offline COMPLETE phase") + (CL:WHEN (EQ 'BOLD (fetch (FONTSPEC FSWEIGHT) of FONTSPEC)) - (SETQ CSINFO (if (AND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) - (CADR (\COERCECHARSET FONTSPEC CHARSET NIL 'FONTCOERCIONS FONT))) - elseif [SETQ CSINFO (OR (\READCHARSET FONTSPEC CHARSET FONT) - (CADR (\COERCECHARSET FONTSPEC CHARSET NIL - 'CHARCOERCIONS] - then - (* ;; "This completes CSINFO with glyphs for all codes from possibly different sources, even if just asking for a single THINCODE. We never return an incomplete CSINFO.") + (* ;; "Heuristically, an actual glyph from a completed/inherited font with the same face ought to be better than the fake from a more regular version of FONT--the algorithms aren't so good. So here the complete happens first. The problem is that the inherited font may have glyphs from its own faking, in the offline importfont sequence. There is no way to know on the fly whether any individual inherited character was faked or not") - (COMPLETE.CHARSET CSINFO FONTSPEC CHARSET FONT) - elseif (NEQ ROTATION 0) - then (CL:UNLESS (MEMB ROTATION '(90 270)) - (ERROR "Only implemented rotations are 0, 90 and 270." ROTATION - )) - (CL:WHEN (SETQ CSINFO (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC - FSROTATION ← 0) - FONT CHARSET)) - (\SFROTATECSINFO CSINFO ROTATION)) - elseif (OR (KANJICHARSETP CHARSET) - (CHINESECHARSETP CHARSET)) - then (CL:UNLESS (EQUAL FACE '(MEDIUM REGULAR REGULAR)) - (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC FSFACE ← - '(MEDIUM REGULAR REGULAR)) - FONT CHARSET)) - elseif (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) - then (MAKEBOLD.CHARSET FONTSPEC CHARSET FONT) - elseif (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) - then (MAKEITALIC.CHARSET FONTSPEC CHARSET FONT) - elseif (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) - then (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC FSFACE ← - '(MEDIUM REGULAR REGULAR)) - FONT CHARSET))) - CSINFO]) + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MAKEBOLD.CHAR) + (create FONTSPEC using FONTSPEC FSWEIGHT ← 'MEDIUM))) + (CL:WHEN (EQ 'ITALIC (fetch (FONTSPEC FSSLOPE) of FONTSPEC)) + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MAKEITALIC.CHAR) + (create FONTSPEC using FONTSPEC FSSLOPE ← 'REGULAR))) + (CL:WHEN (EQ 'COMPRESSED (fetch (FONTSPEC FSEXPANSION) of FONTSPEC)) + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MOVEFONTCHARS) + (create FONTSPEC using FONTSPEC FSEXPANSION ← 'REGULAR)))) + (\GETCHARSETINFO FONT CHARSET]) (\FONTEXISTS?.DISPLAY - [LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:56 by rmk") + [LAMBDA (FONTSPEC NOCOERCIONS) (* ; "Edited 4-Apr-2026 09:03 by rmk") + (* ; "Edited 18-Mar-2026 11:45 by rmk") + (* ; "Edited 17-Dec-2025 20:56 by rmk") (* ; "Edited 28-Aug-2025 22:12 by rmk") (* ; "Edited 25-Aug-2025 15:04 by rmk") (* ; "Edited 17-Aug-2025 09:56 by rmk") @@ -3784,323 +3806,87 @@ (* ; "Edited 13-Jul-2025 11:45 by rmk") (* ; "Edited 22-Jun-2025 08:53 by rmk") - (* ;; "Order doesn't matter here, only need one to work") + (* ;; "Order doesn't matter here, only need one to work. The CHAR coercions are done generically, if this fails. This considers the face faking to be a form of coercion, suppressed by NOCOERCION.") - (LET ((FACE (fetch (FONTSPEC FSFACE) of FONTSPEC))) - (OR [AND (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ← - (create FONTFACE using FACE WEIGHT ← - 'MEDIUM] - [AND (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ← - (create FONTFACE using FACE SLOPE ← - 'REGULAR] - [AND (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ← - (create FONTFACE using FACE EXPANSION ← - 'REGULAR] - (COERCEFONTSPEC FONTSPEC (APPEND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) - (FONTDEVICEPROP 'DISPLAY 'CHARCOERCIONS]) + (* ;; "BIR is possible if either MIR or BRR is available, doesn't always go to MRR.") + + (CL:UNLESS NOCOERCIONS + (CL:WHEN (FONTDEVICEPROP FONTSPEC 'FACECOERCIONS) + (OR (AND (EQ 'BOLD (fetch (FONTSPEC FSWEIGHT) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSWEIGHT ← 'MEDIUM) + NOCOERCIONS)) + (AND (EQ 'ITALIC (fetch (FONTSPEC FSSLOPE) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSSLOPE ← 'REGULAR) + NOCOERCIONS)) + (AND (EQ 'COMPRESSED (fetch (FONTSPEC FSEXPANSION) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSEXPANSION ← 'REGULAR) + NOCOERCIONS)))))]) ) (DEFINEQ -(STRIKEFONT.FILEP - [LAMBDA (FILE) (* ; "Edited 15-May-2025 17:47 by rmk") - - (* ;; "If high bit of type is on, then must be strike. If 2nd bit is on, must be strike-index, and we punt. We don't care about the 3rd bit") - - (* ;; "first word has high bits (onebit index fixed). Onebit means 'new-style font' , index is 0 for simple strike, 1 for index, and fixed is if all chars have max width. Lisp doesn't care about 'fixed'") - - (RESETLST - (CL:UNLESS (OPENP FILE 'INPUT) - [RESETSAVE (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD)) - `(PROGN (CLOSEF? OLDVALUE]) - (CL:WHEN [MEMB (\WIN FILE) - (CONSTANT (LIST (LLSH 1 15) - (LOGOR (LLSH 1 15) - (LLSH 1 13] - T))]) - -(STRIKEFONT.GETCHARSET - [LAMBDA (STRM) (* ; "Edited 3-Aug-2025 22:27 by rmk") - (* ; "Edited 1-Aug-2025 23:50 by rmk") - (* ; "Edited 14-Jul-2025 19:52 by rmk") - (* ; "Edited 9-Jun-2025 14:22 by rmk") - (* ; "Edited 12-Jul-2022 09:19 by rmk") - (* ; "Edited 4-Dec-92 12:11 by jds") - - (* ;; "STRM has already been determined to be a vanilla strike-format file holding only the desired charset.") - (* ; "returns a charsetinfo") - (RESETLST - (CL:UNLESS (\GETSTREAM STRM 'INPUT T) - [RESETSAVE (SETQ STRM (OPENSTREAM STRM 'INPUT 'OLD)) - `(PROGN (CLOSEF? OLDVALUE]) - (SETFILEPTR STRM 0) - (CL:UNLESS (STRIKEFONT.FILEP STRM) - (ERROR "Not a STRIKE font file" STRM)) - (CL:UNLESS (EQ 2 (GETFILEPTR STRM)) - (SETFILEPTR STRM 2)) - (LET (CSINFO NUMBCODES RW BITMAP OFFSETS FIRSTCHAR LASTCHAR HEIGHT WIDTHS) - (SETQ CSINFO (create CHARSETINFO)) - (SETQ FIRSTCHAR (\WIN STRM)) (* ; "minimum ascii code") - (SETQ LASTCHAR (\WIN STRM)) (* ; "maximum ascii code") - (\WIN STRM) (* ; - "MaxWidth which isn't used by anyone.") - (\WIN STRM) (* ; - "number of words in this StrikeBody") - (replace (CHARSETINFO CHARSETASCENT) of CSINFO with (\WIN STRM)) - (* ; - "ascent in scan lines (=FBBdy+FBBoy)") - (replace (CHARSETINFO CHARSETDESCENT) of CSINFO with (\WIN STRM)) - (* ; "descent in scan-lines (=FBBoy)") - (\WIN STRM) (* ; - "offset in bits (<0 for kerning, else 0, =FBBox)") - (SETQ RW (\WIN STRM)) (* ; "raster width of bitmap") - (* ; "height of bitmap") - - (* ;; "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line.") - - (SETQ HEIGHT (IPLUS (SIGNED (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - 16) - (SIGNED (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO) - 16))) - (SETQ BITMAP (BITMAPCREATE (UNFOLD RW BITSPERWORD) - HEIGHT)) - (\BINS STRM (fetch BITMAPBASE of BITMAP) - 0 - (UNFOLD (ITIMES RW HEIGHT) - BYTESPERWORD)) (* ; "read bits into bitmap") - (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with BITMAP) - (SETQ NUMBCODES (IDIFFERENCE (ADD1 LASTCHAR) - FIRSTCHAR)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - - (* ;; - "Initialize the offsets to 0, all but FIRSTCHAR to be replaced with the slug offset") - - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET OFFSETS I 0)) - (for I from FIRSTCHAR as J from 1 to NUMBCODES do - (* ;; - "J starts at 1 because we know that the offset of J=0 is 0 ?") - - (\FSETOFFSET OFFSETS I (\WIN STRM))) - (for I (SLUGOFFSET ← (\WIN STRM)) from 0 to \MAXTHINCHAR - when (EQ 0 (\FGETOFFSET OFFSETS I)) unless (EQ I FIRSTCHAR) - do (\FSETOFFSET OFFSETS I SLUGOFFSET) finally (\FSETOFFSET OFFSETS SLUGCHARINDEX - SLUGOFFSET) - - (* ;; - "There's one more so that \FONTRESETCHARWIDTHS can get the slug width, otherwise not necessary") - - (\FSETOFFSET OFFSETS (ADD1 SLUGCHARINDEX) - (\WIN STRM))) - - (* ;; "Initialize the widths to 0") - - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETWIDTH WIDTHS I 0)) - (\FONTRESETCHARWIDTHS CSINFO 0 SLUGCHARINDEX) - (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO WIDTHS) - of CSINFO)) - CSINFO))]) - -(WRITESTRIKEFONTFILE - [LAMBDA (FONT CHARSET FILE) (* ; "Edited 30-Aug-2025 23:21 by rmk") - (* ; "Edited 28-Aug-2025 15:09 by rmk") - (* ; "Edited 24-Aug-2025 11:39 by rmk") - (* ; "Edited 3-Aug-2025 22:33 by rmk") - (* ; "Edited 22-May-2025 09:53 by rmk") - (* ; "Edited 1-Feb-2025 12:27 by mth") - (* ; "Edited 12-Jul-2022 14:36 by rmk") - (* kbr%: "21-Oct-85 15:08") - (* ; - "Write strike FILE using info in FONT. ") - (CL:UNLESS (FONTP FONT) - (LISPERROR "ILLEGAL ARG" FONT)) - (CL:UNLESS CHARSET (SETQ CHARSET 0)) - (CL:UNLESS (AND (IGEQ CHARSET 0) - (ILEQ CHARSET \MAXCHARSET)) - (LISPERROR "ILLEGAL ARG" CHARSET)) - (LET (STREAM CSINFO FIRSTCHAR LASTCHAR WIDTHS MAXWIDTH LENGTH RASTERWIDTH SLUGOFFSET OFFSETS) - (SETQ CSINFO (\INSURECHARSETINFO FONT CHARSET)) - (CL:UNLESS CSINFO (ERROR "Couldn't find charset " CHARSET)) - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX)) - - (* ;; "Find the first and last non-slug characters") - - [SETQ FIRSTCHAR (for I from 0 to \MAXTHINCHAR thereis (NEQ SLUGOFFSET (\FGETOFFSET OFFSETS I - ] - [SETQ LASTCHAR (for I from \MAXTHINCHAR to 0 by -1 thereis (NEQ SLUGOFFSET (\FGETOFFSET - OFFSETS I] - [SETQ STREAM (OPENSTREAM FILE 'OUTPUT 'NEW '((TYPE BINARY] - (\WOUT STREAM 32768) (* ; "STRIKE HEADER. ") - (\WOUT STREAM FIRSTCHAR) - (\WOUT STREAM LASTCHAR) - (SETQ MAXWIDTH 0) - [for I from 0 to SLUGCHARINDEX do (SETQ MAXWIDTH (IMAX MAXWIDTH (\FGETWIDTH WIDTHS I] - (\WOUT STREAM MAXWIDTH) (* ; "STRIKE BODY. ") - (* ; "Length. ") - (SETQ RASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of (fetch (CHARSETINFO CHARSETBITMAP) - of CSINFO))) - (SETQ LENGTH (IPLUS 8 (IDIFFERENCE LASTCHAR FIRSTCHAR) - (ITIMES (fetch (FONTDESCRIPTOR \SFHeight) of FONT) - RASTERWIDTH))) - (\WOUT STREAM LENGTH) (* ; - "Ascent, Descent, Xoffset (no longer used) and Rasterwidth. ") - (\WOUT STREAM (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (\WOUT STREAM (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (\WOUT STREAM 0) - (\WOUT STREAM RASTERWIDTH) (* ; "Bitmap. ") - [\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - 0 - (ITIMES 2 RASTERWIDTH (IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO] - (* ; "Offsets. ") - [for I (OFFSET ← 0) from FIRSTCHAR to LASTCHAR first (\WOUT STREAM OFFSET) - (* ; "Offset of the first char") - do (CL:UNLESS (EQ SLUGOFFSET (\FGETOFFSET OFFSETS I)) - (* ; - "The slug isn't really here in the bitmap") - (ADD OFFSET (\FGETWIDTH WIDTHS I))) - (\WOUT STREAM OFFSET) finally (* ; - "Offset for the after-slug, for width") - (\WOUT STREAM (IPLUS OFFSET (\FGETWIDTH WIDTHS - SLUGCHARINDEX] - (CLOSEF STREAM]) - -(STRIKECSINFO - [LAMBDA (CSINFO) (* ; "Edited 27-Apr-89 13:39 by atm") - - (* ;; "Returns a STRIKE type font descriptor (EQ WIDTHS IMAGEWIDTHS), cause we know how to write those guys out (they read quicker but display slower). If (EQ WIDTHS IMAGEWIDTHS), just return original.") - - (PROG (WIDTHS OFFSETS IMWIDTHS OLDBM BMWIDTH BMHEIGHT NEWBM NEWOFFSET NEWWIDTH OLDOFFSET - DUMMYOFFSET NEWOFFSETS) - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (SETQ IMWIDTHS (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) - (if (EQ WIDTHS IMWIDTHS) - then (RETURN CSINFO)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (SETQ OLDBM (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (SETQ DUMMYOFFSET (\FGETOFFSET OFFSETS 256)) - (SETQ BMHEIGHT (BITMAPHEIGHT OLDBM)) - [SETQ BMWIDTH (for I from 0 to \MAXTHINCHAR - sum (if (IEQP DUMMYOFFSET (\FGETOFFSET OFFSETS I)) - then 0 - else (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) - (\FGETWIDTH WIDTHS I] - - (* ;; "") - - (* ;; "Initialize new offsets vector") - - (* ;; "") - - (SETQ NEWOFFSETS (\CREATECSINFOELEMENT)) - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET NEWOFFSETS I 0)) - (\FSETOFFSET NEWOFFSETS (ADD1 \MAXTHINCHAR) - BMWIDTH) - - (* ;; "") - - (* ;; "Adjust bitmap with so width = imagewidth, fill offsets") - - (* ;; "") - - (SETQ NEWBM (BITMAPCREATE BMWIDTH BMHEIGHT 1)) - (SETQ NEWOFFSET 0) - [for I from 0 to 255 do (SETQ OLDOFFSET (\FGETOFFSET OFFSETS I)) - (if (IEQP DUMMYOFFSET OLDOFFSET) - then (\FSETOFFSET NEWOFFSETS I BMWIDTH) - else (\FSETOFFSET NEWOFFSETS I NEWOFFSET) - (SETQ NEWWIDTH (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) - (\FGETWIDTH WIDTHS I))) - (BITBLT OLDBM OLDOFFSET 0 NEWBM NEWOFFSET 0 (\FGETWIDTH - IMWIDTHS I) - BMHEIGHT - 'REPLACE) - (SETQ NEWOFFSET (IPLUS NEWOFFSET NEWWIDTH] - - (* ;; "") - - (* ;; "Make new CSInfo record withs IMAGEWIDTHS, WIDTHS the same") - - (* ;; "") - - (SETQ WIDTHS (COPYALL WIDTHS)) - [for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I (IMAX (\FGETWIDTH WIDTHS I) - (\FGETIMAGEWIDTH IMWIDTHS I] - (RETURN (create CHARSETINFO - WIDTHS ← WIDTHS - OFFSETS ← NEWOFFSETS - IMAGEWIDTHS ← WIDTHS - CHARSETBITMAP ← NEWBM - YWIDTHS ← (fetch (CHARSETINFO YWIDTHS) of CSINFO) - CHARSETASCENT ← (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - CHARSETDESCENT ← (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO]) -) - - - -(* ; "Bitmap faking") - -(DEFINEQ - -(MAKEBOLD.CHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 12:02 by rmk") +(FAKEFACE.CHARSET + [LAMBDA (FONT CHARSET FAKEFN SOURCEFONT) (* ; "Edited 5-Apr-2026 00:25 by rmk") + (* ; "Edited 1-Apr-2026 09:10 by rmk") + (* ; "Edited 31-Mar-2026 00:39 by rmk") + (* ; "Edited 24-Mar-2026 10:26 by rmk") + (* ; "Edited 21-Mar-2026 22:31 by rmk") + (* ; "Edited 15-Mar-2026 14:26 by rmk") + (* ; "Edited 7-Sep-2025 12:02 by rmk") (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 26-Aug-2025 22:35 by rmk") (* ; "Edited 18-Aug-2025 09:08 by rmk") - (* ; "Edited 16-Aug-2025 12:53 by rmk") - (* ; "Edited 21-Jun-2025 09:10 by rmk") + (* ; "Edited 16-Aug-2025 12:53 by rmk") - (* ;; "BOLD is requested in FACE, so we look for an MRR or MIR that we can bold. If we find one, we presume that it is complete for all characters in its face. But there may be other fonts in the coercion chain that have true information about the bold face that we are after. We look for those before we try to adjust the characters in the non-bold CSINFO that we found.") + (* ;; "Caller has determined that slug characters in FONT should be replaced by applying FAKEFN to the corresponding SOURCEFACE characters.") - (LET ([MFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSFACE ← (create FONTFACE - using (fetch (FONTSPEC - FSFACE) - of FONTSPEC) - WEIGHT ← 'MEDIUM] - CSINFO) + (* ;; "This assumes that SOURCEFONT has already been faked up.") - (* ;; "MFONT is the corresponding Medium font.") + (LET [CHANGED FCSINFO SCSINFO INDIRECT (FONTSPEC (FONTPROP FONT 'DEVICESPEC] + (CL:WHEN (type? FONTSPEC SOURCEFONT) + (SETQ SOURCEFONT (FONTCREATE1 SOURCEFONT CHARSET))) + (CL:WHEN (AND (SETQ SCSINFO (\GETCHARSETINFO SOURCEFONT CHARSET)) + (NOT (fetch (CHARSETINFO CSSLUGP) of SCSINFO))) + (if (OR (KANJICHARSETP CHARSET) + (CHINESECHARSETP CHARSET)) + then (SETQ FCSINFO (COPYALL SCSINFO)) (* ; "Copy and set up an indirect") + (CHARSETPROP FCSINFO 'SOURCE (FONTPROP SOURCEFONT 'DEVICESPEC)) + (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) + (SETQ CHANGED T) + elseif (AND [NOT (EQUAL FONTSPEC (SETQ INDIRECT (CHARSETPROP SCSINFO 'SOURCE] + (EQUAL (fetch (FONTSPEC FSFACE) of FONTSPEC) + (fetch (FONTSPEC FSFACE) of INDIRECT)) + (FONTFILES INDIRECT CHARSET)) + then + (* ;; "Indirect: font charset adds nothing new, it can inherit the faking of its charset-source: MODERN MIR for HELVETICA MIR rather than faking from HELVETICA MRR. Smaller file size?") - (CL:WHEN (AND MFONT (SETQ CSINFO (\GETCHARSETINFO MFONT CHARSET)) - (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR - FONTCHARENCODING) - of MFONT)) - (replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (fetch (FONTDESCRIPTOR FONTTOMCCSFN) - of MFONT)) - (SETQ CSINFO (COPYALL CSINFO)) (* ; "CSINFO is now the CS to be bolded") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (for CODE SOURCEFONT (CHARCOERCIONS ← (FONTDEVICEPROP FONT 'CHARCOERCIONS)) - from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - do (if (SLUGCHARP.DISPLAY CODE FONT) - then - (* ;; "The Medium font doesn't have a glyph for THINCODE. Look for a bold glyph for THINCODE lurking somewhere down the chain, copy it up. There may be different sources for different codes. We're starting from FONT and FONTSPEC, still hoping for BOLD.") - - (CL:WHEN (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE))) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) - CODE FONT)) - else - (* ;; "There is Medium glyph, bold it") - - (MAKEBOLD.CHAR CODE FONT))) - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T) - CSINFO)]) + (SETQ FCSINFO (COPYALL (MEDLEYFONT.GETCHARSET INDIRECT CHARSET))) + (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) + (SETQ CHANGED FCSINFO) + else (SETQ FCSINFO (OR (\GETCHARSETINFO FONT CHARSET) + (\INSTALLCHARSETINFO FONT (SLUGCSINFO FONT) + CHARSET))) + (for CODE from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) + when (SLUGCHARP CODE FONT) unless (SLUGCHARP CODE SOURCEFONT) + do (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) + CODE FONT) + (APPLY* FAKEFN CODE FONT SOURCEFONT) + (SETQ CHANGED FCSINFO)) + (CL:WHEN CHANGED + (CHARSETPROP FCSINFO 'SOURCE FONTSPEC))) + (replace (CHARSETINFO CSCOMPLETEP) of FCSINFO with T) + CHANGED)]) (MAKEBOLD.CHAR - [LAMBDA (CODE FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (CODE FONT) (* ; "Edited 15-Mar-2026 14:32 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 27-Aug-2025 23:55 by rmk") (* ; "Edited 26-Aug-2025 22:36 by rmk") (* ; "Edited 17-Jun-2025 08:22 by rmk") (* ;; "Replaces the bitmap for CODE in FONT with a bolder one: overlaps 2 bits to produce the bold effect. Could be iterated for bigger fonts, but eventually the open spaces would be closed up.") - (CL:UNLESS (SLUGCHARP.DISPLAY CODE FONT) + (CL:UNLESS (SLUGCHARP CODE FONT) (LET* [(THINCODE (\CHAR8CODE CODE)) (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE))) (OLDCHARBITMAP (\GETCHARBITMAP.CSINFO THINCODE CSINFO)) @@ -4118,61 +3904,16 @@ (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 1 0 CWIDTH HEIGHT 'INPUT 'PAINT) (\PUTCHARBITMAP.CSINFO THINCODE CSINFO NEWCHARBITMAP)))]) -(MAKEITALIC.CHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 12:03 by rmk") - (* ; "Edited 2-Sep-2025 22:59 by rmk") - (* ; "Edited 31-Aug-2025 14:36 by rmk") - (* ; "Edited 26-Aug-2025 22:35 by rmk") - (* ; "Edited 18-Aug-2025 09:10 by rmk") - (* ; "Edited 16-Aug-2025 12:53 by rmk") - (* ; "Edited 21-Jun-2025 09:10 by rmk") - - (* ;; "ITALIC is requested, so we look for an MRR or MIR that we can italicize. If we find one, we presume that it is complete for all characters in its face. But there may be other fonts in the coercion chain that have true information about the italic face that we are after. We look for those before we try to adjust the characters in non-italic CSINFO that we found.") - - (LET ([RFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSFACE ← (create FONTFACE - using (fetch (FONTSPEC - FSFACE) - of FONTSPEC) - SLOPE ← 'REGULAR] - CSINFO) - - (* ;; "RFONT is the corresponding Regular font.") - - (CL:WHEN (AND RFONT (SETQ CSINFO (\GETCHARSETINFO RFONT CHARSET)) - (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR - FONTCHARENCODING) - of RFONT)) - (replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (fetch (FONTDESCRIPTOR FONTTOMCCSFN) - of RFONT)) - (SETQ CSINFO (COPYALL CSINFO)) (* ; - "CSINFO is now the CS to be italicized") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (for CODE SOURCEFONT (CHARCOERCIONS ← (FONTDEVICEPROP FONT 'CHARCOERCIONS)) - from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - do (if (SLUGCHARP.DISPLAY CODE FONT) - then - (* ;; "The regular font doesn't have a glyph for THINCODE. Look for an italic glyph for THINCODE lurking somewhere down the chain, copy it up. There may be different sources for different codes.") - - (CL:WHEN (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE))) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) - CODE FONT)) - else - (* ;; "There is a Regular glyph, Italicize it.") - - (MAKEITALIC.CHAR CODE FONT))) - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T) - CSINFO)]) - (MAKEITALIC.CHAR - [LAMBDA (CODE FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (CODE FONT) (* ; "Edited 15-Mar-2026 14:32 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 26-Aug-2025 22:36 by rmk") (* ; "Edited 18-Jun-2025 14:12 by rmk") (* ; "Edited 17-Jun-2025 09:54 by rmk") (* ;; "Replaces the bitmap for CODE in FONT with a slanted one: It shifts rows to the right as a function of their vertical position. ") - (CL:UNLESS (SLUGCHARP.DISPLAY CODE FONT) + (CL:UNLESS (SLUGCHARP CODE FONT) (LET* ((THINCODE (\CHAR8CODE CODE)) (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE))) (OLDBITMAP (\GETCHARBITMAP.CSINFO THINCODE CSINFO)) @@ -4199,111 +3940,46 @@ 'INPUT 'REPLACE))] (\PUTCHARBITMAP.CSINFO THINCODE CSINFO NEWBITMAP)))]) - -(\SFMAKEBOLD - [LAMBDA (CSINFO) (* ; "Edited 28-Aug-2025 15:10 by rmk") - (* ; "Edited 24-Aug-2025 11:41 by rmk") - (* ; "Edited 16-Jun-2025 23:22 by rmk") - (* gbn "25-Jul-85 04:52") - (LET ((OLDCHARBITMAP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (HEIGHT (IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO))) - NEWCHARBITMAP OFFSET SLUGOFFSET SLUGWIDTH) - (SETQ NEWCHARBITMAP (BITMAPCREATE (fetch BITMAPWIDTH of OLDCHARBITMAP) - (fetch BITMAPHEIGHT of OLDCHARBITMAP))) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX)) - (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS SLUGCHARINDEX)) - (for I from 0 to \MAXTHINCHAR unless (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I))) - do (* ; - "overlap two blts to produce bold effect") - (BITBLT OLDCHARBITMAP OFFSET 0 NEWCHARBITMAP OFFSET 0 (\FGETWIDTH WIDTHS I) - HEIGHT - 'INPUT - 'REPLACE) - (BITBLT OLDCHARBITMAP OFFSET 0 NEWCHARBITMAP (ADD1 OFFSET) - 0 - (SUB1 (\FGETWIDTH WIDTHS I)) - HEIGHT - 'INPUT - 'PAINT)) (* ; - "fill in the slug for the magic charcode") - (BITBLT OLDCHARBITMAP SLUGOFFSET 0 NEWCHARBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT - 'REPLACE) - (create CHARSETINFO using CSINFO CHARSETBITMAP ← NEWCHARBITMAP]) - -(\SFMAKEITALIC - [LAMBDA (CSINFO) (* ; "Edited 16-Jun-2025 23:20 by rmk") - (* gbn "18-Sep-85 17:57") - (LET ((WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (ASCENT (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (DESCENT (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (OLDBITMAP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - HEIGHT OFFSET NEWBITMAP WIDTH SLUGOFFSET SLUGWIDTH N M R XN XX YN YX) - (SETQ HEIGHT (IPLUS ASCENT DESCENT)) - (SETQ NEWBITMAP (BITMAPCREATE (fetch BITMAPWIDTH of OLDBITMAP) - (fetch BITMAPHEIGHT of OLDBITMAP))) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS (ADD1 \MAXTHINCHAR))) - (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS (ADD1 \MAXTHINCHAR))) - (SETQ N (IDIFFERENCE 0 (IQUOTIENT (IPLUS DESCENT 3) - 4))) - (SETQ M (IQUOTIENT (IPLUS ASCENT 3) - 4)) - [for I from 0 to \MAXTHINCHAR unless (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I))) - do (SETQ WIDTH (\FGETWIDTH WIDTHS I)) - (for J from N to M do (SETQ R (IPLUS OFFSET WIDTH)) - (SETQ XN (IMIN R (IMAX (IPLUS OFFSET J) - 0))) - (SETQ XX (IMIN R (IMAX (IPLUS R J) - 0))) - [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES J 4] - [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (IPLUS (ITIMES J 4) - 4] - (CL:WHEN (AND (IGREATERP XX XN) - (IGREATERP YX YN)) - (BITBLT OLDBITMAP OFFSET YN NEWBITMAP XN YN (IDIFFERENCE - XX XN) - (IDIFFERENCE YX YN) - 'INPUT - 'REPLACE))] - (BITBLT OLDBITMAP SLUGOFFSET 0 NEWBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT 'REPLACE) - (create CHARSETINFO using CSINFO CHARSETBITMAP ← NEWBITMAP]) ) + + + +(* ; "Bitmap faking") + (DEFINEQ -(\SFMAKEROTATEDFONT - [LAMBDA (FONTDESC ROTATION) (* ; "Edited 30-Mar-87 20:35 by FS") - - (* ;; "takes a fontdecriptor and rotates it.") - - (* ;; "1/5/86 JDS. Masterscope claims nobody calls this. Let's find out....") - - (HELP "ROTATED fonts need to be fixed for NS Chars & New FONTDESCRIPTOR fields") - (* (create FONTDESCRIPTOR using - FONTDESC (SETQ CHARACTERBITMAP - (\SFROTATEFONTCHARACTERS - (fetch (FONTDESCRIPTOR CHARACTERBITMAP) - of FONTDESC) ROTATION)) (SETQ ROTATION ROTATION) (SETQ \SFOffsets (\SFFIXOFFSETSAFTERROTATION - FONTDESC ROTATION)) (SETQ - FONTCHARSETVECTOR (\ALLOCBLOCK - (ADD1 \MAXCHARSET) T)))) - - (* ;; "If you uncomment out the code above, remove this comment and the NIL below") - - NIL]) - (\SFROTATECSINFO - [LAMBDA (CSINFO ROTATION) (* gbn "15-Sep-85 14:38") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 01:31 by rmk") + (* gbn "15-Sep-85 14:38") - (* ;; "takes a CHARSETINFO and rotates it and produces a rotated equivalent one.") + (* ;; + "Replaces the CSINFO of CHARSET in FONT with one in which all the characters have been rotated.") - (create CHARSETINFO using CSINFO CHARSETBITMAP ← (\SFROTATEFONTCHARACTERS (fetch (CHARSETINFO - CHARSETBITMAP) - of CSINFO) - ROTATION) - OFFSETS ← (\SFROTATECSINFOOFFSETS CSINFO ROTATION]) + (* ;; "Only non-zero rotations are coerced here, since it isn't worth creating and storing rotated versions of all fonts. So in that case, it rotates the charset from the otherwise complete font.") + + (LET ((ROTATION (fetch (FONTSPEC FSROTATION) of FONTSPEC)) + CSINFO)) + (if (MEMB ROTATION '(90 270)) + then + (* ;; "WHAT ABOUT 180 ?") + + (* ;; "CAN THE RECURSIVE CALL BE REPLACED BY \READCHARSET ??") + + (CL:WHEN (SETQ CSINFO (\CREATECHARSET.DISPLAY (create FONTSPEC + using FONTSPEC FSROTATION ← 0) + FONT CHARSET)) + (\SETCHARSETINFO FONT CHARSET (create CHARSETINFO using CSINFO CHARSETBITMAP ← + (\SFROTATEFONTCHARACTERS + (fetch (CHARSETINFO + CHARSETBITMAP + ) + of CSINFO) + ROTATION) + OFFSETS ← ( + \SFROTATECSINFOOFFSETS + CSINFO ROTATION)) + )) + else (ERROR "Only rotations of 0, 90 and 270 are allowed" ROTATION]) (\SFROTATEFONTCHARACTERS [LAMBDA (CHARBITMAP ROTATION) (* ; "Edited 22-Sep-87 10:38 by Snow") @@ -4364,172 +4040,74 @@ (SETQ COLORCSINFO (create CHARSETINFO using BWCSINFO CHARSETBITMAP ← CHARACTERBITMAP)) (RETURN COLORCSINFO]) ) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS DISPLAYFONTCOERCIONS - DISPLAYCHARSETFNS) -) - -(* "END EXPORTED DEFINITIONS") - (DECLARE%: DONTEVAL@LOAD DOCOPY (RPAQ? DISPLAYFONTDIRECTORIES NIL) -(ADDTOVAR DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) +(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) -(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT DISPLAYFONT) +(RPAQ? DISPLAYFACECOERCIONS + '[((* * (BOLD * *)) + (* * (MEDIUM * *))) + ((* * (* ITALIC *)) + (* * (* REGULAR *))) + ((* * (* * COMPRESSED)) + (* * (* * REGULAR]) ) -(RPAQ? DISPLAYFONTCOERCIONS - '(((HELVETICA (<= * 2)) - (HELVETICA 4)) - ((MODERN (<= 15 * 16)) - (* 14)) - ((MODERN (<= 17 * 21)) - (* 18)) - ((MODERN (<= 22 * 28)) - (* 24)) - ((MODERN (<= 29 * 33)) - (* 30)) - ((MODERN (<= 34 * 40)) - (* 36)) - ((MODERN (<= 41 * 65)) - (* 48)) - ((MODERN (<= 66 *)) - (* 72)) - ((PALATINO 9) - (PALATINO 12)) - ((PALATINO (<= * 8)) - (PALATINO 10)) - ((TITAN (<= * 9) - BOLD) - (MODERN 10)) - ((TITAN (<= * 9) - ITALIC) - (MODERN 10)) - ((TITAN (<= * 9)) - (TITAN 10)) - (LPT AMTEX))) - -(RPAQ? DISPLAYCHARCOERCIONS - '((GACHA TERMINAL) - (MODERN CLASSIC) - (TIMESROMAN CLASSIC) - (HELVETICA MODERN) - (TERMINAL MODERN) - (HIPPO CLASSIC) - (CYRILLIC CLASSIC) - (MATH CLASSIC) - (SIGMA MODERN) - (SYMBOL MODERN) - (TITAN CLASSIC) - (PALATINO CLASSIC) - (OPTIMA MODERN) - (BOLDPS CLASSIC) - (PCTERMINAL CLASSIC) - (TITANLEGAL CLASSIC))) - (RPAQ? \DEFAULTCHARSET 0) +(DECLARE%: DOEVAL@COMPILE DONTCOPY +(LOCALVARS . T) +) - -(* ;; "") - - - - -(* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") - - -(RPAQ? ADOBEDISPLAYFONTCOERCIONS - '(((HELVETICABLACK 16) - (HELVETICABLACK 18)) - ((SYMBOL) - (ADOBESYMBOL)) - ((SYMBOL 11) - (ADOBESYMBOL 10)) - ((AVANTGARDE-DEMI) - (AVANTGARDE)) - ((AVANTGARDE-BOOK) - (AVANTGARDE)) - ((NEWCENTURYSCHLBK) - (CENTURYSCHOOLBOOK)) - ((BOOKMAN-LIGHT) - (BOOKMAN)) - ((BOOKMAN-DEMI) - (BOOKMAN)) - ((HELVETICA-NARROW) - (HELVETICANARROW)) - ((HELVETICA 24) - (ADOBEHELVETICA 24)))) - -(RPAQ? *DISPLAY-FONT-NAME-MAP* - '((TIMESROMAN . TR) - (HELVETICA . HV) - (TIMESROMAND . TD) - (HELVETICAD . HD) - (MODERN . MD) - (CLASSIC . CL) - (GACHA . GC) - (TITAN . TI) - (LETTERGOTHIC . LG) - (BOLDPS . BP) - (TERMINAL . TM) - (CLASSICTHIN . CT) - (HIPPO . HP) - (LOGO . LG) - (MATH . MA) - (OLDENGLISH . OE) - (SYMBOL . SY))) +(PUTPROPS FONT FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) -(ADDTOVAR LAMA FONTCOPY) +(ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11429 21096 (CHARWIDTH 11439 . 12228) (CHARWIDTHY 12230 . 13747) (STRINGWIDTH 13749 . -14786) (\CHARWIDTH.DISPLAY 14788 . 15203) (\STRINGWIDTH.DISPLAY 15205 . 15633) (\STRINGWIDTH.GENERIC -15635 . 21094)) (21097 27729 (DEFAULTFONT 21107 . 22392) (FONTCLASS 22394 . 24666) (FONTCLASSUNPARSE -24668 . 25569) (FONTCLASSCOMPONENT 25571 . 26159) (SETFONTCLASSCOMPONENT 26161 . 26603) ( -GETFONTCLASSCOMPONENT 26605 . 27727)) (29442 47482 (FONTCREATE 29452 . 32697) (FONTCREATE1 32699 . -35314) (FONTCREATE.SLUGFD 35316 . 36820) (\FONT.CHECKARGS1 36822 . 41527) (\FONTCREATE1.NOFN 41529 . -41743) (FONTFILEP 41745 . 42633) (\READCHARSET 42635 . 47480)) (47483 54559 (\FONT.CHECKARGS 47493 . -54242) (\CHARSET.CHECK 54244 . 54557)) (54560 61171 (COERCEFONTSPEC 54570 . 60482) ( -COERCEFONTSPEC.TARGETFACE 60484 . 61169)) (63366 64715 (MAKEFONTSPEC 63376 . 64713)) (64716 72893 ( -COMPLETE.FONT 64726 . 67249) (COMPLETEFONTP 67251 . 67874) (COMPLETE.CHARSET 67876 . 70561) ( -PRUNESLUGCSINFOS 70563 . 71488) (MONOSPACEFONTP 71490 . 72891)) (72932 81390 (FONTASCENT 72942 . 73326 -) (FONTDESCENT 73328 . 73813) (FONTHEIGHT 73815 . 74217) (FONTPROP 74219 . 80667) (\AVGCHARWIDTH 80669 - . 81388)) (82047 82955 (FONTDEVICEPROP 82057 . 82953)) (83001 83855 (EDITCHAR 83011 . 83853)) (83901 -96091 (GETCHARBITMAP 83911 . 85035) (PUTCHARBITMAP 85037 . 87195) (\GETCHARBITMAP.CSINFO 87197 . 89213 -) (\PUTCHARBITMAP.CSINFO 89215 . 96089)) (96092 117372 (MOVECHARBITMAP 96102 . 97996) (MOVEFONTCHARS -97998 . 102744) (\MOVEFONTCHAR 102746 . 107593) (\MOVEFONTCHARS.SOURCEDATA 107595 . 113710) ( -\MAKESLUGCHAR 113712 . 116247) (SLUGCHARP.DISPLAY 116249 . 117370)) (118030 129879 (FONTFILES 118040 - . 119873) (\FINDFONTFILE 119875 . 121852) (\FONTFILENAMES 121854 . 122414) (\FONTFILENAME 122416 . -125327) (FONTSPECFROMFILENAME 125329 . 129877)) (129880 166129 (FONTCOPY 129890 . 134973) (FONTP -134975 . 135274) (FONTUNPARSE 135276 . 136999) (SETFONTDESCRIPTOR 137001 . 138465) (\STREAMCHARWIDTH -138467 . 142478) (\COERCECHARSET 142480 . 145847) (\BUILDSLUGCSINFO 145849 . 149480) (\FONTSYMBOL -149482 . 150136) (\DEVICESYMBOL 150138 . 150922) (\FONTFACE 150924 . 158128) (\FONTFACE.COLOR 158130 - . 164912) (SETFONTCHARENCODING 164914 . 166127)) (166130 185807 (FONTSAVAILABLE 166140 . 171504) ( -FONTEXISTS? 171506 . 175047) (\SEARCHFONTFILES 175049 . 178136) (FLUSHFONTCACHE 178138 . 180361) ( -FINDFONTFILES 180363 . 183579) (SORTFONTSPECS 183581 . 185805)) (185808 189923 (MATCHFONTFACE 185818 - . 186633) (MAKEFONTFACE 186635 . 187669) (FONTFACETOATOM 187671 . 189921)) (190554 191046 ( -\UNITWIDTHSVECTOR 190564 . 191044)) (205689 207756 (FONTDESCRIPTOR.DEFPRINT 205699 . 207278) ( -FONTCLASS.DEFPRINT 207280 . 207754)) (211585 214375 (\CREATEKERNELEMENT 211595 . 211953) ( -\FSETLEFTKERN 211955 . 212446) (\FGETLEFTKERN 212448 . 214373)) (214376 226042 (\CREATEFONT 214386 . -217282) (\CREATECHARSET 217284 . 221793) (\INSTALLCHARSETINFO 221795 . 225129) ( -\INSTALLCHARSETINFO.CHARENCODING 225131 . 226040)) (226364 227732 (\FONTRESETCHARWIDTHS 226374 . -227730)) (228362 238439 (\CREATEDISPLAYFONT 228372 . 230239) (\CREATECHARSET.DISPLAY 230241 . 235956) -(\FONTEXISTS?.DISPLAY 235958 . 238437)) (238440 253445 (STRIKEFONT.FILEP 238450 . 239338) ( -STRIKEFONT.GETCHARSET 239340 . 244934) (WRITESTRIKEFONTFILE 244936 . 249849) (STRIKECSINFO 249851 . -253443)) (253476 269809 (MAKEBOLD.CHARSET 253486 . 257141) (MAKEBOLD.CHAR 257143 . 258895) ( -MAKEITALIC.CHARSET 258897 . 262576) (MAKEITALIC.CHAR 262578 . 264924) (\SFMAKEBOLD 264926 . 267152) ( -\SFMAKEITALIC 267154 . 269807)) (269810 273834 (\SFMAKEROTATEDFONT 269820 . 271054) (\SFROTATECSINFO -271056 . 271731) (\SFROTATEFONTCHARACTERS 271733 . 272117) (\SFROTATECSINFOOFFSETS 272119 . 273832)) ( -273835 275009 (\SFMAKECOLOR 273845 . 275007))))) + (FILEMAP (NIL (6545 16212 (CHARWIDTH 6555 . 7344) (CHARWIDTHY 7346 . 8863) (STRINGWIDTH 8865 . 9902) ( +\CHARWIDTH.DISPLAY 9904 . 10319) (\STRINGWIDTH.DISPLAY 10321 . 10749) (\STRINGWIDTH.GENERIC 10751 . +16210)) (16213 22845 (DEFAULTFONT 16223 . 17508) (FONTCLASS 17510 . 19782) (FONTCLASSUNPARSE 19784 . +20685) (FONTCLASSCOMPONENT 20687 . 21275) (SETFONTCLASSCOMPONENT 21277 . 21719) (GETFONTCLASSCOMPONENT + 21721 . 22843)) (24293 43549 (FONTCREATE 24303 . 27548) (FONTCREATE1 27550 . 30209) ( +FONTCREATE.SLUGFD 30211 . 32775) (\FONT.CHECKARGS1 32777 . 37482) (\FONTCREATE1.NOFN 37484 . 37698) ( +FONTFILEP 37700 . 38588) (\READCHARSET 38590 . 43129) (FONTCHARSETS 43131 . 43547)) (43550 50626 ( +\FONT.CHECKARGS 43560 . 50309) (\CHARSET.CHECK 50311 . 50624)) (50627 56987 (COERCEFONTSPEC 50637 . +56298) (COERCEFONTSPEC.TARGETFACE 56300 . 56985)) (59182 62161 (MAKEFONTSPEC 59192 . 60529) ( +FONTSPEC.TO.FONTDESCRIPTOR 60531 . 62159)) (62162 71824 (COMPLETE.FONT 62172 . 64197) (COMPLETEFONTP +64199 . 64937) (COMPLETE.CHARSET 64939 . 69005) (PRUNESLUGCSINFOS 69007 . 70318) (MONOSPACEFONTP 70320 + . 71822)) (71863 81431 (FONTASCENT 71873 . 72257) (FONTDESCENT 72259 . 72744) (FONTHEIGHT 72746 . +73148) (FONTPROP 73150 . 80708) (\AVGCHARWIDTH 80710 . 81429)) (82154 84024 (FONTDEVICEPROP 82164 . +84022)) (84141 84995 (EDITCHAR 84151 . 84993)) (85041 97231 (GETCHARBITMAP 85051 . 86175) ( +PUTCHARBITMAP 86177 . 88335) (\GETCHARBITMAP.CSINFO 88337 . 90353) (\PUTCHARBITMAP.CSINFO 90355 . +97229)) (97232 119573 (MOVECHARBITMAP 97242 . 99136) (MOVEFONTCHARS 99138 . 104288) (\MOVEFONTCHAR +104290 . 109162) (\MOVEFONTCHARS.SOURCEDATA 109164 . 115919) (\MAKESLUGCHAR 115921 . 118456) ( +SLUGCHARP 118458 . 119571)) (120488 132337 (FONTFILES 120498 . 122331) (\FINDFONTFILE 122333 . 124310) + (\FONTFILENAMES 124312 . 124872) (\FONTFILENAME 124874 . 127785) (FONTSPECFROMFILENAME 127787 . +132335)) (132338 168671 (FONTCOPY 132348 . 137431) (FONTP 137433 . 137732) (FONTUNPARSE 137734 . +139457) (SETFONTDESCRIPTOR 139459 . 140923) (\STREAMCHARWIDTH 140925 . 144936) (\COERCECHARSET 144938 + . 148327) (\BUILDSLUGCSINFO 148329 . 152022) (\FONTSYMBOL 152024 . 152678) (\DEVICESYMBOL 152680 . +153464) (\FONTFACE 153466 . 160670) (\FONTFACE.COLOR 160672 . 167454) (SETFONTCHARENCODING 167456 . +168669)) (168672 189243 (FONTSAVAILABLE 168682 . 174046) (FONTEXISTS? 174048 . 177856) ( +\SEARCHFONTFILES 177858 . 181072) (FLUSHFONTCACHE 181074 . 183318) (FINDFONTFILES 183320 . 186536) ( +SORTFONTSPECS 186538 . 189241)) (189244 194782 (MATCHFONTFACE 189254 . 190329) (MAKEFONTFACE 190331 . +191365) (FONTFACETOATOM 191367 . 193617) (FONTFACE.STARS 193619 . 194780)) (195413 195905 ( +\UNITWIDTHSVECTOR 195423 . 195903)) (212709 214776 (FONTDESCRIPTOR.DEFPRINT 212719 . 214298) ( +FONTCLASS.DEFPRINT 214300 . 214774)) (218689 221479 (\CREATEKERNELEMENT 218699 . 219057) ( +\FSETLEFTKERN 219059 . 219550) (\FGETLEFTKERN 219552 . 221477)) (221480 232361 (\CREATEFONT 221490 . +224933) (\CREATECHARSET 224935 . 228112) (\INSTALLCHARSETINFO 228114 . 231448) ( +\INSTALLCHARSETINFO.CHARENCODING 231450 . 232359)) (232683 234051 (\FONTRESETCHARWIDTHS 232693 . +234049)) (234574 241940 (\CREATEDISPLAYFONT 234584 . 236099) (\CREATECHARSET.DISPLAY 236101 . 239525) +(\FONTEXISTS?.DISPLAY 239527 . 241938)) (241941 250211 (FAKEFACE.CHARSET 241951 . 245905) ( +MAKEBOLD.CHAR 245907 . 247760) (MAKEITALIC.CHAR 247762 . 250209)) (250242 254497 (\SFROTATECSINFO +250252 . 252394) (\SFROTATEFONTCHARACTERS 252396 . 252780) (\SFROTATECSINFOOFFSETS 252782 . 254495)) ( +254498 255672 (\SFMAKECOLOR 254508 . 255670))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index a5dd658464ec2ffc17342d9b58401e599f283012..739a5a7005a485c9c26951223bf1faf042396ed1 100644 GIT binary patch delta 21738 zcmch93wRq>ov%i+oz#gP$yOXkag>SjsO=`HM=#qcP>p3dk}YW*OOEX%jq^}~U-Ur( zw7@bg%cGYqY?ITHro8%~3%kpLEl1Ei#p~W1r$AjO+my#8CFQ%9Z+9;a0e1I;CHHsE znUO{sxAg9}AN^8m=FEA`IsgCf|2*@d6BS?mV8tUxoMK?BeD^!IdfU7~QIfU?0^23& z*n3;ow6}M*h}9m^Z+P6Xy)Cfa8$6a@v(s3yg?Xy}?NX4= z!q(m{k-Xp%dS-tlY!H@)l|)KxZWT$)cDqnb9(}$id1&hip~84O23G%lX4<5`|iq(0y$PK zE(@yLP6@jKt{sm4RJAkVL8IpGzA2C~e)iac$Pk?oF+)zxx$_b$A< z*nDDdrEs&grGf&VI?vUj$v)Z=ADBIh^V<4tJ*3ycPa7iYFxDPbw)`d(j6O2 z@FEPxtF?-;v>cCx4fR^Zfyj=*xI9413>8~NOdb@QN=3R^rye>E9jsbwfa>f&u{oBE zrRjvpdFLw9Qo9LnvgUYWubq=rH>f@wp>#re8@JemhnEq%Yo+?Y5;^lN3;uh0#`1Jt z4qZKarmwe(7F?{!Oe~Q6oi}b=%MSEr%E~4$pPqBauFTI_a{GDxId^%x$;(%IZ=zi} zY}JZgshd}vPD@^K)=h8iopblm#%gYZ-n#EfUvKqdwdX9MsT;qTzi6?)ojx94M*j}y z?v+{Jp{t{{`3p*IvTTCavSUf}q|eW}6KvA=^ZM$XySyQ0om_m@J#2`%ZT!c7E*hG$ z#%t}#Ik!^FI^D$kV)vNQpLiQfvoEN2=xC**hqn_&U4yZBcafPyZ(Apa6^5O-Z4>u` z1yX6;CqyaeEAK^;7U@L_h2QQ)9eG*$93g`TFXFO?cK! zt$*|9r`B8F47D!J_{5wyb9~0~zsR_2qpFk1pCZ?RHzLKyDH&6^{Lt zMF4&>ACkLHIl_;HGvf=#^FwtEX(nV7wC$A5&{n`>h1Z{Rm$qxVaRboCsnB6tnpA4% z6+6Xad)@Tf<4q0fZrt?FSuTppDZtvZE9DZr1!Y(sl51-n$fHfTUo{fgg)0ndL)!L(TZV-QiKEgzlA@Ut~ z&qVP(EzN!krz!GHcU_<8>j;)(sjsbl5mE@ZRUFra-8!5e0Bwu$sRe&8pmsipe zUXn0G8S79iZf`F~KVP5|dVxkV{i4qoEK;e@+o_YLx1*!HrMIJv7L6LTN2t_ZQ#GHt z2&`ZjQ|jy#yP;kW#?$n5MF~)#vw=TIjvw1#77IZWXKJ`$lrnzuiM6S_K7*~ahUVJl zmdjTib=Fup4P4767a^WA&@~wG4C`B4-p)Wfm3{H~1l{tw=@#$_m~@1Wa$+ENuW=Gttta!3R*`SJ?c`hQ-Z|1Cw)PLilIgAS$gW7dRqPQ#-i4y% zj&u}=X?vl`YN-fiGQQBl(=)=xd{?$ zcLikekI9$C)haHYQtVepou$x7RouZvAa%4U4_&T_E!3gKQMCkA9g15K=M@iDS@G0O zx5;SjWUV)`*5qfRy~e3*R5s5m&9qW8`GY8`GdDIWwRW~mPtW}ErxT8+R&?S0dKUry zMQ7=xv*hCpyop)XDWc+;S2ofKY^51d7MfCB z`Vw=NB&NAAZS2n-n#$`pEs#wOly*#=R z)yS*sooXwdDI2eWVE$QYJ)tyX%Pv|zM1Q|I>ba`aEih8@Tpg`@lceOP%i?~sq~x$Q zDqECo^GX}tmp0H6aeG8{jp9}O^Gc8w2Eq8F_IyI|07j07r`<5IJbV?pK7%XI!siuF za^bjA`@qEIm(DAjCohj~p1DzVBceFi#kNR=F^zGtSb?-kvC8x=D7ws?IyqWLW757ly~hYxTHj;_LWk! z6j+3!VZKC$(~)F%0(w+zYrh;D5UByho6^;Uu_X3Tr&h5Bm9U-09Z{(h5E__?2qZJb zN}OViTLJ^7Y~Rc~831?CO7N_Pm4S!|QZ3$-d7rcm{s3igARJ+n=G#uam2gg3<|?4f z$=Q8uhh&DR5y!E$)~K*th0Q(a+Pp7T^?u6o$jS{gGb8i zOkSR#eyZ!UtMt8tHz@{G?3;XP&-5>&fHPfYSX^3vTfv!4`Tz+hZviSDG4;~TJNn*YXt0`261pSox73p`sxxn%vOwUuH& z=!wW-=XR-`>OM+166xL=2AHN=>9e4iif!MXi~~w{Zrvrv2P3o;zyU`j@Q)&4f*iYj z%|UGfbX%w*C5gJ_fg4mqCon|OOOG;;K-Vbs=~bBj6j;jMfIbPBW`e>X=DRK;eAT(c zA`CSTwQ`yKVolVRs~EEjr-!!XRt_~YrHnnwExC(sqrm}k)!Aph92 z&MNuH9Xs4A=t`p`7I*Oi4omOhEMeFH$6$e?c-3Hg;ZdMXOu`EZqU#VNK$&ic@17(m zGf>(aDBIY()T!bHcvyw?DM50FQ?x|y1<+VJtb}39s|3)>*b9c;o&+PvaS`f*fy0ap zD7O2>*y<$pUIMnY_TUwO0(d(}-Vt3dbP(yaH8#=jCI1lp!1BUGXndhL)-F_#{jv8j zLr`m;A}%1t1=e7KD#ZX`PlEsHYQk|OBTz-!pYdVzFbXw%(drC zZ1Sa%>6hc1&rbhquib)mt#0;9>hECnpzq4bI5{mDa>k3e8n%)XY4 zS=C#WI___u-4yng zi*@=JmgXR2L?Xhp!XSWy1xJ{4VE7Yk;{X{Mj-}G6+rz?%&K?m zci^+xwx~SDrokA&DvV@z8Xjl6Lop_sWEPPcx67|i-FQuY)zMW0c2exuvj-6D%87LyrWHhvFkqcdNnbRCycD_!>3Rz>~2@FYVC);nc5La*t7TIRsaJ$s?cx%;7%Q_ptJvipH{3V5nJQEe)g_LOK zwkFqWF@DfwPXyXll)NTq*xAST)CsfMz3&um4~oeYea#*@5sSwnDQJrAq8v{vWrZDL zA{;KM2`}FJs>q>zPl;cMLY1)!JgB>nZ4Av-QLIK8v*R8j8%LY#M)RS$rra=me(de$ zth>nQXv6AS#x$Q~EHk}cLxef&kez&D^d8}v@WI0BLxY(-3~e;bhZjDrltMrjK`)j<=>SXZu8vNS^714Gf|*!y84Gs+ zHj;x$hHlApjHWMXD3B7{>8uP8(O%H4Q(D@N*bejjbsCr8iK>V}Xs~622QkBBB+;K9 zDU2C3j}gQe2F)o5yVf`>WK)&*8-T;F&||<4-CYgK@rW3J;?40XGTbjGQ%H0X{he)E z*-#|5BbpZd@Mvft7Kgn6KY?C>CJl*x_zktkvE31DV~2Lj00TSN0acrtr@mr8{gFFx zkK_aXKr*3{54%8j4brL1!lufW#PBB#Hw)}j(++wAowN5IyiX7wCjWeB7ul9sV#~Vn zq&L$vvhW1suqgaVF3tyX;EqgApfHDB_gTxTsfP)!`ee8~<`s4D52$JPABnATH z)nC=`g*V2-OKxSu+OcbJxNA} zm?x!${QZ&tW1X%dkG9-q5?wF%~5&eS&+lI!HE1_y3#D;Yr>}N>`P_^rpkTYYO{!DM|Fubutu5j3^$cpg; zHmReNh*b@+q+y$v`TZrh!i@SMRS(G%<9^j^&Inm7uLF{TZ+QWXy`X7RQ7Kq@+f1!! zD8Y!Qos!?A`jy#$PzKF774(v?eabUCI&rm1?S}6o0vk6)e_NnJQF>4DFguMEQ!g=7 zhkGE!G@p6V_X;3+#AdTtQ?C~|H#of)^?C1MUN5)VwR)xC^yUHPIZM&a3WYMpvnb$f ztq%>R!$SS+~3&Ypky&`T0GYRAKE>i^Ud#7qO9h4-j|g%B`0VR^%Q1 zh%Yn5%-)K>6F;0q*drr zYGr1{=9b=;u--9qL!qXnE9!b~`qvp@uMoEi+>FgzZMg**+vtU=wAX0%(GVNoSZ^_Q zp)mzdNi5r0$O>+LQ3BuAjl5aVJN3BJM)U?@L(WBQ-4_{vo)#!| zUilECG&-|<)Bra)w|tUBp;yJ$a($Uv>0anL2$A-2ixex5&1EhE81Zx$w8#l?w4Axk zSPkZGH*0e3Z3aF?YP$-o3~H*rk>ky~7Q_pd?i$pDQX4;r%n>702N8QIy>AocR5*f| zTR_v@RjeUH+5kqR6JQSkI7}4{__@=dP{~(NoOvU>pm6{ixz+p+{*HiH+#EQOi#G_% zjPSg6(Whcpi>d51>$XkQpP@5-MqVgeU9mLS0tQd%3Q~U~0*}UNco9=Bxrbg)eGDQ^ z=`uc$+EsYB3z_sOM4E#7@HDu$2X z7r0g7cw{M2?*E9&Q1x$kRQ9>9=)xy^!$`#tUWw-Jo+wAiYe0D0BG?KrMlJ?V*``6| zKj@%Y-T}OZdII}0rA~3qD_WjR9nfBLg&)t44QD^v8@+nre3JX;jL<%iDD!|K2eXj+ zxL@<^xy##O+yr}3hfN!|fo6O()J^wqO(0{PWsz*qTPLq16HF$R*FGCXI>__}2nVEy zHR>-p!A*xzJMGd=dfxk_ItI9>Y(g_SC}nUW+oqkb3BX4eiBp>oa8oMI{bmX8qbh8< zAfV}p27h8%h`fohkwhU#6AT4mfndfR@7t}?%n?Sr0Vr8U+6@3TG?oY;nqBe;R9t%B zR%E{b6hk9j2Owi~cBBTd#(e<*ANo+KQM(m8Z?^aFm41Ngz78nF2BzVuNCBV#|_ zw~T50=(w!NXRhS~^3YmS22k{w1s**zP}Uh`{_-LO0LzLbGv-R|L|$7@KK=fC)%!t$ z){^|>Pt%n9^XC$A=0!5n`OdhR&I?}oeY`$0e#_c{&f^-LmuC2GiO;#oQ?8py@-JRl zODPKLFT+^?s}Y3g^>vETNE|3A1vK#my?~Q}rb$SPWCO7jqS6c^h$mlJK+uQuN8_&g zFj&bw0zxJCl9&9&jumRD7s%UDN*kttC~(!-i?>Y1P;a{N`63w}rO615G&KYQrfi3i zqWksL>q$smY4iI0WLRBCRCROHP8Lez9);t1`QxFh#dK0~Rt?$9SP3WbCYxq&e&FHC zL;`V!$}YBR2Wj?t$d+r+{eH9e$9Ws^xK8(KZOLEshPbR%2CfP1}T3bEPuKc10KTsMx zTf-hEjXhiGFADGjmBjNl{DJ^HhwuxBW;5ctVr^2<2%-hfn9kWP57}4P1nUxV`-!b8 z5^8wr1<$%UE%P{&kwcTQH{j4=ULVnBGlz07l*3jPPs}H&F@Zelm==-Ctz!+y$4=DV zRCrFFI`OvcGdFI934tW}BJ5MWyi9&bV6JjuL8>1Q9w=rg6b*N{_UhB}-Vz*^oSC z?ORa`n}2NKRFlEZ&(#=igxxp^)thYz5yy;Ejple`)&n!8qgvSHsi>W5P!!`$S$>p6 zdBl^hKC>sh@MD%0Nt#2So+eIFNMS@k&nXpB0+(u8gI;n=c5@R|sFDf@3hr__l~TgE zM3?|20YABxby~fCvXEV=dVxO_`HCCmg-uSUQY?|6x3G*HiaAUv;@Lk)_{C&&?n%kJ zmyS^4u1;-MLr7EOn zoE@l=Gq&tRM#vuF!f2nY3nQ5dBm80exsZ(@-=#aEk?TG#8b6&+vZsvh_6cwk!IJ_n zQ4+Lwu!{cRcPabDMRi{OLN}{V{YhWoR~7lNc2$+{)~=T3BidDUKANkD*=^56&y9U3 zDx8a2pPM)zCwrcA3vu$^=iJ@-cmiIUv%R^S`o>(lPftJDxB1NUr?4#0QeX$NWKpIM zm4wZpe9$dsPJ*D1-1BJt8ZUKslpKYZ+uEQJdEu;+zOu$a)1Znw?8O;)Y}p~2>av~h zCIbrM+^2XA=FyIHL+946&?>TXP>z#- zJ5M%^&@>;8Aq%2xl1?t6NdnqZeTF9=W~l$sbG^P3F~=^z@_y*h=Q?mXZuj~ z2exPWK)ijzxjyUJSTfF#z1MYS`Zbz^OCx6ZI)kCX4b|n=7lu zZDJew##}vFc)oG=rte&}HgWVv^bB98kay6J5U>S8F2#sQe)GLlT{XUO5j{Nq_OYYl z5Qr8v$jA$umKmatNkupNw>CRcI%LxHieZ(6g?(Uts|sZG;qy?-t9*#`!4T zermpn{I~hu#%j&zZ4RfX($){WV3Q;NG_N$$PbFx|fNuY?VP^+k92C@VLCD*9#Q%~T znNyIeR84v+^k?y#M#;~|nhcK9|NZ?<5eeRFYAez>O}Wwu5-e9bDP;n}O4J=+kR0=Q zHk;2knthNyiTul_Hjq6(*r;Bji95*i3uy_J*&ydjuFVvcli|!`p~>iqT6<`WA9Y|# z&oK@WT(Mw4D2(K`8g-J9Q&U>nS(&QNYTLPkY&X~SS)SP>-45>j2?7gU!qf1?CZA2|4p^{JLg)x=^>D9qHd66h|k z-z72&Wp}>bj}c zU!o&v218Lr0#ut79!-zJeA1B?^575Gs9qX7*Juc_Z0@Q?^hqnCke!C*ZNs_15cA>n z$_#$l);SzP*K8BJ*ADSniqvwj;_;{)nzD7RsQqX(Br}j5$(*W|V_ZMHBGw zG9{m<(M|_Y}Bct0bTQNsABhH9dO` zGvfyM;`Gu|&61W|s>x@6wu+qk>COFqw6%r0_&ZXj5N@WtBTOuO5vSwX+vepiwqypr zczVY2Z%j^Uf+`zDCAOGk$MyC#Okam8VHI>qMioB(JoT?Z$?&{TpS7vWoPhH@q6SnBIugm@)Db$c$9Kx-RlY79%#@VwI22SblHVR3=1zS+cDW61^UD zaW@A;%#-YKVbch9bBp#k&h|@xbn30IyOD3<4Y(CoX2(#Yh;E8**J!8y^jml!zcEm+ zLQ5#-Wy z5$vgBaQkM`!%Ghq^SPeUGP{v6&5rJ56zBEqP(GHGdvQFPy}~FCEVDJCiQ6|TP4vvP z8)trS?wQ8>k-be*vH2-zr4bq2N+V6-=90E3r(;?^c(z4p$b{LF&93FYN&|;_#DPL# zCJFMrBe+3Acf-t$y8*LQ@EZ9XX?w7U66Evutcr_%aBk5T=chjPLV~vs5xd25w|xMP za!m;y2J+xPHmKC0spoZjajMQBp^HM0nwN}wxMKsEK8ubcX*w1&Sn206^p1G~0W!@} z5sj{C3VJN4ovv`!_cLq%B%>$Eh!KpnuwmQ--y-d_kw zQ4?G13R`Tf3KuzyNkivk;35`UiGT&&i9mtDTlH<5`?WD?wU!kD9mwWH;e6CU$}XfL-K8U8|H zr!k$a0M1Uas}Jr{xKEKv6e!+6w3T>Kp{U>YJC8~gK#&_!eVCStuUN4ITlDPZKm-|u z$V-*5x4aZSFXK{`9Wf{m9TtL&Aap)725YGBhbctWY=7q2+F>hN_0)ph-3ePKBhN>gUy+Ee)nfM7fhYx zy0RZoZ%H$1PjhKdm11`^yq1YMtMYZ}k^*bK4o5lomsxu4Yzq82lt~Gw%#vh93I2o= zk{~qNZ~%q;c*W{kq$BDFlf`x~K8xvc0f7@;ln0P8VkB*ZuSS2_V8vGekVE?xdOY2u z+&Oi>_|ChI9ymIF*PZv$wB@!fG+FTgJ_qT=S^fj>JS-lVn!4*fNUH^a;ByhQxaDh4 z2*UeqCk|B#B4xILetGBZdbVzf>ay5(5dlU2na?8XpE)f1E~3ZuVMO%LzKf{)hgwd2 QX{jKR`+ssv1+_5#A9kCd=>Px# delta 23874 zcmc(H33OY>c`g7_lmuB6K+=>%QP347(I73dxY$U_i*N~o1c>EA1SE=DOiKb~38W=2 zYMZo9;iPr)ve=C^kzF@y-R#LpDbj4>6(_dah<m0M#*wtPYnQ_7>&cAbc6TZ_-K4Y~o!x2MVomHplS(Q>*@Id# zmWV|%ik8Ug=7bK#9ZSWsyl65Ut|*MWFmJX~v9o;5PWIKBEo<$(Hoi2i9Kg2@@Qz2a zY_Vo7TT#1}-L|KNMR3j6w&K2-eX@4@ax^rU$|&rlwfXe2I;)-4Eo);P%LZ_F=d#W0 z50~}NE-q`duIL_!Wzq?4Z1&XhuUc8x%I&PJxZY}?y?5om+1RP;ZnmKxGuQRqi1yMW zdRoy&hEiG*UnM(1iM-RPOjb)}F(7uos2%pDTQX7hl#s;!c_Pb6u`(FJcBd9|okjak3;(WfliCEI+1X(!~$tt5G zv23JVmWs-f;Y=(wsG~JI`_!8CYh<%YEgtFD69ep?HSI&x042n-S|S$irf*d22Qq_3 zAw}MceA$9b8_}~wy)?z_nKd2ku3xTY|FLFmV`OhyAIU22p@iPA3A$ppIM!P2XEs@z zZCv6k2O=XWUP29^kQ$_9T$g6|P#dbu?&Y=Zs9rGYd%aYEXW+V|zPAtAKA))X^YHqn zxBL9a_VZ*Ewo3-Uow9r^xK#AL>qP2`w8-=}I3ysPv## zWs0HU&DqO^MDMboEYWx;H9~}mrevR0qfDWqP>C3;i3CyanVX5omI4CHnLYN zU=!h#DXuiJLmH?~$wo$!v6PnRPzpwmu#z*GSQu^FvoSD}5j~0Sms87AFZxEEkgX`C zlxQrS)=ibdV`gu_T77{4Bn-RK7eH}%d4eu!7(gOBWWHcN}Wp|H^Wx~-! zKNTrI>w1D$D^Oc>2Wsm|#D=0-B*q)Bq`R{BZm zmk1p-l6aPFqe65jc z%oy<+nxC=?Fn~de?9mdTgsu%hA$Z1_VCx#T@3MSrrNv?k<(65`6!W3WkA(1Ou@s%R zFVk`_(Cy4kMJ;scsj+$2@Wu1Y+h z-c0Dyvj^Cfk9HL1EupEaZ=OGAafr&@;^Kcg8k(}j>m3%i>I*0bgkB03I70e?>In#~ zk!!0;Ur;#!^#kHHq9v7}XGw810Cq+UqZ>LG6i>Cst8g`^TL;5Yg8|Y{sIuzy^Ogr9 znea#~oz+K_K98dB&Zc)~6@MQ~KD7CCZW$ZC{)PjV`TyJa-16&>3Dr|owooXA<$+!+|#-N*~F;Cg9L}X7S(TO*DedVOo zP&Numv~6p)S!zSMoG-Na_*u(S#r~PrycTwDspVu9>d%dCAMIYv=_Bfx4CS3iRt-^bZ?jUE zeo(J>aPoZo?A4*X^X}{VXYLWSzOIVa$D62H6X>+<;5+vyB^k&I{*XS*J>v`Qpt++5(Da=&?Jsz(whMc<^^p@O9Hb;K(3%ob) zKUXuZ6sywaE#qzI_?=f5^p>ew-t5A-tE$uoUb1~?YG84ED@y9F%csv;9?-Wws<-J1 z-t`A`eSW<4lHNcg(^`9JyrIZ0Zcz%?>+QPxyxvK@>qPG`gh{;>RB$>x?b0!Dg0lKQ zjk~tR&+DzJ#nXEI{rQDgp4FAfg>mKV)!#`%NccgczULdVv>fttv^ydKa7lOVqz4 z+lK`Y%_L1K3JBF7jCre9E1;DnNg#65()W7R>JqBAhyC~VPOCcmZ|$?!6(p`w1)Ufg zg;dc?wuBVwX%sLaa9K-e)*r${fr}EtZsp`N5#+3dMZI8ZJ z$%6U7>)U1KJ)AuW)v*^i}f|CD^A#_GTlgfh4Sp zSXWw$fs8;!g41y}D*0|?Z!D9|>|{HGYi*uh_KVN8H3Y%*sR*Etus#w|{Jrdl!JFAX zgnA2ewH8Yq@9U=A0G2>5)MP8>w5Hl(uD_`ccQ3Cf=JGGEq&s^t7k+tF5i&A7aIA&? zffYw{v8JYCLyj}5rq-f%5@OHtk9;kQ?3Xtb8>VbiR~L>8ejw_&iVaS+W@nTad@}Oc zsAL_Hi|1oamZ)Ru>f}QH>8IkuS7!g!$cyv5Vtn$I{nP&djRQ1y{`Z>KAJ7sBJ=~AK zxY7%07u!2R;wtE8pZdowE1_r6JSu+n#{LZ}6bL|1cTZsUo4sFNZS(rrp+Th!0753V zV@GEyfpxZPFrf`~DrrCt#HaOeBr?zy#+uCVL=QXL-(*vJ*^7f6P$>AYrXykE>j48r zqlchqawLK#2lbI8Y9qC0DNP}@cgc&8*jEia4l0=8&aj>uh-Co~bwxFHa?nvgvRI91 z-{-vsJZZD7TWPV5dPcos{4cL@IvmlOx!Pk6>yx7%K5;x}ZaJSj=jKMet!8djV|?yn z)V6o}hgPsuo)asV-3I~~^|u`HA1*o_O`L#6ds~k4Vxu>=IBVAGoqTE=c%8*3YIS#m z_3^XTJN2zLoAsIDQSa!jQ#FY-_4~OdkDLrI85eX=-)x)xtx=D4yuBD_H(&7;M!osP zPwMTt(ID^ZqeWhNx@~j^e||(fHd2WYPdOt>tS`pLo5k%oM3T|^9E25wqrUD~i{2y? zTObnTgWk|oU(_3{G5!tsDOfD)MJuKbPQ)RE_>0FOaZF9S##6W5=&|9eK z7EB2K+vrdH$Y0}P;|mPE=PisL@xJURo_#w!%sW)n+ic@)XWv#W?tsS!zNTj)gFAs< z1(al5aDO~_lyoMtdq5}jllVOd4f&B|Kd2Lg$ZrCwxKY(!h20-nTLAOd(-FYGoGk(z zBMKh?q#llN#8}7%YBEFeqqol>dV*CIKeR7tB8g`xI~C6!Z^g5(&!=Sc-6LU0JiIv^ zb#wEI*Y#oL8hQT8W_>;%d-TCg1s@hWkX@3DBpLu@K}`1el)YH+Td^Q}#nLA+Y3_yB zTlHMkD;2#819<>I4Td=YEgMdc%8rxv8{S@3CeTyy8nWbeq_FmZ67>aH>%jVr=vypB zh8&i+>=9wOb~hQ6?5&PXHBiaf`vx}D0C!~e`0uet<9=%m`)>TVXBQG*sAV7Cb!6FR z*IFz!vzK?pY=yMmFwCiac2IA~9n0l%$Ay+SyS~`}nBJfX0rXMa@nX4$kAcePnx@xU zbE4wo!!7%Yy4yDHu9^E6Ecdg&e9__#20WZBpsNJIQ#csNLH7)?x*$y|!PJrKO6)J_ z>6`u2>{P!)64-H3o<^9EYXgJF4uHx|IEBmHjZWIDy^7{Y>AW*PY zAwVD>)S!|c*`11T-v!70GfJO|z9-W_Ln0j6C(WvNiJGMLak}ReZ?<7cu1L$@WS<9# za?6CfUP@w92}pPv6n4|WZS^YPyZXH2ut*Upe2l8 zK|m{hXt2`Tlr|h%3VePQo<0RND_IlG4MeGVCdlwKKSLikKSEiM3#>5ZX7hakxy|-wxbD56Yj>_i=p|}xiQ$CVrFfl_3Y3@^LhuT2q{uGOUjzJjW)24PuyL2e7?!* z(1gOb_~~LOH{bO5*|#5^Z?ah(oWvGCE7KlEn$3Fl?T;FzXBv&-XJpnNR@OKvlaDX0 zahJ@p=Gps?Hr;$HaSV*OGh8>!NBucW!fbnLW?ia0_K(G$P0XzZ4IX$J!~W#-50mZB zO#geFy>LfcBnUDyV{)+8#PZ{d-q%ZPFFmICNc8XP+uerYLKIT2sfD@+Xt}p=3-3O5*(p51ICidm? z2*nj*Yl-FOZNpHNr7tuKu`EmIr8nrAy*2+HtMxtXo0EHzV!~(E^DEaE`CZh?O$tFl z4huLUmNS-bYzPuGlGMT@I%K3@IeAp+^D9RuP8~U>^ak0-rgFBvK6Yj5{LLzuJzUxb z`a~KF38A!=W5@)p{83S`-RU;2MIE*X6!}xd5UW42wje|#Nh+TG#0qhRBmwgQXqMH} z0IA6o>(_Uu2GWG{rr}0``%sJue?Nww8(WYrk#HPfFVJ0}X%44ma)2f z4_W(|>*wp7!D=jmefeI0jT-D@KmWU4tC!thXj07-uX=<;H4&BSfhabK&44=l#Zy=6 z#^aGOOd>|Q1FVc_nS0a(qvqmq5MmMSaPSbFZnoH?getA|)UV==$ z4ZvAF$%~`2>jlpe33`2szXh@)VeRL)Bt@Sdp1Ur7tYzPmWRra+-u~3|&vI5GR%_H| z)%Yhj+MvT}^w|UzRepEChY#PdU-ef{9A8y5572ZY-Ehj_q5woPl0fEWQAKn`v%qN` zbPtM)YVh;G7QeBueiKRHs`XFA&g}=#I{ULiYSn#>814QNkh`)(XY8T-$E@S*@9)>F zF4p<}bIUm=&wro2_5Qz0`JttiUhG2$4-hJrhzw@q6bRr8fSyf2fR`{7^RpkCM){f5 zKe(Zw1_YBwGS(>8Ek$@3s)wSgfK7Y#9tB<;u!`-<%$U?T82EM5EGTEjUP?ZTH|>@COK#K0|+wL z_hU>dp7AB(xggXaKdeHjA^E|3&1HSC{K|t5+pYWnAY_c=SQ!|aeZom#JmU+DTMUTN zLlt60a4#5IL5xX(Y|hf4kd|nEH+eZKo}sSOw1Jc>%}sQx97>c?dOXIE)E3 zE$QlBFb0E=yj5np7dnnyAzm;p>Sixza9*jinW?N7^7kVT+}Z$PU~{Hx4XMmP6!Z?lc7S)1CjzZWBAo&mM5YQ12DD)Q02if3u=7}k%9 z&Y1EWl&VqndD-|wTWeG}=RWw*rc%%$`@%!*&2dt<|BBl1UrHzoN^@4%puEFh zf^n1up~i89j1(6=j7UHUtI^PkA^|`9+eg+FXs|gn&((DjBOGf(Q-bF%RhWS*V{$Qz z9;L0bvkjfUo#OsdtkRA)#H=j0lNk@x=Kgh&Rdhed*R4 zr#}w;0o1vaEA&>ADEq;ef;X!$kg9|j`JJkhFilI6d~9fA8+&l$a`vq+-(md-Q@*mt z{&(84nz@<}oVC2d?*EFbmLLlDsjqy~+QG74^;mz#9{B3E0-=%s`GJQ+<`3?RklODB zL+npvGf@rd3$XzqPvq+IlHaQ={XsSG3J?HFRAA1auQ5MkDx^Qb2dGqh!Qql%@-6*P zALy^@L%n^KT#q=jX?cMVD#fze>t`SR+8Jx_?B=hpX<7~X*GoXe>Ev$|g3IBv;a(UC z_Bjs;7mh&KxGHF)F|;~wCmCf<9^+$sI%>l|>%M4?F5C#?oNT6*lu2Y-^P&X*6;L!6 zch))e4uaP#!?)9Kv#r@?ofD>c1$#kV!94J?M{es%SX9vkvGduA- zY~kDO*ZW`$We`TGhhbv}G2^&+nEL$nww@lktPVoj%KQLNu_2CKeZG0CKW^Iq#FroQl|^*Ofw#haYpvbeoH zVwiwBd*QsBc=3hh6dCOGsk6WF7ay~(qz-n#G3R4{`In(1mLHSrGBmf6lkZ_m&CCr> zk1aIanzNFFG9qyBZ^h=8M`1O+Kid8ztfM!F9SF_g1ko?AVR;>p*ND7gZL#k??%HN6 zVoAUfq*ZaajxM;a;8)z(8}m+UO^D5Z$7Kz%zyFTwU#O_R#hB%DCTXNQW)d0KwT(b>gZF8}uK}EG4rdjGGvS`|`LfG#R zvjUM~AP>^>OF>#YjC%=6Lu+2bvY^~|lB={+K?@ZAjGsWy?1uS~8tW(6iSKUo++7S= zH7j495(=Ej7DKQ^ZPs62o;x7!7N5w3FkBk`*k61%!EStcV-WHizM~9OA$+5}12-Ot z4DE({o?BhUJxDkSG-P*D>1BnNKi?Du@@f-y_~P8okoK>0J3=h_y*?*Li@?dzN$RsN zIQ!}E-CQ%f{D17MW1qXQ&M~Tw3@GIvJA2Osg*|xTo9vEPZ(z^7zJ`6~RTp+E9DJ>n zExhVr`PUrmf4|zvre9mj`f!hDtB?KeYujr5v~S>juld+VUTbFGd5yL>oPE88z5Uv1 z-pq#AJJ_n%oh7;`?J^GZ2PM#*u~dxz;2A?e|^cef^R4pL$qVv z#Y_Ws4@4)9-*M~|?)97CIyWHDITab84?q@?LWb5Cc z?)SVAW%s|)in~v}F}zNy%kFT7BzYR-q*2JHoxS~r&Qd?Z)`QuJAMLibj03u;5g7GL zF8E@OEj|$nUCTJX?Z?};!#E?`f}m3&S*08Ub%I9BLJhXQEEd0OdTLiz5JmDCe160#OK5)%t8MNx=uamFIFP=qqgX z{&nozZ#5SHrsSZ0Hx*4`1_i)`VU5he|T)}9}FkV%-=+X zRX4f#NRbzEh%$T`s|w;}0GxWEZ6Gw5@H|)}Cc&_s;8PX8RZ$Kgm{AV+f=QXcAo&7_ zLRi-f)ov+A^|Ob5;##J8JRX&~-@0M9Wxa)FreEU%eQu5Dt$gG?tJpt8ZJIhoeZnkJ z)J|!R2=n^mp8)sZtOwYdkpmQM9$qP1K6K^ti0HgxMB0i#u$Rb1_Z7s3g-C^*-p!{| z#)w(U6Ds+p(`hvUV`J8s4gdL{__0}!;u-(AgIfzt)nHN@2*{fA;~gh#7K-F`3n1=W zMkpF3M=|HdGrEGusPI$q4$i!&MMHe3iaa=^kLf>cE|54o(7!vD7~uLW_n;ADqeaAd zFU8(eMdp%?0CU4IRLIp!#m%N7?Bl8=tPF{|)5ud?B`uI>HX@ti^Qu6jUm|fKIjh63yn%rnGwlB3I+FV zC9z{NlfjNlFUp8*MBsIRClC@x&W>=1+up{uG++@#t|o<3tfq1Td9lPcM7#r07=7&H zPp+>8*9^#;ULW0PP&{A(>nEn(s~o@cuBnMTCr;4r(0fjvI&_M5#VCjFnNU32Dg6D= zi5!eNPj{PLfokGL3Z6RHpDb=-u{Y~G{~e$MCnaJd1|`hgB1nu+xHM~`Y}4h|4o*;< zc)tz{NK(X1uP7cB&!q10(pyAnGKh?l0Zuy{co&URs|8W+MxmeZbiQu*UHOrx@gE{G zvIO}w(U1xYgCe*gND%7hh3dN`{)Vt0!7hx6#AMM705UanaY72HjPZ;~G(FP9!;B%q zD9@P}z^vht@`5K)c~dTI3L{qqZ!;7$0hkB^+5rlp2{rOy^BBZbQsdAtQ5Aa7Vcv?! zcJz0$9}Kn>z*Q-pha5aSAkP#%2N9*g(PK@QhjMl^U;ZM6Cv*0H!~z9;SIZGwF|E9j zRu*_6KH^W*9LJyo2jr%|&u5Nw0vMwQFzRU<9>hR__7UbHf_1>ODQJhN8O{v14<6uN zY#HnedODzDBV1?WDnf_kzEt*^ft{_TFYzhZ29w?!MNlR_!Bt}gzpjsLI*7*U6ZseJ zPL0M=7(GA{$vr5J?Ip-9w@8DM<^lv=fSpxYuX;4$4P@%zc0QmW7POPZh{76KI;6J4 zjTq9=c0PC_RA_b!A1|3^8r61;>ZrTrh`Tu2p6A0k+RjP->#_n*Lncq0vMqjPw7oE8 z6RFO{dZ%NJQ1o&qu3kkj+tk&mnuW=QAMxUdyvqR*w^gM!A+-rofA46!@&^7E4jMPN z88^mNga8>&FWdQZ!BR?CW!xFpeWJ!Wd+tQx>g6-&)P>0lGHsPPZDG8A_#*!4_554* zkG4w$*fOlwzk1PG)1WH?<+qE=tq3?o2zpyyFKnHv)tl>Od{VrrE;YH3yf7x-GH*M8 zF|aM<$6JaBq(_kax+{N{&|A*uUj~reGWp7Q%k*2ZMlA3spJ?1@5zYTQ0fywIV(1TT9iaUr)flAX4aVa>4Wp z*>MVrmtA!gDYVh0w_cfTL~y)Ibk>C)xTgO(nnweC4T>*}7Q}#9nrbN?D*(35?Oaau z#D5G(AAX4nxK4!`XHuN8C#uq!2g?^yk1vbthyq*^G;cgX1`BBk=&n$`h)4l5)r2fF z1v_FdQF(6+R#mVnEHHrAN^vUPb0rO0cr)PmFz5RMklYmsa32mrOGK;%x*;PhJ-{uw zDy05mzl(dr|lP&jAgfM4lkncSDP+p0lfs?hR zPM%T@NrrO@<-kH0}=mmV`uV!)A z+S9*dpx5qBC~iV&38|9fQNYeyF2WE1V*Be2q}Xyc^X1Ug2EmZDKh49*pVuyb9y^CF z|B+^-6Qlb0TErCzxO|Hdyal*in1s%n7Tu$J&+C5hCEedJmYZ9{8K3~#iyU7^M1kdi zMA~iR4LMq2*zbZxlm~C1xZ`HM>B{T|te^(H8Ci>8(3|I0AOCN9Ggeab^pB72%THaE zd|{p5a%FZSFWMrCw#=<9&Z}S%#p#R3_V;r>&3|}b3S4vEo13~{d~H-P?C9_% z`8*7#BfpKtjik7dls|~>=CKKfcGw`U881&J_$C@G{hZ!<`Ei6Y)83a?#+B(GMUzGY zNuz;S9fyeL>-g$FXB)4dS`i<+owFm}e7sHHDhq&- zZ8eG%qq5AZad&YX8+VK{xGk5-7b-tnuQ%SM*Bhl|L$Z_emMI&$Wpu!J$-=9Ax+}PQ zXuPvX6p+{bVD6pujq%|;N=0>l=_USx@s^_Q)jd~cd-&{mY4*OR`x79abCy@e{l$t( zraBl}@ANt3a^8H-vM}CV9N(^Y8()iCqjY0ANC~bd5ecpodawWwAW8|F>!8?(J32N+ z-T|wTcVI;Fj)IhUjQ~_Zc}E;kq`|Q+?)-3O$UC^Li{57$*cp?hiq`<06y2mZj}JOnV5M&OXI#W&tFy7 zk0~%r(w6Orz+bXn{R@7^q z{%0M zYM2*_ilQ#`(nY;=0gH_54S8%t&kq-Prig-E%|D%XY&xK1N_}pc$;cAw0Wmp5=j-iP zX5CS2Q>4Fh&^zfDTr#I`r5A8*&W*2ePybNr*o2kk^yVgP=8Dp0t`xzjGz%2$1`d|P zhQ}2m#R7)A9SPg9!Ar8}Rp2){y&HI|RMw%r`M5U>(NORl`QWkakApPfafM}3cc6cMbGIHm!xQ=n2a@>fOl_~8*SlP(3DRH`Z-0F43K(aLgoLxtz11U3c>tNw+{}Ga6@VM_ZcfE75gPi$gxCiw zHTl-2){19GlSAwr8WYL94Qy-EC@NojLx^i3qnr)3@!as0nd=*c&>@HS;o>CW@G*yo z{+rnt(&C&jtp{e-$3+}byq~9hFfPi7O>s{GQUGJ9_*}3E@a~FWK(894V88+)+EqXj zK$>fK{wYdG@TL;zfX#P+E(AG%vvItDW0oqWSFH*OqDTgs&N8B)f|}|p*&Vz6fu?2( zx~ohED_7Yk?%vW|NfBhklWT}I|NHjBBbXUmNN8ZE&ssi8rxG}KEhESp!6);UC!-?P zVIQBtbG4HTBGBqw4WERk#n8`NqF7eXEKvfU9nROHict2G|2X4`N^GH-5Ik2{ENylhXeer}W*Iga5xNJ@;RtbaJp(9@9l} z9o4iRkhH!8G$l9A(kK^IQnSg!PlH~fbpfr3sS>na$;wn2+i#|IpThhe%4)ZHJF!!wUIA}v#Z{5IlPO-@T{Q{KbK6AtV%-8PSw7a zPl@XVXTOsJ7>_kZV+Be4z%p|A%YRbL3t!yj(>Q?zHbo+*w=BpE4*O6>18j>FZSH?{ z0p?L&Z@T=r-gG}%Aqa;C7=o7}rlco14kNMp6Md_e0ipQIIk;l027Md8q{4E zDD^`1vXrRG*{l005QGN_8A6Qq5^q9Wd*E72v0z$?q=p*H&I=`0F1t$6!~Fnd4-$|F zvoM3hM{0El9};(1;~f=8%o)p;D_R9Qu?_<2N8mbEsY}(#t3_UIQgqwpb=871w^G7c zwel*s-GO1DdfjHIU|iQ}C}NgijXJK(Y>%e$iBw*%kIMlhb51Zeu3ZR2n0sa&sbReV zO!MI4Y=1NfR+x|RXQO7RVv*-!OSj0Mys)%{-T)1z;q2A>F*O7fm!_r{xN!Lif+HnX zpBLQF#6}SzV`ifmQZE1z!8X0HUnJXvPHoH|d1_@UAm3~17yRgwtW+=%yeZ3(-IkIrU>}p>xzIhgyw$RB1G}?Qe_8iVfQsRV~cvXzWoaFzL+Atx6qQ(yA6II zR9YXf|uHHof*28B+>KKV;t2; zEdWJEP+jGDnsf|fK_15m6$<(M6hK_x)p4419H(&_C;0O_o~QY%j?+vP_+g+BukU=E zroDWIf^YMNexfiWNMSsLte-`?R+&2oYA z(LSaxvN!PKe<}{uJo6K)QlO)Mb}IjmPPY`NW|oh)G!80MONUz)jPowVxvS-~EZ_C% zmiBTTuuix8U7c=81^J1UAj@}ix~1KGyk&_x{`03>mJYWp7=-*zXIz$OxqJW