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
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
|
||||
|
||||
Reference in New Issue
Block a user