github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-09 18:11:31 +00:00
Code Issues Projects Releases Wiki Activity

Tedit - a few rough edges (#1937)

Browse Source 
Little odds and ends
This commit is contained in:
rmkaplan
2024-12-25 12:57:08 -08:00
committed by GitHub
parent f896885720
commit db33a50af3
12 changed files with 257 additions and 241 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
sources/FONT
View File

@@ -1,14 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Dec-2024 16:52:43" {WMEDLEY}<sources>FONT.;16 190016
(FILECREATED "19-Dec-2024 15:25:17" {WMEDLEY}<sources>FONT.;26 191458
:EDIT-BY rmk
:CHANGES-TO (VARS FONTCOMS)
(RECORDS FONTCLASS FONTDESCRIPTOR)
(FNS FONTCLASS.DEFPRINT)
:CHANGES-TO (FNS \FGETLEFTKERN)
(VARS FONTCOMS)
(FUNCTIONS \CREATEKERNELEMENT)
:PREVIOUS-DATE "14-Dec-2024 09:13:44" {WMEDLEY}<sources>FONT.;15)
:PREVIOUS-DATE "19-Dec-2024 11:52:01" {WMEDLEY}<sources>FONT.;18)
(PRETTYCOMPRINT FONTCOMS)
@@ -94,8 +94,9 @@
(MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH
\FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH \FGETIMAGEWIDTH \FSETIMAGEWIDTH
\GETCHARSETINFO \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR)
(FUNCTIONS \CREATEKERNELEMENT \FSETLEFTKERN \FGETLEFTKERN)
(FUNCTIONS \CREATEKERNELEMENT \FSETLEFTKERN)
(CONSTANTS (\MAXNSCHAR 65535]
(FNS \FGETLEFTKERN)
(COMS (* ; "NS Character specific code")
(FNS \CREATECHARSET \INSTALLCHARSETINFO)
(GLOBALVARS DISPLAYFONTCOERCIONS MISSINGDISPLAYFONTCOERCIONS
@@ -2870,7 +2871,7 @@
(/DECLAREDATATYPE 'FONTDESCRIPTOR
'(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
WORD POINTER POINTER POINTER)
WORD POINTER POINTER FLAG POINTER)
'((FONTDESCRIPTOR 0 POINTER)
(FONTDESCRIPTOR 2 POINTER)
(FONTDESCRIPTOR 4 POINTER)
@@ -2892,6 +2893,7 @@
(FONTDESCRIPTOR 27 (BITS . 15))
(FONTDESCRIPTOR 28 POINTER)
(FONTDESCRIPTOR 30 POINTER)
(FONTDESCRIPTOR 30 (FLAGBITS . 0))
(FONTDESCRIPTOR 32 POINTER))
'34)
@@ -2933,6 +2935,7 @@
(FONTAVGCHARWIDTH WORD)
(FONTIMAGEWIDTHS POINTER)
(FONTCHARSETVECTOR POINTER)
(FONTHASLEFTKERNS FLAG)
(FONTEXTRAFIELD2 POINTER)))
(DATATYPE CHARSETINFO (WIDTHS OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD)
@@ -3006,6 +3009,8 @@
 "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called")
(FONTIMAGEWIDTHS POINTER) (* ; "This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.")
(FONTCHARSETVECTOR POINTER) (* ; "A 256-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.")
(FONTHASLEFTKERNS FLAG) (* ;
 "T if at least one character set has an entry for left kerns")
