(FILECREATED "17-Jun-85 17:24:40" {SDRVX5}INTERLISP$DISK:<INTERMEZZO.STC>ACTIVEREGIONS.;4 8471
previous date: "14-Jun-85 13:39:18" {SDRVX5}INTERLISP$DISK:<HARMONY.STC>ACTIVEREGIONS.;7)
(* Copyright (c) 1983, 1984, 1985 by Schlumberger Technology Corporation. All rights reserved.)
(PRETTYCOMPRINT ACTIVEREGIONSCOMS)
(RPAQQ ACTIVEREGIONSCOMS ((* * public part)
(RECORDS ACTIVEREGION)
(FNS SETACTIVEREGIONS ADDACTIVEREGION DELETEACTIVEREGION FINDACTIVEREGION
SETPICKREGION GETPICKREGION)
(* * private part)
(FNS ACTIVEREGIONS/BUTTONEVENTFN ACTIVEREGIONS/CHECKPOSITION
ACTIVEREGIONS/DOHIGHLIGHT ACTIVEREGIONS/DOLOWLIGHT
ACTIVEREGIONS/DEFAULTHIGHLIGHTFN ACTIVEREGIONS/MULTIPLEREGIONS?)))
(* * public part)
[DECLARE: EVAL@COMPILE
(RECORD ACTIVEREGION (REGION HELPSTRING DOWNFN UPFN HIGHLIGHTFN LOWLIGHTFN DATA))
]
(DEFINEQ
(SETACTIVEREGIONS
(LAMBDA (Window Regionlist Highlightfn Lowlightfn) (* DRB: " 1-SEP-82 15:28")
(COND
((NOT (WINDOWP Window))
(ERROR "SETACTIVEREGIONS: ARG NOT WINDOW" Window))
(T (WINDOWPROP Window (QUOTE ACTIVEREGIONS)
Regionlist)
(WINDOWPROP Window (QUOTE HIGHLIGHTFN)
(AND Regionlist (OR Highlightfn (FUNCTION ACTIVEREGIONS/DEFAULTHIGHLIGHTFN))))
(WINDOWPROP Window (QUOTE LOWLIGHTFN)
(AND Regionlist (OR Lowlightfn Highlightfn (FUNCTION
ACTIVEREGIONS/DEFAULTHIGHLIGHTFN))))
(WINDOWPROP Window (QUOTE BUTTONEVENTFN)
(AND Regionlist (FUNCTION ACTIVEREGIONS/BUTTONEVENTFN)))
(WINDOWPROP Window (QUOTE PICKREGION)
NIL)))))
(ADDACTIVEREGION
(LAMBDA (Window Activeregion) (* DRB: " 1-SEP-82 15:17")
(COND
((NOT (WINDOWP Window))
(ERROR "ADDACTIVEREGION: ARG NOT WINDOW" Window)
NIL)
(T (WINDOWPROP Window (QUOTE ACTIVEREGIONS)
(CONS Activeregion (WINDOWPROP Window (QUOTE ACTIVEREGIONS))))))))
(DELETEACTIVEREGION
(LAMBDA (Window Activeregion) (* DRB: " 1-SEP-82 15:21")
(COND
((NOT (WINDOWP Window))
(ERROR "DELETEACTIVEREGION: ARG NOT WINDOW" Window)
NIL)
(T (AND (EQ Activeregion (GETPICKREGION Window))
(SETPICKREGION Window NIL))
(WINDOWPROP Window (QUOTE ACTIVEREGIONS)
(DREMOVE Activeregion (WINDOWPROP Window (QUOTE ACTIVEREGIONS))))))))
(FINDACTIVEREGION
(LAMBDA (Window Xcoord Ycoord Regionlist/optional) (* psb: " 5-JUL-84 15:11")
(OR (AND (NOT (INSIDEP (DSPCLIPPINGREGION NIL Window)
Xcoord Ycoord))
(WINDOWPROP Window (QUOTE TITLEBARACTIVEREGION)))
(for X in (OR Regionlist/optional (WINDOWPROP Window (QUOTE ACTIVEREGIONS)))
thereis (COND
((ACTIVEREGIONS/MULTIPLEREGIONS? X)
(for R in (fetch (ACTIVEREGION REGION) of X) thereis (
ACTIVEREGIONS/CHECKPOSITION R Xcoord Ycoord)))
(T (ACTIVEREGIONS/CHECKPOSITION (fetch (ACTIVEREGION REGION) of X)
Xcoord Ycoord))))
(WINDOWPROP Window (QUOTE DEFAULTACTIVEREGION)))))
(SETPICKREGION
(LAMBDA (Window Activeregion Oldregion/local) (* ejs: "12-MAR-84 11:27")
(COND
((NOT (WINDOWP Window))
(ERROR "DELETEACTIVEREGION: ARG NOT WINDOW" Window)
NIL)
((NEQ Activeregion (SETQ Oldregion/local (GETPICKREGION Window)))
(AND Oldregion/local (ACTIVEREGIONS/DOLOWLIGHT Window Oldregion/local))
(AND Activeregion (PROGN (APPLY* (OR (fetch (ACTIVEREGION DOWNFN) of Activeregion)
(FUNCTION NILL))
Window
(fetch (ACTIVEREGION REGION) of Activeregion)
(fetch (ACTIVEREGION DATA) of Activeregion))
(MOUSESTATE (OR LEFT MIDDLE)))
(PROGN (ACTIVEREGIONS/DOHIGHLIGHT Window Activeregion)
Activeregion)))
(T Activeregion))))
(GETPICKREGION
(LAMBDA (Window) (* DRB: " 1-SEP-82 10:43")
(WINDOWPROP Window (QUOTE PICKREGION))))
)
(* * private part)
(DEFINEQ
(ACTIVEREGIONS/BUTTONEVENTFN
(LAMBDA (Window) (* rgs: "14-Jun-85 12:56")
(DECLARE (GLOBALVARS MENUHELDWAIT))
(while (MOUSESTATE (OR LEFT MIDDLE))
bind (PLACELIST ←(WINDOWPROP Window (QUOTE ACTIVEREGIONS)))
(LASTPLACE ←(GETPICKREGION Window))
PRIORLASTPLACE MOUSEBUTTON HelpPrintedFlg TimeIn
do (SETQ LASTPLACE (SETPICKREGION Window (FINDACTIVEREGION Window (LASTMOUSEX Window)
(LASTMOUSEY Window)
PLACELIST)))
(COND
((KEYDOWNP (QUOTE LEFT))
(SETQ MOUSEBUTTON (QUOTE LEFT)))
((KEYDOWNP (QUOTE MIDDLE))
(SETQ MOUSEBUTTON (QUOTE MIDDLE))))
(COND
((EQ LASTPLACE PRIORLASTPLACE)
(COND
(HelpPrintedFlg)
((AND (fetch (ACTIVEREGION HELPSTRING) of LASTPLACE)
(IGREATERP (IDIFFERENCE (CLOCK 0)
TimeIn)
MENUHELDWAIT))
(SETQ HelpPrintedFlg T)
(printout PROMPTWINDOW (fetch (ACTIVEREGION HELPSTRING) of LASTPLACE)
T))))
(T (SETQ HelpPrintedFlg NIL)
(SETQ TimeIn (CLOCK 0))))
(SETQ PRIORLASTPLACE LASTPLACE)
finally (PROGN (AND LASTPLACE (APPLY* (OR (fetch (ACTIVEREGION UPFN) of LASTPLACE)
(FUNCTION NILL))
Window
(fetch (ACTIVEREGION REGION) of LASTPLACE)
(fetch (ACTIVEREGION DATA) of LASTPLACE)
MOUSEBUTTON))
(RETURN LASTPLACE)))))
(ACTIVEREGIONS/CHECKPOSITION
(LAMBDA (Region Xcoord Ycoord) (* DRB: " 1-SEP-82 09:44")
(* Returns NIL unless (Xcoord Ycoord) is within Region)
(AND (IGEQ Xcoord (fetch (REGION LEFT) of Region))
(ILEQ Xcoord (fetch (REGION RIGHT) of Region))
(IGEQ Ycoord (fetch (REGION BOTTOM) of Region))
(ILEQ Ycoord (fetch (REGION TOP) of Region)))))
(ACTIVEREGIONS/DOHIGHLIGHT
(LAMBDA (Window Activeregion) (* DRB: " 2-SEP-82 15:10")
(APPLY* (OR (fetch (ACTIVEREGION HIGHLIGHTFN) of Activeregion)
(WINDOWPROP Window (QUOTE HIGHLIGHTFN))
(FUNCTION NILL))
Window Activeregion)
(WINDOWPROP Window (QUOTE PICKREGION)
Activeregion)))
(ACTIVEREGIONS/DOLOWLIGHT
(LAMBDA (Window Activeregion) (* DRB: " 2-SEP-82 15:11")
(APPLY* (OR (fetch (ACTIVEREGION LOWLIGHTFN) of Activeregion)
(WINDOWPROP Window (QUOTE LOWLIGHTFN))
(FUNCTION NILL))
Window Activeregion)
(WINDOWPROP Window (QUOTE PICKREGION)
NIL)))
(ACTIVEREGIONS/DEFAULTHIGHLIGHTFN
(LAMBDA (Window Activeregion) (* psb: " 5-JUL-84 15:14")
(PROG ((WC (DSPCLIPPINGREGION NIL Window)))
(COND
((ACTIVEREGIONS/MULTIPLEREGIONS? Activeregion)
(for R in (fetch (ACTIVEREGION REGION) of Activeregion)
thereis (BITBLT NIL NIL NIL Window (fetch (REGION LEFT) of WC)
(fetch (REGION BOTTOM) of WC)
(fetch (REGION WIDTH) of WC)
(fetch (REGION HEIGHT) of WC)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE R)))
(T (BITBLT NIL NIL NIL Window (fetch (REGION LEFT) of WC)
(fetch (REGION BOTTOM) of WC)
(fetch (REGION WIDTH) of WC)
(fetch (REGION HEIGHT) of WC)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE
(fetch (ACTIVEREGION REGION) of Activeregion)))))))
(ACTIVEREGIONS/MULTIPLEREGIONS?
(LAMBDA (Activeregion) (* rgs: "14-Jun-85 13:38")
(REGIONP (CAR (fetch REGION of Activeregion)))))
)
(PUTPROPS ACTIVEREGIONS COPYRIGHT ("Schlumberger Technology Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (898 4301 (SETACTIVEREGIONS 908 . 1706) (ADDACTIVEREGION 1708 . 2076) (
DELETEACTIVEREGION 2078 . 2554) (FINDACTIVEREGION 2556 . 3314) (SETPICKREGION 3316 . 4134) (
GETPICKREGION 4136 . 4299)) (4327 8359 (ACTIVEREGIONS/BUTTONEVENTFN 4337 . 5937) (
ACTIVEREGIONS/CHECKPOSITION 5939 . 6440) (ACTIVEREGIONS/DOHIGHLIGHT 6442 . 6814) (
ACTIVEREGIONS/DOLOWLIGHT 6816 . 7176) (ACTIVEREGIONS/DEFAULTHIGHLIGHTFN 7178 . 8159) (
ACTIVEREGIONS/MULTIPLEREGIONS? 8161 . 8357)))))
STOP