Rmk50: TERMINAL fonts plus fixed masterscope conflicts (#806)
* EDITFONT: CHARSET in interface * IDLEHAX, LIFE, TMAX-ENDNOTE: Clean up conflicts in making full masterscope DB * FONT: Add charset coercion for TERMINAL * TERMINAL fonts: Remove bogus character set files so that better coercions can take place
This commit is contained in:
rmkaplan
GitHub
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Feb-2022 13:53:05" {DSK}<home>larry>medley>lispusers>IDLEHAX.;3 26245
|
||||
(FILECREATED "26-Jun-2022 18:21:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;4 26796
|
||||
|
||||
:CHANGES-TO (FNS IDLE-DRAIN)
|
||||
(VARS IDLEHAXCOMS)
|
||||
:CHANGES-TO (FNS KAL.ADVANCE)
|
||||
|
||||
:PREVIOUS-DATE "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
:PREVIOUS-DATE " 9-Feb-2022 13:53:05"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -194,8 +195,17 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(KAL.ADVANCE
|
||||
(LAMBDA (STATE) (* lmm "30-Jul-85 20:16") (freplace A of STATE with (KAL.ORAND (ffetch A of STATE) (ffetch B of STATE))) (freplace PERIODCOUNT of STATE with (SUB1 (ffetch PERIODCOUNT of STATE))) (COND ((EQ (ffetch PERIODCOUNT of STATE) 0) (freplace B of STATE with (KAL.ORAND (ffetch B of STATE) (ffetch C of STATE))) (freplace PERIODCOUNT of STATE with (ffetch PERIOD of STATE)))))
|
||||
)
|
||||
[LAMBDA (STATE) (* ; "Edited 26-Jun-2022 18:20 by rmk")
|
||||
(* lmm "30-Jul-85 20:16")
|
||||
(freplace (KALSTATE A) of STATE with (KAL.ORAND (ffetch (KALSTATE A) of STATE)
|
||||
(ffetch (KALSTATE B) of STATE)))
|
||||
(freplace (KALSTATE PERIODCOUNT) of STATE with (SUB1 (ffetch (KALSTATE PERIODCOUNT) of STATE)))
|
||||
(COND
|
||||
((EQ (ffetch (KALSTATE PERIODCOUNT) of STATE)
|
||||
0)
|
||||
(freplace (KALSTATE B) of STATE with (KAL.ORAND (ffetch (KALSTATE B) of STATE)
|
||||
(ffetch (KALSTATE C) of STATE)))
|
||||
(freplace (KALSTATE PERIODCOUNT) of STATE with (ffetch (KALSTATE PERIOD) of STATE])
|
||||
|
||||
(KAL.SPOTS
|
||||
(LAMBDA (X Y WINDOWSIDE W BLACK XOFFSET) (* lmm " 3-Aug-85 21:59") (PROG ((X0 (LRSH X 7)) (Y0 (LRSH Y 7)) X1 Y1 C) (COND ((ILESSP X0 Y0) (SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE) X0)) (SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE) Y0)) (SETQ C (LOGAND X 1)) (KAL.BMS W X0 Y0 X1 Y1 (if BLACK then (DIFFERENCE 1 C) else C) XOFFSET)))))
|
||||
@@ -470,12 +480,12 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Swap" 'IDLE-SWAP))
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3794 7834 (POLYGONSDEMO 3804 . 3974) (POLYGONS 3976 . 4340) (CONNECTPOLYS 4342 . 6740)
|
||||
(DRAWPOLY1 6742 . 7379) (RANDOMPT 7381 . 7832)) (8471 11453 (KALDEMO 8481 . 9892) (KAL.ADVANCE 9894 .
|
||||
10295) (KAL.SPOTS 10297 . 10638) (KAL.BMS 10640 . 11127) (KAL.ORAND 11129 . 11451)) (11490 12976 (
|
||||
BUBBLES 11500 . 12606) (BUBBLE.CREATE 12608 . 12974)) (13003 13988 (IDLE-WINDOWS 13013 . 13986)) (
|
||||
14023 16294 (LINES 14033 . 15092) (LINES1 15094 . 15504) (LINES2 15506 . 15817) (LINES3 15819 . 16292)
|
||||
) (16354 17567 (WALKINGSPOKE 16364 . 17145) (WARP 17147 . 17565)) (17592 21875 (IDLE-MELT 17602 .
|
||||
20118) (IDLE-SLIDE 20120 . 21873)) (22046 22292 (DEMOWINDOW 22056 . 22290)) (22704 24577 (IDLE-DRAIN
|
||||
22714 . 24575)) (24609 26090 (IDLE-SWAP 24619 . 26088)))))
|
||||
(FILEMAP (NIL (3812 7852 (POLYGONSDEMO 3822 . 3992) (POLYGONS 3994 . 4358) (CONNECTPOLYS 4360 . 6758)
|
||||
(DRAWPOLY1 6760 . 7397) (RANDOMPT 7399 . 7850)) (8489 12004 (KALDEMO 8499 . 9910) (KAL.ADVANCE 9912 .
|
||||
10846) (KAL.SPOTS 10848 . 11189) (KAL.BMS 11191 . 11678) (KAL.ORAND 11680 . 12002)) (12041 13527 (
|
||||
BUBBLES 12051 . 13157) (BUBBLE.CREATE 13159 . 13525)) (13554 14539 (IDLE-WINDOWS 13564 . 14537)) (
|
||||
14574 16845 (LINES 14584 . 15643) (LINES1 15645 . 16055) (LINES2 16057 . 16368) (LINES3 16370 . 16843)
|
||||
) (16905 18118 (WALKINGSPOKE 16915 . 17696) (WARP 17698 . 18116)) (18143 22426 (IDLE-MELT 18153 .
|
||||
20669) (IDLE-SLIDE 20671 . 22424)) (22597 22843 (DEMOWINDOW 22607 . 22841)) (23255 25128 (IDLE-DRAIN
|
||||
23265 . 25126)) (25160 26641 (IDLE-SWAP 25170 . 26639)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
105
lispusers/LIFE
105
lispusers/LIFE
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Dec-2021 15:21:48" |{DSK}<home>medley>medley>lispusers>LIFE.;3| 9875
|
||||
(FILECREATED "26-Jun-2022 18:34:22"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>LIFE.;3| 10394
|
||||
|
||||
|changes| |to:| (VARS LIFECOMS)
|
||||
(FNS EXPAND.BITMAP.VERTICALLY)
|
||||
:CHANGES-TO (FNS EXPAND.BITMAP.VERTICALLY EXPAND.BITMAP.HORIZONTALLY)
|
||||
|
||||
|previous| |date:| "20-Aug-88 12:18:43" |{DSK}<home>medley>medley>lispusers>LIFE.;1|)
|
||||
:PREVIOUS-DATE " 6-Dec-2021 15:21:48"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>LIFE.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1987-1988 by Xerox Corporation.
|
||||
@@ -43,7 +44,7 @@
|
||||
PBT TEMP)
|
||||
(|if| (NEQ N 1)
|
||||
|then| (SETQ TEMP (BITMAPCREATE (IQUOTIENT W N)
|
||||
H))
|
||||
H))
|
||||
(SETQ PBT (|create| PILOTBBT))
|
||||
(BITBLT WIN 0 0 TEMP 0 0)
|
||||
(EXPAND.BITMAP.HORIZONTALLY TEMP N A PBT)
|
||||
@@ -63,13 +64,13 @@
|
||||
(SHUFFLE (INHI LO HORIZ?)
|
||||
`(PROGN ,@(|if| HORIZ?
|
||||
|then| `((BITBLTBITMAP ,INHI N 0 ,LO 0 0 W1 H)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO W1 0 N H)
|
||||
(BITBLTBITMAP ,INHI 0 0 C N 0 W1 H)
|
||||
(BITBLTBITMAP ,INHI W1 0 C 0 0 N H))
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO W1 0 N H)
|
||||
(BITBLTBITMAP ,INHI 0 0 C N 0 W1 H)
|
||||
(BITBLTBITMAP ,INHI W1 0 C 0 0 N H))
|
||||
|else| `((BITBLTBITMAP ,INHI 0 1 ,LO 0 0 W H1)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO 0 H1 W 1)
|
||||
(BITBLTBITMAP ,INHI 0 0 C 0 1 W H1)
|
||||
(BITBLTBITMAP ,INHI 0 H1 C 0 0 W 1)))
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO 0 H1 W 1)
|
||||
(BITBLTBITMAP ,INHI 0 0 C 0 1 W H1)
|
||||
(BITBLTBITMAP ,INHI 0 H1 C 0 0 W 1)))
|
||||
(BITBLTBITMAP C 0 0 ,LO 0 0 W H 'INPUT 'INVERT)
|
||||
(BITBLTBITMAP ,LO 0 0 C 0 0 W H 'INPUT 'ERASE)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO 0 0 W H 'INPUT 'INVERT)
|
||||
@@ -103,22 +104,26 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EXPAND.BITMAP.VERTICALLY
|
||||
(LAMBDA (BITMAP M BM2 PBT) (* \;
|
||||
"Edited 6-Dec-2021 15:04 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 14:47 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:54 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:51 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:11 by medley")
|
||||
(* \;
|
||||
"Edited 6-Mar-87 15:02 by Masinter")
|
||||
(LAMBDA (BITMAP M BM2 PBT)
|
||||
|
||||
(* |;;| "Edited 26-Jun-2022 18:29 by rmk: Change (add ... to (SETQ xx (PLUS xxx ..)) because \"with\" gets confused")
|
||||
|
||||
(* |;;| "Edited 6-Dec-2021 15:04 by medley")
|
||||
|
||||
(* |;;| "Edited 6-Dec-2021 14:47 by medley")
|
||||
|
||||
(* |;;| "Edited 6-Dec-2021 13:54 by medley")
|
||||
|
||||
(* |;;| "Edited 6-Dec-2021 13:51 by medley")
|
||||
|
||||
(* |;;| "Edited 6-Dec-2021 13:11 by medley")
|
||||
|
||||
(* |;;| "Edited 6-Mar-87 15:02 by Masinter")
|
||||
|
||||
(OR BM2 (SETQ BM2 (BITMAPCREATE (|fetch| BITMAPWIDTH BITMAP)
|
||||
(TIMES M (|fetch| BITMAPHEIGHT BITMAP)))))
|
||||
(OR PBT (SETQ PBT (|create| PILOTBBT)))
|
||||
(|with| PILOTBBT PBT (*)
|
||||
(|with| PILOTBBT PBT (*)
|
||||
(SETQ PBTDESTHI (|ffetch| |BitMapHiLoc| BM2))
|
||||
(SETQ PBTDESTLO (|ffetch| |BitMapLoLoc| BM2))
|
||||
(SETQ PBTSOURCEHI (|ffetch| |BitMapHiLoc| BITMAP))
|
||||
@@ -130,15 +135,49 @@
|
||||
(SETQ PBTFLAGS 16384)
|
||||
(SETQ PBTHEIGHT (|fetch| BITMAPHEIGHT BITMAP))
|
||||
(SETQ PBTWIDTH (|fetch| BITMAPWIDTH BITMAP))
|
||||
(|for| I |from| 1 |to| M |do| (\\PILOTBITBLT PBT 0)
|
||||
(|add| PBTDESTLO (|fetch|
|
||||
BITMAPRASTERWIDTH
|
||||
|of| BM2))))
|
||||
(|for| I |from| 1 |to| M |do| (\\PILOTBITBLT PBT 0)
|
||||
(* \;
|
||||
"RMK: Can't use add here, expansion setf expansion gets confused")
|
||||
(SETQ PBTDESTLO (PLUS PBTDESTLO (|fetch| BITMAPRASTERWIDTH
|
||||
|of| BM2)))
|
||||
\n))
|
||||
BM2))
|
||||
|
||||
(expand.bitmap.horizontally
|
||||
(lambda (bitmap n bm2 pbt) (* \; "Edited 6-Mar-87 17:08 by Masinter") (or bm2 (setq bm2 (bitmapcreate (times n (|fetch| bitmapwidth bitmap)) (|fetch| bitmapheight bitmap)))) (or pbt (setq pbt (|create| pilotbbt))) (let ((sourcebase (|fetch| bitmapbase bitmap)) (destbase (|fetch| bitmapbase bm2))) (|with| pilotbbt pbt (setq pbtdestbpl n) (setq pbtsourcebpl 1) (setq pbtsourcebit 0) (setq pbtflags 16384) (setq pbtwidth 1) (let ((ht (times (|fetch| bitmapwidth bitmap) (|fetch| bitmapheight bitmap)))) (|do| (setq pbtdest destbase) (setq pbtsource sourcebase) (setq pbtheight (min (times 1024 16) ht)) (setq pbtdestbit 0) (|for| i |from| 0 |while| (lessp i n) |do| (\\pilotbitblt pbt 0) (|add| pbtdestbit 1)) (setq ht (- ht (times 1024 16))) (|if| (leq ht 0) |then| (return)) (setq destbase (\\addbase destbase (times n 1024))) (setq sourcebase (\\addbase sourcebase 1024)))))) bm2)
|
||||
)
|
||||
(EXPAND.BITMAP.HORIZONTALLY
|
||||
(LAMBDA (BITMAP N BM2 PBT)
|
||||
|
||||
(* |;;| "Edited 26-Jun-2022 18:34 by rmk: ADD doesn't expand properly under WITH, at least masterscope complains. So expanded it here")
|
||||
|
||||
(* |;;| "Edited 26-Jun-2022 18:30 by rmk")
|
||||
|
||||
(* |;;| "Edited 6-Mar-87 17:08 by Masinter")
|
||||
|
||||
(OR BM2 (SETQ BM2 (BITMAPCREATE (TIMES N (|fetch| BITMAPWIDTH BITMAP))
|
||||
(|fetch| BITMAPHEIGHT BITMAP))))
|
||||
(OR PBT (SETQ PBT (|create| PILOTBBT)))
|
||||
(LET ((SOURCEBASE (|fetch| BITMAPBASE BITMAP))
|
||||
(DESTBASE (|fetch| BITMAPBASE BM2)))
|
||||
(|with| PILOTBBT PBT (SETQ PBTDESTBPL N)
|
||||
(SETQ PBTSOURCEBPL 1)
|
||||
(SETQ PBTSOURCEBIT 0)
|
||||
(SETQ PBTFLAGS 16384)
|
||||
(SETQ PBTWIDTH 1)
|
||||
(LET ((HT (TIMES (|fetch| BITMAPWIDTH BITMAP)
|
||||
(|fetch| BITMAPHEIGHT BITMAP))))
|
||||
(|do| (SETQ PBTDEST DESTBASE)
|
||||
(SETQ PBTSOURCE SOURCEBASE)
|
||||
(SETQ PBTHEIGHT (MIN (TIMES 1024 16)
|
||||
HT))
|
||||
(SETQ PBTDESTBIT 0)
|
||||
(|for| I |from| 0 |while| (LESSP I N) |do| (\\PILOTBITBLT PBT 0)
|
||||
(SETQ PBTDESTBIT
|
||||
(PLUS PBTDESTBIT 1)))
|
||||
(SETQ HT (- HT (TIMES 1024 16)))
|
||||
(|if| (LEQ HT 0)
|
||||
|then| (RETURN))
|
||||
(SETQ DESTBASE (\\ADDBASE DESTBASE (TIMES N 1024)))
|
||||
(SETQ SOURCEBASE (\\ADDBASE SOURCEBASE 1024))))))
|
||||
BM2))
|
||||
)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS
|
||||
@@ -151,6 +190,6 @@
|
||||
(|LifeIdle| \w 8))))))
|
||||
(PUTPROPS LIFE COPYRIGHT ("Xerox Corporation" 1987 1988))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1557 5825 (|Life| 1557 . 5825)) (5827 5955 (|LifeIdle| 5827 . 5955)) (5956 9223 (
|
||||
EXPAND.BITMAP.VERTICALLY 5966 . 8302) (EXPAND.BITMAP.HORIZONTALLY 8304 . 9221)))))
|
||||
(FILEMAP (NIL (1590 5830 (|Life| 1590 . 5830)) (5832 5960 (|LifeIdle| 5832 . 5960)) (5961 9742 (
|
||||
EXPAND.BITMAP.VERTICALLY 5971 . 7898) (EXPAND.BITMAP.HORIZONTALLY 7900 . 9740)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "18-Mar-2022 07:12:34"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;4| 23444
|
||||
(FILECREATED "26-Jun-2022 18:15:33"
|
||||
|{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>TMAX>TMAX-ENDNOTE.;3| 23863
|
||||
|
||||
:CHANGES-TO (VARS TMAX-ENDNOTECOMS)
|
||||
:CHANGES-TO (FNS REGMARK.PUTFN REGMARK.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "17-Mar-2022 23:10:26"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-ENDNOTE.;2|)
|
||||
:PREVIOUS-DATE "18-Mar-2022 07:12:34"
|
||||
|{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>TMAX>TMAX-ENDNOTE.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1987 by Xerox Corporation.
|
||||
@@ -381,11 +381,12 @@
|
||||
ydesc _ 0
|
||||
xkern _ 0)))
|
||||
|
||||
(regmark.putfn
|
||||
(lambda (markobj stream) (* |fsg| "23-Jul-87 14:02")
|
||||
(prin2 (list '|Region| (|fetch| region.use |of| (|fetch| objectdatum |of| markobj))
|
||||
(|fetch| marking |of| (|fetch| objectdatum |of| markobj)))
|
||||
stream)))
|
||||
(REGMARK.PUTFN
|
||||
(LAMBDA (MARKOBJ STREAM) (* \; "Edited 26-Jun-2022 18:12 by rmk")
|
||||
(* |fsg| "23-Jul-87 14:02")
|
||||
(PRIN2 (LIST '|Region| (|fetch| (REGMARKOBJ REGION.USE) |of| (|fetch| OBJECTDATUM |of| MARKOBJ))
|
||||
(|fetch| (REGMARKOBJ MARKING) |of| (|fetch| OBJECTDATUM |of| MARKOBJ)))
|
||||
STREAM)))
|
||||
|
||||
(regmark.getfn
|
||||
(lambda (stream copy.object) (* |fsg| "20-Aug-87 14:58")
|
||||
@@ -405,22 +406,25 @@
|
||||
(|fetch| objectdatum |of| image.obj))))
|
||||
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
|
||||
|
||||
(regmark.buttoneventinfn
|
||||
(lambda (markobj stream) (* |fsg| "18-Feb-87 10:07")
|
||||
(* * |This| |function| |is| |never| |called| |because| |the| regmark
|
||||
|ImageObjects| |are| |protected| |after| |they| |are| |inserted| |and|
|
||||
|anything| |protected| |can't| |be| |selected.|)
|
||||
(REGMARK.BUTTONEVENTINFN
|
||||
(LAMBDA (MARKOBJ STREAM) (* \; "Edited 26-Jun-2022 18:13 by rmk")
|
||||
(* |fsg| "18-Feb-87 10:07")
|
||||
|
||||
(and (mousestate middle)
|
||||
(let ((markdatum (|fetch| objectdatum |of| markobj)))
|
||||
(tedit.promptprint stream (concat "Region used for " (|fetch| region.use |of| markdatum
|
||||
)
|
||||
(cond
|
||||
((|fetch| marking |of| markdatum)
|
||||
(concat ", Marker is " (|fetch| marking
|
||||
|of| markdatum)))
|
||||
(t "")))
|
||||
t)))))
|
||||
(* * |This| |function| |is| |never| |called| |because| |the| REGMARK
|
||||
|ImageObjects| |are| |protected| |after| |they| |are| |inserted| |and| |anything|
|
||||
|protected| |can't| |be| |selected.|)
|
||||
|
||||
(AND (MOUSESTATE MIDDLE)
|
||||
(LET ((MARKDATUM (|fetch| OBJECTDATUM |of| MARKOBJ)))
|
||||
(TEDIT.PROMPTPRINT STREAM (CONCAT "Region used for " (|fetch| (REGMARKOBJ REGION.USE)
|
||||
|of| MARKDATUM)
|
||||
(COND
|
||||
((|fetch| (REGMARKOBJ MARKING) |of| MARKDATUM)
|
||||
(CONCAT ", Marker is " (|fetch| (REGMARKOBJ
|
||||
MARKING)
|
||||
|of| MARKDATUM)))
|
||||
(T "")))
|
||||
T)))))
|
||||
)
|
||||
|
||||
(RPAQ? \\REGMARKOBJ.IMAGEFNS
|
||||
@@ -445,13 +449,13 @@
|
||||
)
|
||||
(PUTPROPS TMAX-ENDNOTE COPYRIGHT ("Xerox Corporation" 1987))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (2489 12116 (ADD.ENDNOTE 2499 . 3167) (INSERT.ENDNOTES 3169 . 5372) (
|
||||
INSERT.ENDNOTES.TEXT 5374 . 6803) (DELETE.ENDNOTES 6805 . 7796) (NOTESREGIONP 7798 . 8060) (
|
||||
SET.ENDNOTE.STYLE 8062 . 10735) (MAP.ENDNOTE.LOOKS 10737 . 11504) (GET.ENDNOTE.FONTS 11506 . 12114)) (
|
||||
12117 16032 (ENDNOTEP 12127 . 12468) (NOTE.PUTFN 12470 . 13122) (NOTE.GETFN 13124 . 13704) (
|
||||
NOTE.BUTTONEVENTINFN 13706 . 14486) (NOTE.WHENSELECTEDFN 14488 . 16030)) (16790 19194 (AUX.TEDIT 16800
|
||||
. 17762) (AUX.TEDIT.AFTERQUITFN 17764 . 18207) (AUX.TEDIT.TITLEMENUFN 18209 . 19192)) (19279 22743 (
|
||||
REGMARKOBJ 19289 . 19696) (REGMARKOBJP 19698 . 19892) (REGMARK.DISPLAYFN 19894 . 20140) (
|
||||
REGMARK.IMAGEBOXFN 20142 . 20493) (REGMARK.PUTFN 20495 . 20827) (REGMARK.GETFN 20829 . 21128) (
|
||||
REGMARK.COPYFN 21130 . 21668) (REGMARK.BUTTONEVENTINFN 21670 . 22741)))))
|
||||
(FILEMAP (NIL (2529 12156 (ADD.ENDNOTE 2539 . 3207) (INSERT.ENDNOTES 3209 . 5412) (
|
||||
INSERT.ENDNOTES.TEXT 5414 . 6843) (DELETE.ENDNOTES 6845 . 7836) (NOTESREGIONP 7838 . 8100) (
|
||||
SET.ENDNOTE.STYLE 8102 . 10775) (MAP.ENDNOTE.LOOKS 10777 . 11544) (GET.ENDNOTE.FONTS 11546 . 12154)) (
|
||||
12157 16072 (ENDNOTEP 12167 . 12508) (NOTE.PUTFN 12510 . 13162) (NOTE.GETFN 13164 . 13744) (
|
||||
NOTE.BUTTONEVENTINFN 13746 . 14526) (NOTE.WHENSELECTEDFN 14528 . 16070)) (16830 19234 (AUX.TEDIT 16840
|
||||
. 17802) (AUX.TEDIT.AFTERQUITFN 17804 . 18247) (AUX.TEDIT.TITLEMENUFN 18249 . 19232)) (19319 23162 (
|
||||
REGMARKOBJ 19329 . 19736) (REGMARKOBJP 19738 . 19932) (REGMARK.DISPLAYFN 19934 . 20180) (
|
||||
REGMARK.IMAGEBOXFN 20182 . 20533) (REGMARK.PUTFN 20535 . 21006) (REGMARK.GETFN 21008 . 21307) (
|
||||
REGMARK.COPYFN 21309 . 21847) (REGMARK.BUTTONEVENTINFN 21849 . 23160)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
433
sources/FONT
433
sources/FONT
@@ -1,14 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 9-Feb-2021 11:39:44" {DSK}<home>larry>ilisp>medley>sources>FONT.;7 189150
|
||||
|
||||
changes to%: (VARS FONTCOMS)
|
||||
(FILECREATED "26-Jun-2022 13:00:17" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FONT.;2 188234
|
||||
|
||||
previous date%: "28-Jun-99 16:29:49" {DSK}<home>larry>ilisp>medley>sources>FONT.;6)
|
||||
:CHANGES-TO (VARS FONTCOMS)
|
||||
(FNS \CREATE-REAL-CHARSET.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE " 9-Feb-2021 11:39:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FONT.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1999,
|
||||
2021 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1994, 1999, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -21,7 +23,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
\STRINGWIDTH.GENERIC)
|
||||
(FNS DEFAULTFONT FONTCLASS FONTCLASSUNPARSE FONTCLASSCOMPONENT SETFONTCLASSCOMPONENT)
|
||||
[COMS (* ;
|
||||
"Until we pin down the exact interface")
|
||||
"Until we pin down the exact interface")
|
||||
(P (MOVD 'FONTCLASSCOMPONENT 'FONTCOMPONENT)
|
||||
(MOVD 'SETFONTCLASSCOMPONENT 'SETFONTCOMPONENT]
|
||||
[COMS (* ; "MAPPING FOR DOS FILENAMES ")
|
||||
@@ -123,6 +125,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
((TIMESROMAN)
|
||||
(CLASSIC))
|
||||
((HELVETICA)
|
||||
(MODERN))
|
||||
((TERMINAL)
|
||||
(MODERN]
|
||||
(CHARSETERRORFLG NIL)
|
||||
(\DEFAULTCHARSET 0)))
|
||||
@@ -1409,12 +1413,13 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
|
||||
(\CREATE-REAL-CHARSET.DISPLAY
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?)
|
||||
(* ; "Edited 26-Jun-2022 12:37 by rmk")
|
||||
(* ; "Edited 15-Jan-88 00:02 by FS")
|
||||
(COND
|
||||
[(AND (EQ ROTATION 0)
|
||||
(PROG1 (\READDISPLAYFONTFILE FAMILY SIZE FACE ROTATION 'DISPLAY CHARSET)
|
||||
(* ;
|
||||
"If it is available, this will force the appropriate file to be read to fill in the charset entry")
|
||||
"If it is available, this will force the appropriate file to be read to fill in the charset entry")
|
||||
]
|
||||
(T
|
||||
(* ;; "if we get here, the font is not directly available, either it needs to be rotated, boldified, or italicised 'by hand'. Past that point, we do not allow DISPLAYFONTCOERCIONS, only MISSINGxxxxDISPLAYFONTCOERCIONS.")
|
||||
@@ -1428,8 +1433,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(OR (MEMB ROTATION '(90 270))
|
||||
(ERROR "only implemented rotations are 0, 90 and 270." ROTATION))
|
||||
(COND
|
||||
((SETQ XFONT (\CREATEDISPLAYFONT FAMILY SIZE FACE 0 'DISPLAY
|
||||
CHARSET))
|
||||
((SETQ XFONT (\CREATEDISPLAYFONT FAMILY SIZE FACE 0 'DISPLAY CHARSET))
|
||||
|
||||
(* ;; "Do not call FONTCREATE here. The user might have modified (via PUTCHARBITMAP, etc.) the in-memory version of the source. This also fixes a bug in which several font descriptors ended up sharing bitmaps or charsetvectors, causing havoc when the user modifies either fontdescriptor.")
|
||||
|
||||
@@ -1439,8 +1443,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
((AND (EQ (fetch WEIGHT of FACE)
|
||||
'BOLD)
|
||||
(SETQ XFONT (\CREATEDISPLAYFONT FAMILY SIZE
|
||||
(create FONTFACE using FACE WEIGHT _
|
||||
'MEDIUM)
|
||||
(create FONTFACE using FACE WEIGHT _ 'MEDIUM)
|
||||
0
|
||||
'DISPLAY CHARSET)))
|
||||
|
||||
@@ -1452,55 +1455,51 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
((AND (EQ (fetch (FONTFACE SLOPE) of FACE)
|
||||
'ITALIC)
|
||||
(SETQ XFONT (\CREATEDISPLAYFONT FAMILY SIZE
|
||||
(create FONTFACE using FACE SLOPE _
|
||||
'REGULAR)
|
||||
(create FONTFACE using FACE SLOPE _ 'REGULAR)
|
||||
0
|
||||
'DISPLAY CHARSET)))
|
||||
(if (SETQ CSINFO (\GETCHARSETINFO CHARSET XFONT T))
|
||||
then (\SFMAKEITALIC CSINFO)
|
||||
else NIL))
|
||||
[(AND CHARSET (NOT (EQL 0))
|
||||
[(AND CHARSET (NOT (EQL CHARSET 0))
|
||||
(for TRANSL in MISSINGCHARSETDISPLAYFONTCOERCIONS
|
||||
bind NEWCSINFO UFONT REALFONT
|
||||
when (AND (SETQ UFONT (CAR TRANSL))
|
||||
(EQ FAMILY (CAR UFONT))
|
||||
(OR (NOT (CADR UFONT))
|
||||
(EQ SIZE (CADR UFONT)))
|
||||
(OR (NOT (CADDR UFONT))
|
||||
(EQ CHARSET (CADDR UFONT)))
|
||||
(SETQ REALFONT (CADR TRANSL))
|
||||
(SETQ NEWCSINFO (\CREATE-REAL-CHARSET.DISPLAY
|
||||
(OR (CAR REALFONT)
|
||||
FAMILY)
|
||||
(OR (CADR REALFONT)
|
||||
SIZE)
|
||||
FACE ROTATION DEVICE
|
||||
(OR (CADDR REALFONT)
|
||||
CHARSET)
|
||||
FONTDESC NOSLUG?)))
|
||||
(EQ FAMILY (CAR UFONT))
|
||||
(OR (NOT (CADR UFONT))
|
||||
(EQ SIZE (CADR UFONT)))
|
||||
(OR (NOT (CADDR UFONT))
|
||||
(EQ CHARSET (CADDR UFONT)))
|
||||
(SETQ REALFONT (CADR TRANSL))
|
||||
(SETQ NEWCSINFO (\CREATE-REAL-CHARSET.DISPLAY
|
||||
(OR (CAR REALFONT)
|
||||
FAMILY)
|
||||
(OR (CADR REALFONT)
|
||||
SIZE)
|
||||
FACE ROTATION DEVICE
|
||||
(OR (CADDR REALFONT)
|
||||
CHARSET)
|
||||
FONTDESC NOSLUG?)))
|
||||
do (RETURN NEWCSINFO]
|
||||
((for TRANSL in MISSINGDISPLAYFONTCOERCIONS bind NEWCSINFO
|
||||
UFONT REALFONT
|
||||
((for TRANSL in MISSINGDISPLAYFONTCOERCIONS bind NEWCSINFO UFONT REALFONT
|
||||
when (AND (SETQ UFONT (CAR TRANSL))
|
||||
(EQ FAMILY (CAR UFONT))
|
||||
(OR (NOT (CADR UFONT))
|
||||
(EQ SIZE (CADR UFONT)))
|
||||
(OR (NOT (CADDR UFONT))
|
||||
(EQ CHARSET (CADDR UFONT)))
|
||||
(SETQ REALFONT (CADR TRANSL))
|
||||
(SETQ NEWCSINFO (\CREATE-REAL-CHARSET.DISPLAY
|
||||
(OR (CAR REALFONT)
|
||||
FAMILY)
|
||||
(OR (CADR REALFONT)
|
||||
SIZE)
|
||||
FACE ROTATION DEVICE
|
||||
(OR (CADDR REALFONT)
|
||||
CHARSET)
|
||||
FONTDESC NOSLUG?)))
|
||||
(EQ FAMILY (CAR UFONT))
|
||||
(OR (NOT (CADR UFONT))
|
||||
(EQ SIZE (CADR UFONT)))
|
||||
(OR (NOT (CADDR UFONT))
|
||||
(EQ CHARSET (CADDR UFONT)))
|
||||
(SETQ REALFONT (CADR TRANSL))
|
||||
(SETQ NEWCSINFO (\CREATE-REAL-CHARSET.DISPLAY
|
||||
(OR (CAR REALFONT)
|
||||
FAMILY)
|
||||
(OR (CADR REALFONT)
|
||||
SIZE)
|
||||
FACE ROTATION DEVICE (OR (CADDR REALFONT)
|
||||
CHARSET)
|
||||
FONTDESC NOSLUG?)))
|
||||
do (RETURN NEWCSINFO)))
|
||||
((NOT NOSLUG?)
|
||||
(\BUILDSLUGCSINFO (fetch (FONTDESCRIPTOR FONTAVGCHARWIDTH)
|
||||
of FONTDESC)
|
||||
(\BUILDSLUGCSINFO (fetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FONTDESC)
|
||||
(FONTPROP FONTDESC 'ASCENT)
|
||||
(FONTPROP FONTDESC 'DESCENT)
|
||||
(FONTPROP FONTDESC 'DEVICE])
|
||||
@@ -2918,34 +2917,34 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE)
|
||||
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
|
||||
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
|
||||
|
||||
(DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER)
|
||||
(FONTFAMILY POINTER)
|
||||
(FONTSIZE POINTER)
|
||||
(FONTFACE POINTER)
|
||||
(\SFAscent WORD)
|
||||
(\SFDescent WORD)
|
||||
(\SFHeight WORD)
|
||||
(ROTATION WORD)
|
||||
(FBBOX SIGNEDWORD)
|
||||
(FBBOY SIGNEDWORD)
|
||||
(FBBDX SIGNEDWORD)
|
||||
(FBBDY SIGNEDWORD)
|
||||
(\SFLKerns POINTER)
|
||||
(\SFRWidths POINTER)
|
||||
(FONTDEVICESPEC POINTER)
|
||||
(OTHERDEVICEFONTPROPS POINTER)
|
||||
(FONTSCALE POINTER)
|
||||
(\SFFACECODE BITS 8)
|
||||
(FONTAVGCHARWIDTH WORD)
|
||||
(FONTIMAGEWIDTHS POINTER)
|
||||
(FONTCHARSETVECTOR POINTER)
|
||||
(FONTEXTRAFIELD2 POINTER)))
|
||||
(FONTFAMILY POINTER)
|
||||
(FONTSIZE POINTER)
|
||||
(FONTFACE POINTER)
|
||||
(\SFAscent WORD)
|
||||
(\SFDescent WORD)
|
||||
(\SFHeight WORD)
|
||||
(ROTATION WORD)
|
||||
(FBBOX SIGNEDWORD)
|
||||
(FBBOY SIGNEDWORD)
|
||||
(FBBDX SIGNEDWORD)
|
||||
(FBBDY SIGNEDWORD)
|
||||
(\SFLKerns POINTER)
|
||||
(\SFRWidths POINTER)
|
||||
(FONTDEVICESPEC POINTER)
|
||||
(OTHERDEVICEFONTPROPS POINTER)
|
||||
(FONTSCALE POINTER)
|
||||
(\SFFACECODE BITS 8)
|
||||
(FONTAVGCHARWIDTH WORD)
|
||||
(FONTIMAGEWIDTHS POINTER)
|
||||
(FONTCHARSETVECTOR POINTER)
|
||||
(FONTEXTRAFIELD2 POINTER)))
|
||||
|
||||
(DATATYPE CHARSETINFO (WIDTHS OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD)
|
||||
(CHARSETDESCENT WORD)
|
||||
LEFTKERN))
|
||||
(CHARSETDESCENT WORD)
|
||||
LEFTKERN))
|
||||
)
|
||||
|
||||
(RPAQ? \FONTSINCORE )
|
||||
@@ -2970,13 +2969,13 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
)
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
(DEFOPTIMIZER FONTPROP (&REST ARGS)
|
||||
(SELECTQ (AND (EQ (CAADR ARGS)
|
||||
'QUOTE)
|
||||
(CADADR ARGS))
|
||||
(ASCENT (LIST 'FONTASCENT (CAR ARGS)))
|
||||
(DESCENT (LIST 'FONTDESCENT (CAR ARGS)))
|
||||
(HEIGHT (LIST 'FONTHEIGHT (CAR ARGS)))
|
||||
'IGNOREMACRO))
|
||||
(SELECTQ (AND (EQ (CAADR ARGS)
|
||||
'QUOTE)
|
||||
(CADADR ARGS))
|
||||
(ASCENT (LIST 'FONTASCENT (CAR ARGS)))
|
||||
(DESCENT (LIST 'FONTDESCENT (CAR ARGS)))
|
||||
(HEIGHT (LIST 'FONTHEIGHT (CAR ARGS)))
|
||||
'IGNOREMACRO))
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -2984,74 +2983,74 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE)
|
||||
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
|
||||
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
|
||||
|
||||
(DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER)
|
||||
(FONTFAMILY POINTER)
|
||||
(FONTSIZE POINTER)
|
||||
(FONTFACE POINTER)
|
||||
(\SFAscent WORD)
|
||||
(\SFDescent WORD)
|
||||
(\SFHeight WORD)
|
||||
(ROTATION WORD)
|
||||
(FBBOX SIGNEDWORD)
|
||||
(FBBOY SIGNEDWORD)
|
||||
(FBBDX SIGNEDWORD)
|
||||
(FBBDY SIGNEDWORD)
|
||||
(\SFLKerns POINTER)
|
||||
(\SFRWidths POINTER)
|
||||
(FONTDEVICESPEC POINTER) (* ;
|
||||
"Holds the spec by which the font is known to the printing device, if coercion has been done")
|
||||
(OTHERDEVICEFONTPROPS POINTER) (* ;
|
||||
"For individual devices to hang special information")
|
||||
(FONTSCALE POINTER)
|
||||
(\SFFACECODE BITS 8)
|
||||
(FONTAVGCHARWIDTH WORD) (* ;
|
||||
"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.")
|
||||
(FONTEXTRAFIELD2 POINTER))
|
||||
FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR))
|
||||
(FONTFAMILY POINTER)
|
||||
(FONTSIZE POINTER)
|
||||
(FONTFACE POINTER)
|
||||
(\SFAscent WORD)
|
||||
(\SFDescent WORD)
|
||||
(\SFHeight WORD)
|
||||
(ROTATION WORD)
|
||||
(FBBOX SIGNEDWORD)
|
||||
(FBBOY SIGNEDWORD)
|
||||
(FBBDX SIGNEDWORD)
|
||||
(FBBDY SIGNEDWORD)
|
||||
(\SFLKerns POINTER)
|
||||
(\SFRWidths POINTER)
|
||||
(FONTDEVICESPEC POINTER) (* ;
|
||||
"Holds the spec by which the font is known to the printing device, if coercion has been done")
|
||||
(OTHERDEVICEFONTPROPS POINTER) (* ;
|
||||
"For individual devices to hang special information")
|
||||
(FONTSCALE POINTER)
|
||||
(\SFFACECODE BITS 8)
|
||||
(FONTAVGCHARWIDTH WORD) (* ;
|
||||
"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.")
|
||||
(FONTEXTRAFIELD2 POINTER))
|
||||
FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR))
|
||||
|
||||
(RECORD FONTFACE (WEIGHT SLOPE EXPANSION)
|
||||
[ACCESSFNS ((COLOR (CDDDR DATUM)
|
||||
(RPLACD (CDDR DATUM)
|
||||
NEWVALUE))
|
||||
(BACKCOLOR [COND
|
||||
((CDDDR DATUM)
|
||||
(CAR (CDDDR DATUM]
|
||||
(PROGN [COND
|
||||
((NULL (CDDDR DATUM))
|
||||
(RPLACD (CDDR DATUM)
|
||||
(LIST NIL NIL]
|
||||
(RPLACA (CDDDR DATUM)
|
||||
NEWVALUE)))
|
||||
(FORECOLOR [COND
|
||||
((CDDDR DATUM)
|
||||
(CADR (CDDDR DATUM]
|
||||
(PROGN [COND
|
||||
((NULL (CDDDR DATUM))
|
||||
(RPLACD (CDDR DATUM)
|
||||
(LIST NIL NIL]
|
||||
(RPLACA (CDR (CDDDR DATUM))
|
||||
NEWVALUE]
|
||||
WEIGHT _ 'MEDIUM SLOPE _ 'REGULAR EXPANSION _ 'REGULAR (TYPE? LISTP))
|
||||
[ACCESSFNS ((COLOR (CDDDR DATUM)
|
||||
(RPLACD (CDDR DATUM)
|
||||
NEWVALUE))
|
||||
(BACKCOLOR [COND
|
||||
((CDDDR DATUM)
|
||||
(CAR (CDDDR DATUM]
|
||||
(PROGN [COND
|
||||
((NULL (CDDDR DATUM))
|
||||
(RPLACD (CDDR DATUM)
|
||||
(LIST NIL NIL]
|
||||
(RPLACA (CDDDR DATUM)
|
||||
NEWVALUE)))
|
||||
(FORECOLOR [COND
|
||||
((CDDDR DATUM)
|
||||
(CADR (CDDDR DATUM]
|
||||
(PROGN [COND
|
||||
((NULL (CDDDR DATUM))
|
||||
(RPLACD (CDDR DATUM)
|
||||
(LIST NIL NIL]
|
||||
(RPLACA (CDR (CDDDR DATUM))
|
||||
NEWVALUE]
|
||||
WEIGHT _ 'MEDIUM SLOPE _ 'REGULAR EXPANSION _ 'REGULAR (TYPE? LISTP))
|
||||
|
||||
(DATATYPE CHARSETINFO (WIDTHS (* ; "The advance-width of each character, an array indexed by charcode. Usually the same as the imagewidth, but can differ for accents, kerns kerns. This is what should be used for stringwidth calculations.")
|
||||
OFFSETS (* ;
|
||||
"Offset of each character into the image bitmap; X value of left edge")
|
||||
IMAGEWIDTHS (* ;
|
||||
"imagewidths is not automagically allocated since it is not always needed")
|
||||
CHARSETBITMAP (* ;
|
||||
"Bitmap containing the character images, indexed by OFFSETS")
|
||||
YWIDTHS
|
||||
(CHARSETASCENT WORD) (* ;
|
||||
"Max ascent for all characters in this CHARSET")
|
||||
(CHARSETDESCENT WORD) (* ;
|
||||
"Max descent for all characters in this CHARSET")
|
||||
LEFTKERN)
|
||||
WIDTHS _ (\CREATECSINFOELEMENT)
|
||||
OFFSETS _ (\CREATECSINFOELEMENT))
|
||||
(DATATYPE CHARSETINFO (WIDTHS (* ; "The advance-width of each character, an array indexed by charcode. Usually the same as the imagewidth, but can differ for accents, kerns kerns. This is what should be used for stringwidth calculations.")
|
||||
OFFSETS (* ;
|
||||
"Offset of each character into the image bitmap; X value of left edge")
|
||||
IMAGEWIDTHS (* ;
|
||||
"imagewidths is not automagically allocated since it is not always needed")
|
||||
CHARSETBITMAP (* ;
|
||||
"Bitmap containing the character images, indexed by OFFSETS")
|
||||
YWIDTHS
|
||||
(CHARSETASCENT WORD) (* ;
|
||||
"Max ascent for all characters in this CHARSET")
|
||||
(CHARSETDESCENT WORD) (* ;
|
||||
"Max descent for all characters in this CHARSET")
|
||||
LEFTKERN)
|
||||
WIDTHS _ (\CREATECSINFOELEMENT)
|
||||
OFFSETS _ (\CREATECSINFOELEMENT))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
|
||||
@@ -3104,65 +3103,63 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS FONTASCENT MACRO ((FONTSPEC)
|
||||
(ffetch \SFAscent of (\GETFONTDESC FONTSPEC))))
|
||||
(ffetch \SFAscent of (\GETFONTDESC FONTSPEC))))
|
||||
|
||||
(PUTPROPS FONTDESCENT MACRO ((FONTSPEC)
|
||||
(ffetch \SFDescent of (\GETFONTDESC FONTSPEC))))
|
||||
(ffetch \SFDescent of (\GETFONTDESC FONTSPEC))))
|
||||
|
||||
(PUTPROPS FONTHEIGHT MACRO ((FONTSPEC)
|
||||
(ffetch \SFHeight of (\GETFONTDESC FONTSPEC))))
|
||||
(ffetch \SFHeight of (\GETFONTDESC FONTSPEC))))
|
||||
|
||||
(PUTPROPS \FGETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE)
|
||||
(\GETBASE OFFSETSBLOCK CHAR8CODE)))
|
||||
(\GETBASE OFFSETSBLOCK CHAR8CODE)))
|
||||
|
||||
(PUTPROPS \FSETOFFSET DMACRO ((OFFSETSBLOCK CHAR8CODE OFFSET)
|
||||
(\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET)))
|
||||
(\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET)))
|
||||
|
||||
(PUTPROPS \FGETWIDTH DMACRO ((WIDTHSBLOCK CHAR8CODE)
|
||||
(\GETBASE WIDTHSBLOCK CHAR8CODE)))
|
||||
(\GETBASE WIDTHSBLOCK CHAR8CODE)))
|
||||
|
||||
(PUTPROPS \FSETWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH)
|
||||
(\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
|
||||
(\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
|
||||
|
||||
(PUTPROPS \FGETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE)
|
||||
(\FGETWIDTH (ffetch (CHARSETINFO WIDTHS)
|
||||
of (\GETCHARSETINFO (\CHARSET CHARCODE)
|
||||
FONTDESC))
|
||||
(\CHAR8CODE CHARCODE))))
|
||||
(\FGETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO
|
||||
(\CHARSET CHARCODE)
|
||||
FONTDESC))
|
||||
(\CHAR8CODE CHARCODE))))
|
||||
|
||||
(PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH)
|
||||
(\FSETWIDTH (ffetch (CHARSETINFO WIDTHS)
|
||||
of (\GETCHARSETINFO (\CHARSET CHARCODE)
|
||||
FONTDESC))
|
||||
(\CHAR8CODE CHARCODE)
|
||||
WIDTH)))
|
||||
(\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO
|
||||
(\CHARSET CHARCODE)
|
||||
FONTDESC))
|
||||
(\CHAR8CODE CHARCODE)
|
||||
WIDTH)))
|
||||
|
||||
(PUTPROPS \FGETIMAGEWIDTH MACRO ((IMAGEWIDTHSBLOCK CHAR8CODE)
|
||||
(\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE)))
|
||||
(\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE)))
|
||||
|
||||
(PUTPROPS \FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH)
|
||||
(\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
|
||||
(\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
|
||||
|
||||
(PUTPROPS \GETCHARSETINFO MACRO ((CHARSET FONTDESC NOSLUG?)
|
||||
|
||||
(* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates the required charset.")
|
||||
(* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates the required charset.")
|
||||
|
||||
(* ;;
|
||||
"NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL")
|
||||
(* ;;
|
||||
"NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL")
|
||||
|
||||
(OR (\GETBASEPTR (ffetch FONTCHARSETVECTOR of
|
||||
FONTDESC
|
||||
)
|
||||
(UNFOLD CHARSET 2))
|
||||
(\CREATECHARSET CHARSET FONTDESC NOSLUG?))))
|
||||
(OR (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC)
|
||||
(UNFOLD CHARSET 2))
|
||||
(\CREATECHARSET CHARSET FONTDESC NOSLUG?))))
|
||||
|
||||
(PUTPROPS \CREATECSINFOELEMENT MACRO (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3)
|
||||
WORDSPERCELL))))
|
||||
WORDSPERCELL))))
|
||||
|
||||
(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (NIL (* ;
|
||||
"Allocates a block for the character set records")
|
||||
(\ALLOCBLOCK (ADD1 \MAXCHARSET)
|
||||
T)))
|
||||
(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (NIL (* ;
|
||||
"Allocates a block for the character set records")
|
||||
(\ALLOCBLOCK (ADD1 \MAXCHARSET)
|
||||
T)))
|
||||
)
|
||||
|
||||
(DEFMACRO \CREATEKERNELEMENT ()
|
||||
@@ -3263,13 +3260,15 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(MODERN 12))))
|
||||
|
||||
(RPAQ? MISSINGDISPLAYFONTCOERCIONS '(((GACHA)
|
||||
(TERMINAL))
|
||||
((MODERN)
|
||||
(CLASSIC))
|
||||
((TIMESROMAN)
|
||||
(CLASSIC))
|
||||
((HELVETICA)
|
||||
(MODERN))))
|
||||
(TERMINAL))
|
||||
((MODERN)
|
||||
(CLASSIC))
|
||||
((TIMESROMAN)
|
||||
(CLASSIC))
|
||||
((HELVETICA)
|
||||
(MODERN))
|
||||
((TERMINAL)
|
||||
(MODERN))))
|
||||
|
||||
(RPAQ? CHARSETERRORFLG NIL)
|
||||
|
||||
@@ -3311,27 +3310,26 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(RPAQ? DISPLAYFONTEXTENSIONS 'DISPLAYFONT)
|
||||
|
||||
(RPAQ? DISPLAYFONTDIRECTORIES '({DSK}/USR/LOCAL/LDE/FONTS/DISPLAY/PRESENTATION/
|
||||
{dsk}/usr/local/lde/fonts/display/publishing/))
|
||||
{dsk}/usr/local/lde/fonts/display/publishing/))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \FGETCHARIMAGEWIDTH MACRO (OPENLAMBDA (FONT CHARCODE)
|
||||
(\FGETWIDTH (ffetch (CHARSETINFO IMAGEWIDTHS)
|
||||
of (\GETCHARSETINFO (\CHARSET
|
||||
CHARCODE)
|
||||
FONT))
|
||||
(\CHAR8CODE CHARCODE))))
|
||||
(\FGETWIDTH (ffetch (CHARSETINFO IMAGEWIDTHS)
|
||||
of (\GETCHARSETINFO (\CHARSET CHARCODE)
|
||||
FONT))
|
||||
(\CHAR8CODE CHARCODE))))
|
||||
|
||||
(PROGN (PUTPROPS \GETFONTDESC DMACRO [X (COND
|
||||
((CDR X)
|
||||
(CONS '\COERCEFONTDESC X))
|
||||
(T `(\DTEST ,(CAR X)
|
||||
'FONTDESCRIPTOR])
|
||||
((CDR X)
|
||||
(CONS '\COERCEFONTDESC X))
|
||||
(T `(\DTEST ,(CAR X)
|
||||
'FONTDESCRIPTOR])
|
||||
(PUTPROPS \GETFONTDESC MACRO (= . \COERCEFONTDESC)))
|
||||
|
||||
(PUTPROPS \SETCHARSETINFO MACRO ((CHARSETVECTOR CHARSET CSINFO)
|
||||
(\RPLPTR CHARSETVECTOR (UNFOLD CHARSET 2)
|
||||
CSINFO)))
|
||||
(\RPLPTR CHARSETVECTOR (UNFOLD CHARSET 2)
|
||||
CSINFO)))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -3350,29 +3348,30 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991,
|
||||
(PUTPROPS FONT COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1992 1993 1994 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8618 18137 (CHARWIDTH 8628 . 9413) (CHARWIDTHY 9415 . 10785) (STRINGWIDTH 10787 . 11880
|
||||
) (\CHARWIDTH.DISPLAY 11882 . 12295) (\STRINGWIDTH.DISPLAY 12297 . 12721) (\STRINGWIDTH.GENERIC 12723
|
||||
. 18135)) (18138 24520 (DEFAULTFONT 18148 . 19981) (FONTCLASS 19983 . 22145) (FONTCLASSUNPARSE 22147
|
||||
. 23046) (FONTCLASSCOMPONENT 23048 . 23557) (SETFONTCLASSCOMPONENT 23559 . 24518)) (25194 37926 (
|
||||
FONTCREATE 25204 . 34471) (\FONT.SYMBOLMEMB 34473 . 34703) (\FONT.SYMBOLASSOC 34705 . 35863) (
|
||||
\FONT.COMPARESYMBOL 35865 . 37924)) (37965 42589 (FONTASCENT 37975 . 38143) (FONTDESCENT 38145 . 38414
|
||||
) (FONTHEIGHT 38416 . 38602) (FONTPROP 38604 . 42047) (\AVGCHARWIDTH 42049 . 42587)) (42636 55275 (
|
||||
GETCHARBITMAP 42646 . 45536) (PUTCHARBITMAP 45538 . 53595) (MOVECHARBITMAP 53597 . 55273)) (55276
|
||||
140202 (FONTCOPY 55286 . 60594) (FONTSAVAILABLE 60596 . 65801) (FONTFILEFORMAT 65803 . 67427) (FONTP
|
||||
67429 . 67728) (FONTUNPARSE 67730 . 70294) (SETFONTDESCRIPTOR 70296 . 72005) (CHARCODEP 72007 . 72368)
|
||||
(EDITCHAR 72370 . 72799) (\STREAMCHARWIDTH 72801 . 76965) (\UNITWIDTHSVECTOR 76967 . 77330) (
|
||||
\CREATEDISPLAYFONT 77332 . 78085) (\CREATECHARSET.DISPLAY 78087 . 81003) (\CREATE-REAL-CHARSET.DISPLAY
|
||||
81005 . 88296) (\BUILDSLUGCSINFO 88298 . 89741) (\SEARCHDISPLAYFONTFILES 89743 . 91676) (
|
||||
\SEARCHFONTFILES 91678 . 94989) (\FINDFONTFILE 94991 . 96182) (\FONTSYMBOL 96184 . 96834) (
|
||||
\DEVICESYMBOL 96836 . 97705) (\FONTFACE 97707 . 104897) (\FONTFACE.COLOR 104899 . 111819) (
|
||||
\FONTFILENAME 111821 . 115236) (\FONTFILENAME.OLD 115238 . 118187) (\FONTFILENAME.NEW 118189 . 120446)
|
||||
(\FONTINFOFROMFILENAME 120448 . 123562) (\FONTINFOFROMFILENAME.OLD 123564 . 125841) (\GETFONTDESC
|
||||
125843 . 126234) (\COERCEFONTDESC 126236 . 131621) (\LOOKUPFONT 131623 . 132967) (\LOOKUPFONTSINCORE
|
||||
132969 . 135042) (\READDISPLAYFONTFILE 135044 . 140200)) (141105 158155 (\READSTRIKEFONTFILE 141115 .
|
||||
145643) (\SFMAKEBOLD 145645 . 148041) (\SFMAKEITALIC 148043 . 150946) (\SFMAKEROTATEDFONT 150948 .
|
||||
152349) (\SFROTATECSINFO 152351 . 152988) (\SFROTATEFONTCHARACTERS 152990 . 153370) (
|
||||
\SFFIXOFFSETSAFTERROTATION 153372 . 155511) (\SFROTATECSINFOOFFSETS 155513 . 156782) (\SFMAKECOLOR
|
||||
156784 . 158153)) (158156 166467 (WRITESTRIKEFONTFILE 158166 . 163007) (STRIKECSINFO 163009 . 166465))
|
||||
(181614 184470 (\CREATECHARSET 181624 . 184468)) (185556 187308 (\FONTRESETCHARWIDTHS 185566 . 187306
|
||||
)))))
|
||||
(FILEMAP (NIL (8745 18264 (CHARWIDTH 8755 . 9540) (CHARWIDTHY 9542 . 10912) (STRINGWIDTH 10914 . 12007
|
||||
) (\CHARWIDTH.DISPLAY 12009 . 12422) (\STRINGWIDTH.DISPLAY 12424 . 12848) (\STRINGWIDTH.GENERIC 12850
|
||||
. 18262)) (18265 24647 (DEFAULTFONT 18275 . 20108) (FONTCLASS 20110 . 22272) (FONTCLASSUNPARSE 22274
|
||||
. 23173) (FONTCLASSCOMPONENT 23175 . 23684) (SETFONTCLASSCOMPONENT 23686 . 24645)) (25321 38053 (
|
||||
FONTCREATE 25331 . 34598) (\FONT.SYMBOLMEMB 34600 . 34830) (\FONT.SYMBOLASSOC 34832 . 35990) (
|
||||
\FONT.COMPARESYMBOL 35992 . 38051)) (38092 42716 (FONTASCENT 38102 . 38270) (FONTDESCENT 38272 . 38541
|
||||
) (FONTHEIGHT 38543 . 38729) (FONTPROP 38731 . 42174) (\AVGCHARWIDTH 42176 . 42714)) (42763 55402 (
|
||||
GETCHARBITMAP 42773 . 45663) (PUTCHARBITMAP 45665 . 53722) (MOVECHARBITMAP 53724 . 55400)) (55403
|
||||
139942 (FONTCOPY 55413 . 60721) (FONTSAVAILABLE 60723 . 65928) (FONTFILEFORMAT 65930 . 67554) (FONTP
|
||||
67556 . 67855) (FONTUNPARSE 67857 . 70421) (SETFONTDESCRIPTOR 70423 . 72132) (CHARCODEP 72134 . 72495)
|
||||
(EDITCHAR 72497 . 72926) (\STREAMCHARWIDTH 72928 . 77092) (\UNITWIDTHSVECTOR 77094 . 77457) (
|
||||
\CREATEDISPLAYFONT 77459 . 78212) (\CREATECHARSET.DISPLAY 78214 . 81130) (\CREATE-REAL-CHARSET.DISPLAY
|
||||
81132 . 88036) (\BUILDSLUGCSINFO 88038 . 89481) (\SEARCHDISPLAYFONTFILES 89483 . 91416) (
|
||||
\SEARCHFONTFILES 91418 . 94729) (\FINDFONTFILE 94731 . 95922) (\FONTSYMBOL 95924 . 96574) (
|
||||
\DEVICESYMBOL 96576 . 97445) (\FONTFACE 97447 . 104637) (\FONTFACE.COLOR 104639 . 111559) (
|
||||
\FONTFILENAME 111561 . 114976) (\FONTFILENAME.OLD 114978 . 117927) (\FONTFILENAME.NEW 117929 . 120186)
|
||||
(\FONTINFOFROMFILENAME 120188 . 123302) (\FONTINFOFROMFILENAME.OLD 123304 . 125581) (\GETFONTDESC
|
||||
125583 . 125974) (\COERCEFONTDESC 125976 . 131361) (\LOOKUPFONT 131363 . 132707) (\LOOKUPFONTSINCORE
|
||||
132709 . 134782) (\READDISPLAYFONTFILE 134784 . 139940)) (140845 157895 (\READSTRIKEFONTFILE 140855 .
|
||||
145383) (\SFMAKEBOLD 145385 . 147781) (\SFMAKEITALIC 147783 . 150686) (\SFMAKEROTATEDFONT 150688 .
|
||||
152089) (\SFROTATECSINFO 152091 . 152728) (\SFROTATEFONTCHARACTERS 152730 . 153110) (
|
||||
\SFFIXOFFSETSAFTERROTATION 153112 . 155251) (\SFROTATECSINFOOFFSETS 155253 . 156522) (\SFMAKECOLOR
|
||||
156524 . 157893)) (157896 166207 (WRITESTRIKEFONTFILE 157906 . 162747) (STRIKECSINFO 162749 . 166205))
|
||||
(180252 180415 (\CREATEKERNELEMENT 180252 . 180415)) (180417 180545 (\FSETLEFTKERN 180417 . 180545))
|
||||
(180547 180641 (\FGETLEFTKERN 180547 . 180641)) (180810 183666 (\CREATECHARSET 180820 . 183664)) (
|
||||
184821 186573 (\FONTRESETCHARWIDTHS 184831 . 186571)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user