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

once more

Browse Source
This commit is contained in:
Larry Masinter
2023-03-01 07:53:44 -08:00
parent 6d86932d35
commit fb1d14dfeb
3 changed files with 188 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

266
sources/ADISPLAY
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Feb-2023 06:37:11" {DSK}<home>larry>il>medley>sources>ADISPLAY.;2 238362
(FILECREATED " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>ADISPLAY.;2 245335
:EDIT-BY "lmm"
:PREVIOUS-DATE "13-Jun-2021 14:03:35" {DSK}<home>larry>il>medley>sources>ADISPLAY.;1)
:CHANGES-TO (FNS \DRAWLINE.DISPLAY)
:PREVIOUS-DATE "28-Feb-2023 06:37:11" {DSK}<home>larry>il>medley>sources>ADISPLAY.;1)
(* ; "
@@ -1470,56 +1472,154 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(\DRAWLINE.DISPLAY
[LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING)
(* ; "Edited 13-Jun-2021 14:03 by rmk:")
(* ; "Edited 1-Mar-2023 07:42 by lmm")
(* ; "Edited 29-Jan-91 14:59 by matsuda")
(* ;; "DISPLAYSTREAM is guaranteed to be a display-stream. Draws a line from x1,y1 to x2,y2 leaving the position at x2,y2")
(* ;; "Added handling of brushes (I think, this is actually pretty tricky).")
(DECLARE (LOCALVARS . T))
(SELECTQ OPERATION
(NIL (ffetch DDOPERATION of (fetch IMAGEDATA of DISPLAYSTREAM)))
((REPLACE PAINT INVERT ERASE)
OPERATION)
(\ILLEGAL.ARG OPERATION))
(\INSURETOPWDS DISPLAYSTREAM) (* ;
 "RMK: This was only in the no-dash case, oddly")
(IF (OR DASHING (BRUSHP WIDTH))
THEN [LET ((BRUSH (INSURE.BRUSH WIDTH)))
(if COLOR
then (replace (BRUSH BRUSHCOLOR) of BRUSH with COLOR))
(IF (BIGBITMAPP (ffetch DDDestination of (fetch IMAGEDATA of DISPLAYSTREAM)))
THEN (\DRAWLINE.BIGBM.DASH DISPLAYSTREAM X1 Y1 X2 Y2 BRUSH DASHING OPERATION)
ELSE (GLOBALRESOURCES \BRUSHBBT (\LINEWITHBRUSH X1 Y1 X2 Y2 BRUSH
(\GOOD.DASHLST DASHING BRUSH)
DISPLAYSTREAM \BRUSHBBT OPERATION]
ELSEIF (BIGBITMAPP (ffetch DDDestination of (fetch IMAGEDATA of DISPLAYSTREAM)))
THEN (\DRAWLINE.BIGBM.NODASH DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR)
ELSE (LET ((DD (fetch IMAGEDATA of DISPLAYSTREAM)))
(\CLIPANDDRAWLINE (\DSPTRANSFORMX (OR (FIXP X1)
(FIXR X1))
DD)
(\DSPTRANSFORMY (OR (FIXP Y1)
(FIXR Y1))
DD)
(\DSPTRANSFORMX (OR (FIXP X2)
(FIXR X2))
DD)
(\DSPTRANSFORMY (OR (FIXP Y2)
(FIXR Y2))
DD)
[COND
((NULL WIDTH)
1)
((OR (FIXP WIDTH)
(FIXR WIDTH]
OPERATION
(ffetch DDDestination of DD)
(ffetch DDClippingLeft of DD)
(SUB1 (ffetch DDClippingRight of DD))
(ffetch DDClippingBottom of DD)
(SUB1 (ffetch DDClippingTop of DD))
DISPLAYSTREAM COLOR))) (* ;
(DECLARE (LOCALVARS . T)
(GLOBALVARS \SCREENBITMAPS))
[COND
[(OR DASHING (BRUSHP WIDTH))
(GLOBALRESOURCE
\BRUSHBBT
(LET ((BBT \BRUSHBBT)
(BRUSH (INSURE.BRUSH WIDTH)))
(if COLOR
then (replace (BRUSH BRUSHCOLOR) of BRUSH with COLOR))
(IF [NOT (type? BIGBM (ffetch DDDestination of (fetch IMAGEDATA of DISPLAYSTREAM]
THEN (\LINEWITHBRUSH X1 Y1 X2 Y2 BRUSH (\GOOD.DASHLST DASHING BRUSH)
DISPLAYSTREAM BBT (SELECTQ OPERATION
(NIL (ffetch DDOPERATION
of (fetch IMAGEDATA of DISPLAYSTREAM)))
((REPLACE PAINT INVERT ERASE)
OPERATION)
(\ILLEGAL.ARG OPERATION)))
ELSE (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM))
BITMAP BIGBMLIST HEIGHT BOTTOM BM YY1 YY2 ClippingTop ClippingBottom CTop
CBottom)
(SETQ BITMAP (ffetch DDDestination of DD))
(SETQ BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
(SETQ ClippingTop (ffetch DDClippingTop of DD))
(SETQ ClippingBottom (ffetch DDClippingBottom of DD))
(SETQ BM (GetNewFragment BIGBMLIST))
(while (AND BM (IGREATERP HEIGHT ClippingBottom))
do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM)))
[SETQ CTop (COND
((IGREATERP ClippingTop HEIGHT)
(IDIFFERENCE HEIGHT BOTTOM))
(T (IDIFFERENCE ClippingTop BOTTOM]
(if (IGEQ CTop 0)
then [SETQ CBottom (COND
((ILESSP ClippingBottom BOTTOM)
0)
(T (IDIFFERENCE ClippingBottom BOTTOM]
(replace DDDestination of DD with BM)
(replace DDClippingTop of DD with CTop)
(replace DDClippingBottom of DD with CBottom)
(\LINEWITHBRUSH X1 (IDIFFERENCE Y1 BOTTOM)
X2
(IDIFFERENCE Y2 BOTTOM)
BRUSH
(\GOOD.DASHLST DASHING BRUSH)
DISPLAYSTREAM BBT
(SELECTQ OPERATION
(NIL (ffetch DDOPERATION
of (fetch IMAGEDATA of DISPLAYSTREAM)))
((REPLACE PAINT INVERT ERASE)
OPERATION)
(\ILLEGAL.ARG OPERATION)))
(SETQ BM (GetNewFragment BIGBMLIST))
(SETQ HEIGHT BOTTOM)))
(freplace DDDestination of DD with BITMAP)
(freplace DDClippingTop of DD with ClippingTop)
(freplace DDClippingBottom of DD with ClippingBottom]
(T (PROG ((DD (fetch IMAGEDATA of DISPLAYSTREAM))
BITMAP)
(\INSURETOPWDS DISPLAYSTREAM) (* ; "bring the window to the top")
(SETQ BITMAP (ffetch DDDestination of DD))
(COND
((NOT (type? BIGBM BITMAP))
(\CLIPANDDRAWLINE (\DSPTRANSFORMX (OR (FIXP X1)
(FIXR X1))
DD)
(\DSPTRANSFORMY (OR (FIXP Y1)
(FIXR Y1))
DD)
(\DSPTRANSFORMX (OR (FIXP X2)
(FIXR X2))
DD)
(\DSPTRANSFORMY (OR (FIXP Y2)
(FIXR Y2))
DD)
[COND
((NULL WIDTH)
1)
((OR (FIXP WIDTH)
(FIXR WIDTH]
(SELECTQ OPERATION
(NIL (ffetch DDOPERATION of DD))
((REPLACE PAINT INVERT ERASE)
OPERATION)
(\ILLEGAL.ARG OPERATION))
BITMAP
(ffetch DDClippingLeft of DD)
(SUB1 (ffetch DDClippingRight of DD))
(ffetch DDClippingBottom of DD)
(SUB1 (ffetch DDClippingTop of DD))
DISPLAYSTREAM COLOR))
(T (PROG ((BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP))
(HEIGHT (BITMAPHEIGHT BITMAP))
BOTTOM BM CTop CBottom (ClippingTop (ffetch DDClippingTop of DD))
(ClippingBottom (ffetch DDClippingBottom of DD))
(YY1 (\DSPTRANSFORMY (OR (FIXP Y1)
(FIXR Y1))
DD))
(YY2 (\DSPTRANSFORMY (OR (FIXP Y2)
(FIXR Y2))
DD)))
(SETQ BM (GetNewFragment BIGBMLIST))
(while (AND BM (IGREATERP HEIGHT ClippingBottom))
do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM)))
[SETQ CTop (COND
((IGREATERP ClippingTop HEIGHT)
(IDIFFERENCE HEIGHT BOTTOM))
(T (IDIFFERENCE ClippingTop BOTTOM]
(COND
((IGEQ CTop 0)
[SETQ CBottom (COND
((ILESSP ClippingBottom BOTTOM)
0)
(T (IDIFFERENCE ClippingBottom BOTTOM]
(\CLIPANDDRAWLINE (\DSPTRANSFORMX (OR (FIXP X1)
(FIXR X1))
DD)
(IDIFFERENCE YY1 BOTTOM)
(\DSPTRANSFORMX (OR (FIXP X2)
(FIXR X2))
DD)
(IDIFFERENCE YY2 BOTTOM)
[COND
((NULL WIDTH)
1)
((OR (FIXP WIDTH)
(FIXR WIDTH]
(SELECTQ OPERATION
(NIL (ffetch DDOPERATION of DD))
((REPLACE PAINT INVERT ERASE)
OPERATION)
(\ILLEGAL.ARG OPERATION))
BM
(ffetch DDClippingLeft of DD)
(SUB1 (ffetch DDClippingRight of DD))
CBottom
(SUB1 CTop)
DISPLAYSTREAM COLOR)))
(SETQ BM (GetNewFragment BIGBMLIST))
(SETQ HEIGHT BOTTOM] (* ;
 "the generic case of MOVETO is used so that the hardcopy streams get handled as well.")
(MOVETO X2 Y2 DISPLAYSTREAM])
@@ -4334,40 +4434,40 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(PUTPROPS ADISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12017 19378 (\BBTCURVEPT 12027 . 19376)) (19379 29195 (CREATETEXTUREFROMBITMAP 19389 .
21319) (PRINTBITMAP 21321 . 22672) (PRINT-BITMAPS-NICELY 22674 . 26525) (PRINTCURSOR 26527 . 27560) (
\WRITEBITMAP 27562 . 29193)) (29238 31786 (\GETINTEGERPART 29248 . 30793) (\CONVERTTOFRACTION 30795 .
31784)) (31923 32795 (CURSORP 31933 . 32152) (CURSORBITMAP 32154 . 32200) (CreateCursorBitMap 32202 .
32793)) (37157 46200 (CARET 37167 . 38927) (\CARET.CREATE 38929 . 39107) (\CARET.DOWN 39109 . 40461) (
\CARET.FLASH? 40463 . 42277) (\CARET.SHOW 42279 . 42848) (CARETRATE 42850 . 43508) (\CARET.FLASH.AGAIN
43510 . 44676) (\CARET.FLASH.MULTIPLE 44678 . 45201) (\CARET.FLASH 45203 . 46198)) (46201 51273 (
\MEDW.CARET.SHOW 46211 . 51271)) (51637 53472 (\AREAVISIBLE? 51647 . 52571) (\REGIONOVERLAPAREAP 52573
. 53118) (\AREAINREGIONP 53120 . 53470)) (53521 65997 (CREATEREGION 53531 . 53867) (REGIONP 53869 .
54015) (INTERSECTREGIONS 54017 . 56787) (UNIONREGIONS 56789 . 58940) (REGIONSINTERSECTP 58942 . 59550)
(SUBREGIONP 59552 . 60197) (EXTENDREGION 60199 . 62356) (EXTENDREGIONBOTTOM 62358 . 63000) (
EXTENDREGIONLEFT 63002 . 63621) (EXTENDREGIONRIGHT 63623 . 64176) (EXTENDREGIONTOP 64178 . 64719) (
INSIDEP 64721 . 65489) (STRINGREGION 65491 . 65995)) (66242 71516 (\BRUSHBITMAP 66252 . 67969) (
\GETBRUSH 67971 . 68282) (\GETBRUSHBBT 68284 . 70312) (\InitCurveBrushes 70314 . 71380) (
\BrushFromWidth 71382 . 71514)) (71517 74584 (\MAKEBRUSH.DIAGONAL 71527 . 71807) (
\MAKEBRUSH.HORIZONTAL 71809 . 72203) (\MAKEBRUSH.VERTICAL 72205 . 72517) (\MAKEBRUSH.SQUARE 72519 .
72796) (\MAKEBRUSH.ROUND 72798 . 74582)) (74585 75750 (INSTALLBRUSH 74595 . 75748)) (76151 80623 (
\DRAWLINE.DISPLAY 76161 . 79338) (RELMOVETO 79340 . 79727) (MOVETOUPPERLEFT 79729 . 80621)) (80624
104109 (\CLIPANDDRAWLINE 80634 . 87080) (\CLIPANDDRAWLINE1 87082 . 98830) (\CLIPCODE 98832 . 100206) (
\LEASTPTAT 100208 . 100806) (\GREATESTPTAT 100808 . 101436) (\DRAWLINE1 101438 . 102554) (
\DRAWLINE.UFN 102556 . 104107)) (108639 154686 (\DRAWCIRCLE.DISPLAY 108649 . 117462) (\DRAWARC.DISPLAY
117464 . 117754) (\DRAWARC.GENERIC 117756 . 118509) (\COMPUTE.ARC.POINTS 118511 . 120776) (
\DRAWELLIPSE.DISPLAY 120778 . 136447) (\DRAWCURVE.DISPLAY 136449 . 138738) (\DRAWPOINT.DISPLAY 138740
. 139936) (\DRAWPOLYGON.DISPLAY 139938 . 143466) (\LINEWITHBRUSH 143468 . 154684)) (154687 186379 (
LOADPOLY 154697 . 155257) (PARAMETRICSPLINE 155259 . 165456) (\CURVE 165458 . 171060) (\CURVE2 171062
. 182393) (\CURVEEND 182395 . 182877) (\CURVESLOPE 182879 . 185362) (\CURVESTART 185364 . 185688) (
\FDIFS/FROM/DERIVS 185690 . 186377)) (198908 213244 (\FILLCIRCLE.DISPLAY 198918 . 209666) (\LINEBLT
209668 . 213242)) (213288 215288 (SCREENBITMAP 213298 . 213775) (BITMAPP 213777 . 214011) (
BITMAPHEIGHT 214013 . 214389) (BITSPERPIXEL 214391 . 215286)) (215929 216922 (DSPFILL 215939 . 216622)
(INVERTW 216624 . 216920)) (216923 220566 (\DSPCOLOR.DISPLAY 216933 . 218230) (\DSPBACKCOLOR.DISPLAY
218232 . 219611) (DSPEOLFN 219613 . 220564)) (220999 225653 (DSPCLEOL 221009 . 221885) (DSPRUBOUTCHAR
221887 . 222319) (\DSPMOVELR 222321 . 225651)) (225783 226901 (\CURSOR.DEFPRINT 225793 . 226899)) (
227313 235887 (TEXTUREOFCOLOR 227323 . 228585) (\PRIMARYTEXTURE 228587 . 229169) (\LEVELTEXTURE 229171
. 229672) (INSURE.B&W.TEXTURE 229674 . 231069) (INSURE.RGB.COLOR 231071 . 232499) (\LOOKUPCOLORNAME
232501 . 232771) (RGBP 232773 . 233538) (HLSP 233540 . 233915) (HLSTORGB 233917 . 235057) (\HLSVALUEFN
235059 . 235885)))))
(FILEMAP (NIL (12060 19421 (\BBTCURVEPT 12070 . 19419)) (19422 29238 (CREATETEXTUREFROMBITMAP 19432 .
21362) (PRINTBITMAP 21364 . 22715) (PRINT-BITMAPS-NICELY 22717 . 26568) (PRINTCURSOR 26570 . 27603) (
\WRITEBITMAP 27605 . 29236)) (29281 31829 (\GETINTEGERPART 29291 . 30836) (\CONVERTTOFRACTION 30838 .
31827)) (31966 32838 (CURSORP 31976 . 32195) (CURSORBITMAP 32197 . 32243) (CreateCursorBitMap 32245 .
32836)) (37200 46243 (CARET 37210 . 38970) (\CARET.CREATE 38972 . 39150) (\CARET.DOWN 39152 . 40504) (
\CARET.FLASH? 40506 . 42320) (\CARET.SHOW 42322 . 42891) (CARETRATE 42893 . 43551) (\CARET.FLASH.AGAIN
43553 . 44719) (\CARET.FLASH.MULTIPLE 44721 . 45244) (\CARET.FLASH 45246 . 46241)) (46244 51316 (
\MEDW.CARET.SHOW 46254 . 51314)) (51680 53515 (\AREAVISIBLE? 51690 . 52614) (\REGIONOVERLAPAREAP 52616
. 53161) (\AREAINREGIONP 53163 . 53513)) (53564 66040 (CREATEREGION 53574 . 53910) (REGIONP 53912 .
54058) (INTERSECTREGIONS 54060 . 56830) (UNIONREGIONS 56832 . 58983) (REGIONSINTERSECTP 58985 . 59593)
(SUBREGIONP 59595 . 60240) (EXTENDREGION 60242 . 62399) (EXTENDREGIONBOTTOM 62401 . 63043) (
EXTENDREGIONLEFT 63045 . 63664) (EXTENDREGIONRIGHT 63666 . 64219) (EXTENDREGIONTOP 64221 . 64762) (
INSIDEP 64764 . 65532) (STRINGREGION 65534 . 66038)) (66285 71559 (\BRUSHBITMAP 66295 . 68012) (
\GETBRUSH 68014 . 68325) (\GETBRUSHBBT 68327 . 70355) (\InitCurveBrushes 70357 . 71423) (
\BrushFromWidth 71425 . 71557)) (71560 74627 (\MAKEBRUSH.DIAGONAL 71570 . 71850) (
\MAKEBRUSH.HORIZONTAL 71852 . 72246) (\MAKEBRUSH.VERTICAL 72248 . 72560) (\MAKEBRUSH.SQUARE 72562 .
72839) (\MAKEBRUSH.ROUND 72841 . 74625)) (74628 75793 (INSTALLBRUSH 74638 . 75791)) (76194 87596 (
\DRAWLINE.DISPLAY 76204 . 86311) (RELMOVETO 86313 . 86700) (MOVETOUPPERLEFT 86702 . 87594)) (87597
111082 (\CLIPANDDRAWLINE 87607 . 94053) (\CLIPANDDRAWLINE1 94055 . 105803) (\CLIPCODE 105805 . 107179)
(\LEASTPTAT 107181 . 107779) (\GREATESTPTAT 107781 . 108409) (\DRAWLINE1 108411 . 109527) (
\DRAWLINE.UFN 109529 . 111080)) (115612 161659 (\DRAWCIRCLE.DISPLAY 115622 . 124435) (\DRAWARC.DISPLAY
124437 . 124727) (\DRAWARC.GENERIC 124729 . 125482) (\COMPUTE.ARC.POINTS 125484 . 127749) (
\DRAWELLIPSE.DISPLAY 127751 . 143420) (\DRAWCURVE.DISPLAY 143422 . 145711) (\DRAWPOINT.DISPLAY 145713
. 146909) (\DRAWPOLYGON.DISPLAY 146911 . 150439) (\LINEWITHBRUSH 150441 . 161657)) (161660 193352 (
LOADPOLY 161670 . 162230) (PARAMETRICSPLINE 162232 . 172429) (\CURVE 172431 . 178033) (\CURVE2 178035
. 189366) (\CURVEEND 189368 . 189850) (\CURVESLOPE 189852 . 192335) (\CURVESTART 192337 . 192661) (
\FDIFS/FROM/DERIVS 192663 . 193350)) (205881 220217 (\FILLCIRCLE.DISPLAY 205891 . 216639) (\LINEBLT
216641 . 220215)) (220261 222261 (SCREENBITMAP 220271 . 220748) (BITMAPP 220750 . 220984) (
BITMAPHEIGHT 220986 . 221362) (BITSPERPIXEL 221364 . 222259)) (222902 223895 (DSPFILL 222912 . 223595)
(INVERTW 223597 . 223893)) (223896 227539 (\DSPCOLOR.DISPLAY 223906 . 225203) (\DSPBACKCOLOR.DISPLAY
225205 . 226584) (DSPEOLFN 226586 . 227537)) (227972 232626 (DSPCLEOL 227982 . 228858) (DSPRUBOUTCHAR
228860 . 229292) (\DSPMOVELR 229294 . 232624)) (232756 233874 (\CURSOR.DEFPRINT 232766 . 233872)) (
234286 242860 (TEXTUREOFCOLOR 234296 . 235558) (\PRIMARYTEXTURE 235560 . 236142) (\LEVELTEXTURE 236144
. 236645) (INSURE.B&W.TEXTURE 236647 . 238042) (INSURE.RGB.COLOR 238044 . 239472) (\LOOKUPCOLORNAME
239474 . 239744) (RGBP 239746 . 240511) (HLSP 240513 . 240888) (HLSTORGB 240890 . 242030) (\HLSVALUEFN
242032 . 242858)))))
STOP

BIN
sources/ADISPLAY.LCOM
View File

Binary file not shown.

8
sources/FILESETS
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Feb-2023 11:25:24" {DSK}<home>larry>il>medley>sources>FILESETS.;2 6410
(FILECREATED " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>FILESETS.;2 6433
:EDIT-BY "lmm"
:CHANGES-TO (VARS EXPORTFILES)
:PREVIOUS-DATE "11-Sep-2022 20:08:31" {DSK}<home>larry>il>medley>sources>FILESETS.;1)
:PREVIOUS-DATE "26-Feb-2023 11:25:24" {DSK}<home>larry>il>medley>sources>FILESETS.;1)
(* ; "
@@ -71,7 +73,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS
DTDECLARE BIGBITMAP))
DTDECLARE BIGBITMAPS))
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))