(FONTEXTRAFIELD2 POINTER))
FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)
(INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))))
@@ -3065,7 +3070,7 @@
(/DECLAREDATATYPE 'FONTDESCRIPTOR
'(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
WORD POINTER POINTER POINTER)
WORD POINTER POINTER FLAG POINTER)
'((FONTDESCRIPTOR 0 POINTER)
(FONTDESCRIPTOR 2 POINTER)
(FONTDESCRIPTOR 4 POINTER)
@@ -3087,6 +3092,7 @@
(FONTDESCRIPTOR 27 (BITS . 15))
(FONTDESCRIPTOR 28 POINTER)
(FONTDESCRIPTOR 30 POINTER)
(FONTDESCRIPTOR 30 (FLAGBITS . 0))
(FONTDESCRIPTOR 32 POINTER))
'34)
@@ -3164,18 +3170,16 @@
T)))
)
(DEFMACRO \CREATEKERNELEMENT ()
`(CL:MAKE-ARRAY (IPLUS \MAXTHINCHAR 3)
:ELEMENT-TYPE
'(SIGNED-BYTE 16)
:INITIAL-ELEMENT 0))
(DEFMACRO \CREATEKERNELEMENT () (* ; "Edited 19-Dec-2024 12:20 by rmk")
`(PROGN (HELP "THIS IS BOGUS, SEE \FGETLEFTKERN")
(CL:MAKE-ARRAY (IPLUS \MAXTHINCHAR 3)
:ELEMENT-TYPE
'(SIGNED-BYTE 16)
:INITIAL-ELEMENT 0)))
(DEFMACRO \FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE)
`(CL:SETF (CL:AREF ,LEFTKERNBLOCK ,INDEX)
,KERNVALUE))
(DEFMACRO \FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE)
`(CL:AREF ,LEFTKERNBLOCK ,CHAR8CODE))
(DECLARE%: EVAL@COMPILE
(RPAQQ \MAXNSCHAR 65535)
@@ -3187,6 +3191,23 @@
(* "END EXPORTED DEFINITIONS")
)
(DEFINEQ
(\FGETLEFTKERN
[LAMBDA (FONT PREVCHARCODE CHARCODE) (* ; "Edited 19-Dec-2024 15:25 by rmk")
(* ;; "Returns the kern information for CHARCODE in FONT, given that it is an immediate successor of PREVCHARCODE. Returns 0 if no PREVCHARCODE/CHARCODE kerning is specified. For now, assume that the kerning information is sparse for characters within a character set, stored as a 2-level alist. ")
(* ;; "If the kerning information for a character is already a FIXP, then it is an offset no matter what the preceding character might be. This appears to be the way at least AC font files are set up.")
(OR [AND (fetch (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT)
(LET [(CHARKERNS (CDR (FASSOC (\GETCHARSETINFO (\CHARSET CHARCODE)
FONT T)
(\CHAR8CODE CHARCODE]
(OR (FIXP CHARKERNS)
(CDR (FASSOC PREVCHARCODE CHARKERNS]
0])
)
@@ -3359,31 +3380,31 @@
(ADDTOVAR LAMA FONTCOPY)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8729 18248 (CHARWIDTH 8739 . 9524) (CHARWIDTHY 9526 . 10896) (STRINGWIDTH 10898 . 11991
) (\CHARWIDTH.DISPLAY 11993 . 12406) (\STRINGWIDTH.DISPLAY 12408 . 12832) (\STRINGWIDTH.GENERIC 12834
. 18246)) (18249 24631 (DEFAULTFONT 18259 . 20092) (FONTCLASS 20094 . 22256) (FONTCLASSUNPARSE 22258
. 23157) (FONTCLASSCOMPONENT 23159 . 23668) (SETFONTCLASSCOMPONENT 23670 . 24629)) (25305 38037 (
FONTCREATE 25315 . 34582) (\FONT.SYMBOLMEMB 34584 . 34814) (\FONT.SYMBOLASSOC 34816 . 35974) (
\FONT.COMPARESYMBOL 35976 . 38035)) (38076 42700 (FONTASCENT 38086 . 38254) (FONTDESCENT 38256 . 38525
) (FONTHEIGHT 38527 . 38713) (FONTPROP 38715 . 42158) (\AVGCHARWIDTH 42160 . 42698)) (42747 55386 (
GETCHARBITMAP 42757 . 45647) (PUTCHARBITMAP 45649 . 53706) (MOVECHARBITMAP 53708 . 55384)) (55387
139926 (FONTCOPY 55397 . 60705) (FONTSAVAILABLE 60707 . 65912) (FONTFILEFORMAT 65914 . 67538) (FONTP
67540 . 67839) (FONTUNPARSE 67841 . 70405) (SETFONTDESCRIPTOR 70407 . 72116) (CHARCODEP 72118 . 72479)
(EDITCHAR 72481 . 72910) (\STREAMCHARWIDTH 72912 . 77076) (\UNITWIDTHSVECTOR 77078 . 77441) (
\CREATEDISPLAYFONT 77443 . 78196) (\CREATECHARSET.DISPLAY 78198 . 81114) (\CREATE-REAL-CHARSET.DISPLAY
81116 . 88020) (\BUILDSLUGCSINFO 88022 . 89465) (\SEARCHDISPLAYFONTFILES 89467 . 91400) (
\SEARCHFONTFILES 91402 . 94713) (\FINDFONTFILE 94715 . 95906) (\FONTSYMBOL 95908 . 96558) (
\DEVICESYMBOL 96560 . 97429) (\FONTFACE 97431 . 104621) (\FONTFACE.COLOR 104623 . 111543) (
\FONTFILENAME 111545 . 114960) (\FONTFILENAME.OLD 114962 . 117911) (\FONTFILENAME.NEW 117913 . 120170)
(\FONTINFOFROMFILENAME 120172 . 123286) (\FONTINFOFROMFILENAME.OLD 123288 . 125565) (\GETFONTDESC
125567 . 125958) (\COERCEFONTDESC 125960 . 131345) (\LOOKUPFONT 131347 . 132691) (\LOOKUPFONTSINCORE
132693 . 134766) (\READDISPLAYFONTFILE 134768 . 139924)) (140829 157553 (\READSTRIKEFONTFILE 140839 .
145041) (\SFMAKEBOLD 145043 . 147439) (\SFMAKEITALIC 147441 . 150344) (\SFMAKEROTATEDFONT 150346 .
151747) (\SFROTATECSINFO 151749 . 152386) (\SFROTATEFONTCHARACTERS 152388 . 152768) (
\SFFIXOFFSETSAFTERROTATION 152770 . 154909) (\SFROTATECSINFOOFFSETS 154911 . 156180) (\SFMAKECOLOR
156182 . 157551)) (157554 164807 (WRITESTRIKEFONTFILE 157564 . 161347) (STRIKECSINFO 161349 . 164805))
(164808 166647 (FONTDESCRIPTOR.DEFPRINT 164818 . 166169) (FONTCLASS.DEFPRINT 166171 . 166645)) (
181517 181680 (\CREATEKERNELEMENT 181517 . 181680)) (181682 181810 (\FSETLEFTKERN 181682 . 181810)) (
181812 181906 (\FGETLEFTKERN 181812 . 181906)) (182075 185585 (\CREATECHARSET 182085 . 183836) (
\INSTALLCHARSETINFO 183838 . 185583)) (186740 188492 (\FONTRESETCHARWIDTHS 186750 . 188490)))))
(FILEMAP (NIL (8734 18253 (CHARWIDTH 8744 . 9529) (CHARWIDTHY 9531 . 10901) (STRINGWIDTH 10903 . 11996
) (\CHARWIDTH.DISPLAY 11998 . 12411) (\STRINGWIDTH.DISPLAY 12413 . 12837) (\STRINGWIDTH.GENERIC 12839
. 18251)) (18254 24636 (DEFAULTFONT 18264 . 20097) (FONTCLASS 20099 . 22261) (FONTCLASSUNPARSE 22263
. 23162) (FONTCLASSCOMPONENT 23164 . 23673) (SETFONTCLASSCOMPONENT 23675 . 24634)) (25310 38042 (
FONTCREATE 25320 . 34587) (\FONT.SYMBOLMEMB 34589 . 34819) (\FONT.SYMBOLASSOC 34821 . 35979) (
\FONT.COMPARESYMBOL 35981 . 38040)) (38081 42705 (FONTASCENT 38091 . 38259) (FONTDESCENT 38261 . 38530
) (FONTHEIGHT 38532 . 38718) (FONTPROP 38720 . 42163) (\AVGCHARWIDTH 42165 . 42703)) (42752 55391 (
GETCHARBITMAP 42762 . 45652) (PUTCHARBITMAP 45654 . 53711) (MOVECHARBITMAP 53713 . 55389)) (55392
139931 (FONTCOPY 55402 . 60710) (FONTSAVAILABLE 60712 . 65917) (FONTFILEFORMAT 65919 . 67543) (FONTP
67545 . 67844) (FONTUNPARSE 67846 . 70410) (SETFONTDESCRIPTOR 70412 . 72121) (CHARCODEP 72123 . 72484)
(EDITCHAR 72486 . 72915) (\STREAMCHARWIDTH 72917 . 77081) (\UNITWIDTHSVECTOR 77083 . 77446) (
\CREATEDISPLAYFONT 77448 . 78201) (\CREATECHARSET.DISPLAY 78203 . 81119) (\CREATE-REAL-CHARSET.DISPLAY
81121 . 88025) (\BUILDSLUGCSINFO 88027 . 89470) (\SEARCHDISPLAYFONTFILES 89472 . 91405) (
\SEARCHFONTFILES 91407 . 94718) (\FINDFONTFILE 94720 . 95911) (\FONTSYMBOL 95913 . 96563) (
\DEVICESYMBOL 96565 . 97434) (\FONTFACE 97436 . 104626) (\FONTFACE.COLOR 104628 . 111548) (
\FONTFILENAME 111550 . 114965) (\FONTFILENAME.OLD 114967 . 117916) (\FONTFILENAME.NEW 117918 . 120175)
(\FONTINFOFROMFILENAME 120177 . 123291) (\FONTINFOFROMFILENAME.OLD 123293 . 125570) (\GETFONTDESC
125572 . 125963) (\COERCEFONTDESC 125965 . 131350) (\LOOKUPFONT 131352 . 132696) (\LOOKUPFONTSINCORE
132698 . 134771) (\READDISPLAYFONTFILE 134773 . 139929)) (140834 157558 (\READSTRIKEFONTFILE 140844 .
145046) (\SFMAKEBOLD 145048 . 147444) (\SFMAKEITALIC 147446 . 150349) (\SFMAKEROTATEDFONT 150351 .
151752) (\SFROTATECSINFO 151754 . 152391) (\SFROTATEFONTCHARACTERS 152393 . 152773) (
\SFFIXOFFSETSAFTERROTATION 152775 . 154914) (\SFROTATECSINFOOFFSETS 154916 . 156185) (\SFMAKECOLOR
156187 . 157556)) (157559 164812 (WRITESTRIKEFONTFILE 157569 . 161352) (STRIKECSINFO 161354 . 164810))
(164813 166652 (FONTDESCRIPTOR.DEFPRINT 164823 . 166174) (FONTCLASS.DEFPRINT 166176 . 166650)) (
181848 182170 (\CREATEKERNELEMENT 181848 . 182170)) (182172 182300 (\FSETLEFTKERN 182172 . 182300)) (
182426 183473 (\FGETLEFTKERN 182436 . 183471)) (183517 187027 (\CREATECHARSET 183527 . 185278) (
\INSTALLCHARSETINFO 185280 . 187025)) (188182 189934 (\FONTRESETCHARWIDTHS 188192 . 189932)))))
STOP

BIN
sources/FONT.LCOM
View File

Binary file not shown.