1
0
mirror of synced 2026-04-04 21:47:27 +00:00

Patch to REGIONMANAGER and ADISPLAY for SCREENREGIONS (#1387)

For ADISPLAY, just added SCREENREGIONP.  Fixed typos in REGIONMANAGER.TEDIT
This commit is contained in:
rmkaplan
2023-11-03 17:39:33 -07:00
committed by GitHub
parent 713f2388c7
commit 5b90251210
5 changed files with 80 additions and 68 deletions

View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129 40525
(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133 41064
:EDIT-BY rmk
:PREVIOUS-DATE "10-Oct-2023 22:17:47" {MEDLEY}<lispusers>REGIONMANAGER.;9)
:CHANGES-TO (FNS RM-CREATEW)
:PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129)
(PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -138,7 +140,8 @@
(DEFINEQ
(RM-CREATEW
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 24-Sep-2023 20:38 by rmk")
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 2-Nov-2023 23:48 by rmk")
(* ; "Edited 24-Sep-2023 20:38 by rmk")
(* ; "Edited 14-Sep-2023 22:23 by rmk")
(* ; "Edited 1-Jan-2022 23:12 by rmk")
(* ; "Edited 29-Dec-2021 19:25 by rmk")
@@ -147,16 +150,22 @@
(* ;; "We have to bracket the original window creation because the we have to mark that the window uses that region, to put it back in the pool when the window is closed.")
(LET [WINDOW (REGION-TYPE (if (AND (LITATOM REGION)
REGION)
then (PROG1 REGION (SETQ REGION NIL))
else (LISTGET PROPS 'REGION-TYPE]
(* ;; "NOTE: putting the region as the REGION--TYPE property may only be needed for old TEDIT compatibility")
(* ;; "We have REGION-TYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type?")
(LET [WINDOW REGION-TYPE (RTPROP (LISTGET PROPS 'REGION-TYPE]
(SETQ REGION-TYPE (if (AND (LITATOM REGION)
REGION)
then (PROG1 REGION (SETQ REGION NIL))
elseif (LITATOM RTPROP)
then RTPROP))
(CL:UNLESS (OR (REGIONP REGION)
(SCREENREGIONP REGION))
(SETQ REGION (OR (REGIONP RTPROP)
(SCREENREGIONP RTPROP))))
(* ;; "Note: REGION can also be a screenregion, that falls through.")
(* ;; "We have REGION-TYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type? REGION can also be a screenregion, that falls through.")
(CL:WHEN REGION-TYPE
(CL:WHEN (AND REGION-TYPE (NULL REGION))
(SETQ REGION (GRAB-TYPED-REGION REGION-TYPE)))
(SETQ WINDOW (CREATEW.ORIG REGION TITLE BORDERSIZE NOOPENFLG PROPS))
(CL:WHEN REGION-TYPE (REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW))
@@ -721,11 +730,11 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1573 6691 (SET-TYPED-REGIONS 1583 . 3758) (GRAB-TYPED-REGION 3760 . 4786) (
REGISTER-TYPED-REGION 4788 . 6085) (REGION-TYPE 6087 . 6689)) (6692 14098 (RM-CREATEW 6702 . 8325) (
RM-CLOSEW 8327 . 11345) (RM-GETREGION 11347 . 13496) (CLOSE-TYPED-W 13498 . 14096)) (14741 22220 (
RELCREATEREGION 14751 . 19374) (RELGETREGION 19376 . 21983) (RELCREATEPOSITION 21985 . 22218)) (22221
29025 (\RELCREATEREGION.REF 22231 . 25982) (\RELCREATEREGION.SIZE 25984 . 29023)) (29078 38420 (
RM-ATTACHWINDOW 29088 . 38418)) (38421 40155 (CLOSEWITH 38431 . 38958) (CLOSEWITH.DOIT 38960 . 39240)
(MOVEWITH 39242 . 39765) (MOVEWITH.DOIT 39767 . 40153)))))
(FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) (
REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) (
RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 (
RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760
29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 (
RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779)
(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692)))))
STOP

Binary file not shown.

View File

@@ -32,9 +32,9 @@ Relative regions
Two functions are provided to make it easy to create regions relative and oriented with respect to a specified reference point. These may be useful for constructing an application that includes a constellation of windows arranged in a particular relative way.
(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function]
RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen.
WIDTH and HEIGHT can be given as absolute (natural) numbers) or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
WIDTH and HEIGHT can be given as absolute (natural) numbers or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
natural number: the number of screen points
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corres-ponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
region/window/SCREEN/TTY: equivalent to (region/window/SCREEN/TTY 1 0).
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be displayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
The reference-point arguments REFX and REFY are interpreted as follows:
@@ -55,7 +55,7 @@ Each of these applications is constructed by anticipating the subregions that th
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other windows are attached (e.g. expanded menus) by later user actions.
A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way.
(CLOSEWITH CHILDREN PARENT [Function]
@@ -73,9 +73,9 @@ If NEWPOS is the new position of PARENT, moves each of the move-children so that
TIMESROMAN$  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN
DÈ   }/ ¯[ <01>C×<00>T Û Á1 

; 3o)Ä ž     4 n © o2 V@1 %!  A  &MmJS-f=
; 3o)Ä ž     4 n © o2 V@1 %!  A  &MmIS-f<
3E
"

l /3
t2C ƒ "O=  , l¬)9¤Ç S~ æ- 4!Uh'2&µ$"&( )MDATE:fï1¶2Ș
t2C ƒ "O=  , l¬)9¤Ç S~ æ- 4!Uh'š2&µ$"&( )MDATE:fû+Ë2ɘ

View File

@@ -1,18 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>ADISPLAY.;2 245335
(FILECREATED " 2-Nov-2023 23:35:15" {WMEDLEY}<sources>ADISPLAY.;12 245350
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (FNS \DRAWLINE.DISPLAY)
:CHANGES-TO (VARS ADISPLAYCOMS)
(FNS SCREENREGIONP)
:PREVIOUS-DATE "28-Feb-2023 06:37:11" {DSK}<home>larry>il>medley>sources>ADISPLAY.;1)
:PREVIOUS-DATE " 1-Mar-2023 07:49:03" {WMEDLEY}<sources>ADISPLAY.;11)
(* ; "
Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT ADISPLAYCOMS)
(RPAQQ ADISPLAYCOMS
@@ -23,6 +20,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(COMS (* ; "Interlisp-D dependent stuff.")
(EXPORT (RECORDS REGION BITMAP BITMAPWORD POSITION CURSOR MOUSEEVENT SCREENREGION
SCREENPOSITION))
(FNS SCREENREGIONP)
(SYSRECORDS PILOTBBT \DISPLAYDATA)
(CONSTANTS (BITSPERINTEGER 32))
(FNS \BBTCURVEPT)
@@ -207,6 +205,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(* "END EXPORTED DEFINITIONS")
(DEFINEQ
(SCREENREGIONP
[LAMBDA (X) (* ; "Edited 2-Nov-2023 23:34 by rmk")
(CL:WHEN (type? SCREENREGION X)
X])
)
(ADDTOVAR SYSTEMRECLST
(DATATYPE PILOTBBT ((PBTDESTLO WORD)
@@ -4431,43 +4436,41 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(ADDTOVAR LAMA UNIONREGIONS INTERSECTREGIONS)
)
(PUTPROPS ADISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1993 1994 2021))
(DECLARE%: DONTCOPY
(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)))))
(FILEMAP (NIL (10558 10752 (SCREENREGIONP 10568 . 10750)) (12196 19557 (\BBTCURVEPT 12206 . 19555)) (
19558 29374 (CREATETEXTUREFROMBITMAP 19568 . 21498) (PRINTBITMAP 21500 . 22851) (PRINT-BITMAPS-NICELY
22853 . 26704) (PRINTCURSOR 26706 . 27739) (\WRITEBITMAP 27741 . 29372)) (29417 31965 (\GETINTEGERPART
29427 . 30972) (\CONVERTTOFRACTION 30974 . 31963)) (32102 32974 (CURSORP 32112 . 32331) (CURSORBITMAP
32333 . 32379) (CreateCursorBitMap 32381 . 32972)) (37336 46379 (CARET 37346 . 39106) (\CARET.CREATE
39108 . 39286) (\CARET.DOWN 39288 . 40640) (\CARET.FLASH? 40642 . 42456) (\CARET.SHOW 42458 . 43027) (
CARETRATE 43029 . 43687) (\CARET.FLASH.AGAIN 43689 . 44855) (\CARET.FLASH.MULTIPLE 44857 . 45380) (
\CARET.FLASH 45382 . 46377)) (46380 51452 (\MEDW.CARET.SHOW 46390 . 51450)) (51816 53651 (
\AREAVISIBLE? 51826 . 52750) (\REGIONOVERLAPAREAP 52752 . 53297) (\AREAINREGIONP 53299 . 53649)) (
53700 66176 (CREATEREGION 53710 . 54046) (REGIONP 54048 . 54194) (INTERSECTREGIONS 54196 . 56966) (
UNIONREGIONS 56968 . 59119) (REGIONSINTERSECTP 59121 . 59729) (SUBREGIONP 59731 . 60376) (EXTENDREGION
60378 . 62535) (EXTENDREGIONBOTTOM 62537 . 63179) (EXTENDREGIONLEFT 63181 . 63800) (EXTENDREGIONRIGHT
63802 . 64355) (EXTENDREGIONTOP 64357 . 64898) (INSIDEP 64900 . 65668) (STRINGREGION 65670 . 66174))
(66421 71695 (\BRUSHBITMAP 66431 . 68148) (\GETBRUSH 68150 . 68461) (\GETBRUSHBBT 68463 . 70491) (
\InitCurveBrushes 70493 . 71559) (\BrushFromWidth 71561 . 71693)) (71696 74763 (\MAKEBRUSH.DIAGONAL
71706 . 71986) (\MAKEBRUSH.HORIZONTAL 71988 . 72382) (\MAKEBRUSH.VERTICAL 72384 . 72696) (
\MAKEBRUSH.SQUARE 72698 . 72975) (\MAKEBRUSH.ROUND 72977 . 74761)) (74764 75929 (INSTALLBRUSH 74774 .
75927)) (76330 87732 (\DRAWLINE.DISPLAY 76340 . 86447) (RELMOVETO 86449 . 86836) (MOVETOUPPERLEFT
86838 . 87730)) (87733 111218 (\CLIPANDDRAWLINE 87743 . 94189) (\CLIPANDDRAWLINE1 94191 . 105939) (
\CLIPCODE 105941 . 107315) (\LEASTPTAT 107317 . 107915) (\GREATESTPTAT 107917 . 108545) (\DRAWLINE1
108547 . 109663) (\DRAWLINE.UFN 109665 . 111216)) (115748 161795 (\DRAWCIRCLE.DISPLAY 115758 . 124571)
(\DRAWARC.DISPLAY 124573 . 124863) (\DRAWARC.GENERIC 124865 . 125618) (\COMPUTE.ARC.POINTS 125620 .
127885) (\DRAWELLIPSE.DISPLAY 127887 . 143556) (\DRAWCURVE.DISPLAY 143558 . 145847) (
\DRAWPOINT.DISPLAY 145849 . 147045) (\DRAWPOLYGON.DISPLAY 147047 . 150575) (\LINEWITHBRUSH 150577 .
161793)) (161796 193488 (LOADPOLY 161806 . 162366) (PARAMETRICSPLINE 162368 . 172565) (\CURVE 172567
. 178169) (\CURVE2 178171 . 189502) (\CURVEEND 189504 . 189986) (\CURVESLOPE 189988 . 192471) (
\CURVESTART 192473 . 192797) (\FDIFS/FROM/DERIVS 192799 . 193486)) (206017 220353 (\FILLCIRCLE.DISPLAY
206027 . 216775) (\LINEBLT 216777 . 220351)) (220397 222397 (SCREENBITMAP 220407 . 220884) (BITMAPP
220886 . 221120) (BITMAPHEIGHT 221122 . 221498) (BITSPERPIXEL 221500 . 222395)) (223038 224031 (
DSPFILL 223048 . 223731) (INVERTW 223733 . 224029)) (224032 227675 (\DSPCOLOR.DISPLAY 224042 . 225339)
(\DSPBACKCOLOR.DISPLAY 225341 . 226720) (DSPEOLFN 226722 . 227673)) (228108 232762 (DSPCLEOL 228118
. 228994) (DSPRUBOUTCHAR 228996 . 229428) (\DSPMOVELR 229430 . 232760)) (232892 234010 (
\CURSOR.DEFPRINT 232902 . 234008)) (234422 242996 (TEXTUREOFCOLOR 234432 . 235694) (\PRIMARYTEXTURE
235696 . 236278) (\LEVELTEXTURE 236280 . 236781) (INSURE.B&W.TEXTURE 236783 . 238178) (
INSURE.RGB.COLOR 238180 . 239608) (\LOOKUPCOLORNAME 239610 . 239880) (RGBP 239882 . 240647) (HLSP
240649 . 241024) (HLSTORGB 241026 . 242166) (\HLSVALUEFN 242168 . 242994)))))
STOP

Binary file not shown.