(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)

(FILECREATED "15-Aug-90 15:34:38" {DSK}<usr>local>lde>SOURCES>loops>LIBRARY>GAUGEACTIVE.;2
 6840   

      changes to%:  (VARS GAUGEACTIVECOMS)

      previous date%: "23-Feb-88 23:30:19" {DSK}<usr>local>lde>SOURCES>loops>LIBRARY>GAUGEACTIVE.;1
)


(* ; "
Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT GAUGEACTIVECOMS)

(RPAQQ GAUGEACTIVECOMS

       ((DECLARE%: DONTCOPY (PROP MAKEFILE-ENVIRONMENT GAUGEACTIVE))
        (FILES (FROM VALUEOF LOOPSLIBRARYDIRECTORY)
               GAUGESCALES)
        (CLASSES ActiveGaugeMixin ActiveHorizontalScale ActiveVerticalScale)
        (METHODS ActiveGaugeMixin.Attach ActiveGaugeMixin.Change)
        (CURSORS HorizontalAGCursor VerticalAGCursor)
        (FNS MakeActiveGaugeMenu)
        (P (MakeActiveGaugeMenu))))
(DECLARE%: DONTCOPY 

(PUTPROPS GAUGEACTIVE
 MAKEFILE-ENVIRONMENT
 (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10))
)

(FILESLOAD (FROM
 VALUEOF LOOPSLIBRARYDIRECTORY)
       GAUGESCALES)

(DEFCLASSES ActiveGaugeMixin ActiveHorizontalScale ActiveVerticalScale)
(DEFCLASS ActiveGaugeMixin

   (MetaClass AbstractClass Edited%: 
                    (* edited%: "29-Jan-87 00:03")

          doc "Abstract classes are placeholders in the inheritance network, which cannot themselves be instantiated."
          )
   (Supers Object)
   (InstanceVariables (cursor NIL doc "the cursor to use when changing the scale.")
          (fixedNewValue? NIL doc "set to T if the value returned from the user interaction is to be a fixnum and not a floating point number."
                 )))

(DEFCLASS ActiveHorizontalScale

   (MetaClass Class Edited%: 
                            (* edited%: "29-Jan-87 00:21")

          doc "This is the default metaClass for all classes")
   (Supers ActiveGaugeMixin HorizontalScale)
   (ClassVariables (CARorCDR CAR doc "used to extract the xcoord of the mouse position"))
   (InstanceVariables (cursor NIL %:initForm HorizontalAGCursor)))

(DEFCLASS ActiveVerticalScale

   (MetaClass Class Edited%: 
                            (* edited%: "29-Jan-87 00:20")

          doc "This is the default metaClass for all classes")
   (Supers ActiveGaugeMixin VerticalScale)
   (ClassVariables (CARorCDR CDR doc "used to extract the ycoord of the mouse position"))
   (InstanceVariables (cursor NIL %:initForm VerticalAGCursor)))


(\BatchMethodDefs)
(METH ActiveGaugeMixin  Attach (obj varName propName type xOrPos y)

      "Attach Set button if it isn't there already" (category (ActiveGaugeMixin)))


(METH ActiveGaugeMixin  Change NIL

      "Update gauge when attached variable is accessed" (category (ActiveGauge)))



(Method ((ActiveGaugeMixin Attach)
 self obj varName propName type xOrPos y)
   "Attach Set button if it isn't there already"
   (PROG1 (_Super )
       (OR (for
 w in
 (ATTACHEDWINDOWS (@ window)) thereis
 (WINDOWPROP w 'GAUGE))
           (LET [(newButton (create
 MENU
                                   ITEMS _ '((Set NIL 
                                            "Set the value of the variable the gauge is attached to."
                                                  ))
                                   CENTERFLG _ T
                                   WHENSELECTEDFN _ (FUNCTION (LAMBDA (ITEM MENU)
                                                                (_ (WINDOWPROP (WFROMMENU MENU)
                                                                          'GAUGE)
                                                                   Change)]

                (* ;; "Attach the new button to the gauge's window, and put the gauge on the button's window so it can find the gauge")


                (ATTACHMENU newButton (@ window)
                       'BOTTOM)
                (WINDOWPROP (WFROMMENU newButton)
                       'GAUGE self)))))

(Method ((ActiveGaugeMixin Change)
 self)                 (* ; "RBGMartin 30-Jan-87 03:19")

   "Update gauge when attached variable is accessed"
   (COND
      [(_ self Attached? T)
       (RESETLST
           (RESETSAVE (CURSOR (@ cursor)))
           (until
 (MOUSESTATE LEFT) do
 (BLOCK))
           (bind
 (av _ (CAR (@ containedInAV)))
                  avObject avVarName avPropName avType newValue until
 (MOUSESTATE (NOT LEFT))
              first
 (SETQ avObject (@ av object))
                    (SETQ avVarName (@ av varName))
                    (SETQ avPropName (@ av propName))
                    (SETQ avType (@ av type))
              do
 (BLOCK)
                    [SETQ newValue (PLUS (@ inputLower)
                                         (TIMES (@ inputRange)
                                                (FQUOTIENT (DIFFERENCE (APPLY* (@ |::CARorCDR|)
                                                                              (CURSORPOSITION
                                                                               NIL
                                                                               (@ window)))
                                                                  (@ lower))
                                                       (@ range)]
                    (PutIt avObject avVarName (COND
                                                 ((@ fixedNewValue?)
                                                  (FIXR newValue))
                                                 (T newValue))
                           avPropName avType)))]
      (T (_ self PromptPrint "Not Attached"))))

(\UnbatchMethodDefs)
(RPAQ HorizontalAGCursor (CURSORCREATE (QUOTE #*(16 16)OOOOOO@AOOOO@A@@@CH@@GL@@ON@AOO@COOH@CH@@CH@@CH@@CH@@CH@@CH@@CH@
) (QUOTE NIL) 7 15))
(RPAQ VerticalAGCursor (CURSORCREATE (QUOTE #*(16 16)N@@@J@@@J@@@J@H@JAH@JCH@JGH@JOOOOOOONOOONGH@NCH@NAH@N@H@N@@@N@@@
) (QUOTE NIL) 0 7))
(DEFINEQ

(MakeActiveGaugeMenu

  [LAMBDA NIL
                                                (* edited%: "21-May-86 15:16")

    (SETQ ActiveGaugeMenu (create
 MENU
                                 ITEMS _ '((Set NIL 
                                            "Set the value of the variable the gauge is attached to."
                                                ))
                                 CENTERFLG _ T
                                 WHENSELECTEDFN _ (FUNCTION (LAMBDA (ITEM MENU)
                                                              (_ (WINDOWPROP (WFROMMENU MENU)
                                                                        'GAUGE)
                                                                 Change)])
)

(MakeActiveGaugeMenu
)
(PUTPROPS GAUGEACTIVE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (5946 6707 (MakeActiveGaugeMenu 5956 . 6705)))))
STOP