(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "29-Apr-87 13:49:14" {PHYLUM}<CTAMARIN>EMULATOR>ACTIVEREGIONS.;2
 9616   

      changes to%:  (RECORDS ACTIVEREGION)

      previous date%: "17-Jun-85 17:24:40" {PHYLUM}<CTAMARIN>EMULATOR>ACTIVEREGIONS.;1)


(* "
Copyright (c) 1983, 1984, 1985, 1987 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 'ACTIVEREGIONS Regionlist)
          [WINDOWPROP Window 'HIGHLIGHTFN (AND Regionlist (OR Highlightfn (FUNCTION 
                                                                     ACTIVEREGIONS/DEFAULTHIGHLIGHTFN
                                                                           ]
          [WINDOWPROP Window 'LOWLIGHTFN (AND Regionlist (OR Lowlightfn Highlightfn
                                                             (FUNCTION 
                                                              ACTIVEREGIONS/DEFAULTHIGHLIGHTFN]
          (WINDOWPROP Window 'BUTTONEVENTFN (AND Regionlist (FUNCTION ACTIVEREGIONS/BUTTONEVENTFN)))
          (WINDOWPROP Window '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 'ACTIVEREGIONS (CONS Activeregion (WINDOWPROP Window '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 'ACTIVEREGIONS (DREMOVE Activeregion (WINDOWPROP Window '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 'TITLEBARACTIVEREGION))
        [for
 X in
 (OR Regionlist/optional (WINDOWPROP Window '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 '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 '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 'ACTIVEREGIONS))
                                              (LASTPLACE ← (GETPICKREGION
 Window))
                                              PRIORLASTPLACE MOUSEBUTTON HelpPrintedFlg TimeIn
       do
 (SETQ LASTPLACE (SETPICKREGION
 Window (FINDACTIVEREGION
 Window (LASTMOUSEX Window)
                                                       (LASTMOUSEY Window)
                                                       PLACELIST)))
          [COND
             ((KEYDOWNP 'LEFT)
              (SETQ MOUSEBUTTON 'LEFT))
             ((KEYDOWNP 'MIDDLE)
              (SETQ MOUSEBUTTON '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 'HIGHLIGHTFN)
                (FUNCTION NILL))
           Window Activeregion)
    (WINDOWPROP Window 'PICKREGION Activeregion])

(ACTIVEREGIONS/DOLOWLIGHT

  [LAMBDA (Window Activeregion)
                              (* DRB%: " 2-SEP-82 15:11")

    (APPLY* (OR (fetch
 (ACTIVEREGION LOWLIGHTFN) of
 Activeregion)
                (WINDOWPROP Window 'LOWLIGHTFN)
                (FUNCTION NILL))
           Window Activeregion)
    (WINDOWPROP Window '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)
                                'TEXTURE
                                '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)
                       'TEXTURE
                       '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 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1143 4829 (SETACTIVEREGIONS 1153 . 2091) (ADDACTIVEREGION 2093 . 2420) (
DELETEACTIVEREGION 2422 . 2865) (FINDACTIVEREGION 2867 . 3689) (SETPICKREGION 3691 . 4673) (
GETPICKREGION 4675 . 4827)) (4855 9498 (ACTIVEREGIONS/BUTTONEVENTFN 4865 . 6871) (
ACTIVEREGIONS/CHECKPOSITION 6873 . 7442) (ACTIVEREGIONS/DOHIGHLIGHT 7444 . 7810) (
ACTIVEREGIONS/DOLOWLIGHT 7812 . 8166) (ACTIVEREGIONS/DEFAULTHIGHLIGHTFN 8168 . 9304) (
ACTIVEREGIONS/MULTIPLEREGIONS? 9306 . 9496)))))
STOP