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

(FILECREATED "15-Aug-90 17:04:07" {DSK}<usr>local>lde>SOURCES>loops>LIBRARY>GAUGESCALES.;2
 17762  

      changes to%:  (VARS GAUGESCALESCOMS)

      previous date%: "11-Mar-88 12:05:26" {DSK}<usr>local>lde>SOURCES>loops>LIBRARY>GAUGESCALES.;1
)


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

(PRETTYCOMPRINT GAUGESCALESCOMS)

(RPAQQ GAUGESCALESCOMS

       ((DECLARE%: DONTCOPY (PROP MAKEFILE-ENVIRONMENT GAUGESCALES)
               (PROP FILETYPE GAUGESCALES))
        (FILES (FROM VALUEOF LOOPSLIBRARYDIRECTORY)
               GAUGEBOUNDEDMIXIN GAUGEINSTRUMENTS)
        (CLASSES HSGraphics VSGraphics)
        (METHODS HSGraphics.ShowLabels HSGraphics.ShowTicks)
        (METHODS VSGraphics.ShowLabels VSGraphics.ShowTicks)
        (CLASSES HorizontalScale VerticalScale)
        (METHODS HorizontalScale.DrawInstrument HorizontalScale.Set HorizontalScale.SetParameters 
               HorizontalScale.ShowReading VerticalScale.DrawInstrument VerticalScale.OutOfBounds 
               VerticalScale.Set VerticalScale.SetParameters VerticalScale.ShowReading)))
(DECLARE%: DONTCOPY 

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


(PUTPROPS GAUGESCALES
 FILETYPE
 :COMPILE-FILE)
)

(FILESLOAD (FROM
 VALUEOF LOOPSLIBRARYDIRECTORY)
       GAUGEBOUNDEDMIXIN GAUGEINSTRUMENTS)

(DEFCLASSES HSGraphics VSGraphics)
(DEFCLASS HSGraphics

   (MetaClass AbstractClass Edited%: 
                    (* edited%: "31-Oct-86 21:12")

          doc "Abstract classes are placeholders in the inheritance network, which cannot themselves be instantiated."
          )
   (Supers StraightScale)
   (InstanceVariables (height 57 doc "a window high enough for 11 labels")
          (scaleBottom 10 doc "bottom edge of scale")
          (scaleLeft 12 min 3 doc "left edge of scale")
          (scaleWidth 120 doc "width of inside of scale")
          (scaleHeight 15 doc "height of scale")
          (width 208)))

(DEFCLASS VSGraphics

   (MetaClass AbstractClass Edited%: 
                    (* edited%: "31-Oct-86 21:11")

          doc "Abstract classes are placeholders in the inheritance network, which cannot themselves be instantiated."
          )
   (Supers StraightScale)
   (InstanceVariables (height 160 doc "a window high enough for 11 labels")
          (scaleLeft 15 doc "left edge of scale")
          (scaleHeight 120 doc "height of scale")
          (scaleWidth 15 doc "width of inside of scale")
          (scaleBottom 12 doc "bottom edge of scale")
          (width 77)))


(\BatchMethodDefs)
(METH HSGraphics  ShowLabels NIL

      "Put labels next to ticks" (category (HSGraphics)))


(METH HSGraphics  ShowTicks NIL

      "Show ticks along top edge of scale" (category (HSGraphics)))



(Method ((HSGraphics ShowLabels)
 self)                   (* ; "edited: 31-Oct-86 21:14")

   "Put labels next to ticks"
   [PROG ((ticks (@ ticks))
          (window (@ window)))
         (AND ticks (PROG (xpos (ylabel (IPLUS (@ scaleBottom)
                                               (@ scaleHeight)
                                               (@ ticks%:,tickLength)
                                               8)))

         (* in ylabel calculation, 8 is used for 4 pixels of space on either side of 

       tick. Refer to HorizontalScale.ShowTicks)


                          (SETQ xpos (EvenIntervals (@ scaleLeft)
                                            (@ scaleWidth)
                                            (SUB1 ticks)
                                            T))
                          (for
 x in
 xpos as
 lab in
 (@ labels)
                             bind
 (font _ (@ font))
                             do
 (MOVETO (IDIFFERENCE x (IQUOTIENT (STRINGWIDTH lab font)
                                                                  2))
                                           ylabel window)
                                   (PRIN1 lab window])

(Method ((HSGraphics ShowTicks)
 self)                    (* ; "edited: 31-Oct-86 21:14")

   "Show ticks along top edge of scale"
   [PROG ((ticks (@ ticks)))
         (AND ticks (PROG ((tickY (IPLUS (@ scaleBottom)
                                         (@ scaleHeight)
                                         4))
                           (tickXs (EvenIntervals (@ scaleLeft)
                                          (@ scaleWidth)
                                          (SUB1 ticks)
                                          T)))
                          (for
 XT on
 tickXs do
 (DrawVTick self (CAR XT)
                                                                  tickY
                                                                  (AND (CDR XT)
                                                                       (IDIFFERENCE (CADR XT)
                                                                              (CAR XT])

(\UnbatchMethodDefs)

(\BatchMethodDefs)
(METH VSGraphics  ShowLabels NIL

      "Put labels next to ticks" (category (VSGraphics)))


(METH VSGraphics  ShowTicks NIL

      "Show ticks along right edge of scale" (category (VSGraphics)))



(Method ((VSGraphics ShowLabels)
 self)                   (* ; "JRB 30-Jan-87 04:42")

   "Put labels next to ticks"
   [PROG ((window (@ window))
          (ticks (@ ticks))
          (precision (@ labels%:,precision))
          (font (@ font))
          (labels (@ labels)))
         (AND ticks (PROG (ypos (xlabel (IPLUS (@ scaleLeft)
                                               (@ scaleWidth)
                                               (@ ticks%:,tickLength)
                                               6)))
                          (SETQ ypos (EvenIntervals (IDIFFERENCE (@ scaleBottom)
                                                           (FONTPROP font 'DESCENT))
                                            (@ scaleHeight)
                                            (SUB1 ticks)
                                            T))
                          (for
 y in
 ypos as
 lab in
 labels
                             bind
 minusoff _
                                   (if
 [OR (MINUSP (MKATOM (CAR labels)))
                                               (MINUSP (MKATOM (CAR (LAST labels]
                                       then
 (CHARWIDTH (CHARCODE -
)
                                                       font))
                             do
 (MOVETO xlabel y window)
                                   (if
 minusoff
                                       then
 (if
 (NOT (MINUSP (MKATOM LAB)))
                                                    then
 (RELMOVETO minusoff 0 window)))
                                   (PRIN1 lab window])

(Method ((VSGraphics ShowTicks)
 self)                    (* ; "edited: 31-Oct-86 21:13")

   "Show ticks along right edge of scale"
   [PROG ((tickX (IPLUS (@ scaleLeft)
                        (@ scaleWidth)
                        4))
          (tickYs (EvenIntervals (@ scaleBottom)
                         (@ scaleHeight)
                         (SUB1 (@ ticks))
                         T)))
         (for
 YT on
 tickYs do
 (DrawHTick self tickX (CAR YT)
                                                 (AND (CDR YT)
                                                      (IDIFFERENCE (CADR YT)
                                                             (CAR YT])

(\UnbatchMethodDefs)

(DEFCLASSES HorizontalScale VerticalScale)
(DEFCLASS HorizontalScale

   (MetaClass Class doc "A labelled bounded scale with a bar which fills to the right" Edited%: 

                                                             (* edited%: "27-Jan-87 11:27")
)
   (Supers HSGraphics))

(DEFCLASS VerticalScale

   (MetaClass Class doc 
          "A labelled bounded scale with a black bar which rises proportional to its reading" 
          Edited%: 
                                      (* ; "Edited  9-Mar-88 16:39 by jrb:")

          )
   (Supers VSGraphics)
   (InstanceVariables (height 160 doc "a window high enough for 11 labels" min 160)
          (width 77)
          (scaleWidth 15 doc "width of inside of scale")
          (scaleHeight 120 doc "height of scale")
          (scaleLeft 15 doc "left edge of scale")
          (scaleBottom 12 doc "bottom edge of scale")))


(\BatchMethodDefs)
(METH HorizontalScale  DrawInstrument NIL

      "Draw a horizontal tube for instrument" (category (HorizontalScale)))


(METH HorizontalScale  Set (newReading)

      "show reading on horizontal scale" (category (HorizontalScale)))


(METH HorizontalScale  SetParameters NIL

      "Set scale width from width" (category (Internal)))


(METH HorizontalScale  ShowReading NIL

      "dgb:  9-JUN-83 22:37" (category (HorizontalScale)))


(METH VerticalScale  DrawInstrument NIL

      "Draw a vertical tube for instrument" (category (VerticalScale)))


(METH VerticalScale  OutOfBounds (outFlg)

      "Print ? if out, space other wise" (category (VerticalScale)))


(METH VerticalScale  Set (reading)

      "show reading on vertical scale" (category (VerticalScale)))


(METH VerticalScale  SetParameters NIL

      "Set scale height from height" (category (Internal)))


(METH VerticalScale  ShowReading NIL

      "show the line at initial level. intrnal displayVal is really line heigt" (category (
                                                                                        VerticalScale
                                                                                           )))



(Method ((HorizontalScale DrawInstrument)
 self)          (* ; "dgb: 21-FEB-83 11:39")

   "Draw a horizontal tube for instrument"
   (DrawBox (@ scaleLeft)
          (@ scaleBottom)
          (ADD1 (@ scaleWidth))
          (@ scaleHeight)
          1
          'PAINT
          (@ window)))

(Method ((HorizontalScale Set)
 self newReading)          (* ; "edited: 15-May-86 00:53")

   "show reading on horizontal scale"
   (_@ reading newReading)
   [PROG ((y (ADD1 (@ scaleBottom)))
          (w (SUB1 (@ scaleHeight)))
          (displayVal (@ displayVal))
          (newSetting (_ self ComputeDisplayVal newReading))
          (window (@ window))
          (shade (@ shade)))
         (_@ displayVal newSetting)
         (COND
            ((GREATERP displayVal newSetting)
             (LineLeft displayVal newSetting y window w))
            ((GREATERP newSetting displayVal)
             (LineRight displayVal newSetting y window w shade])

(Method ((HorizontalScale SetParameters)
 self)           (* ; "edited: 28-Jan-87 21:59")

   "Set scale width from width"
   [PROG [(mxStrWidth (MAXSTRINGWIDTH (@ labels)
                             (@ font)]
         (_Super )
         (_@ scaleBottom (@ spaceForLabelScale))
         (_@ width%:,min [WIDTHIFWINDOW (IMAX [PLUS [TIMES 2 (_@ scaleLeft (IMAX (PLUS 2
                                                                                       (QUOTIENT
                                                                                        mxStrWidth 2)
                                                                                       )
                                                                                 (@ scaleLeft%:,min)))
                                                           ]
                                                    (TIMES (COND
                                                              ((@ ticks)
                                                               (SUB1 (@ ticks)))
                                                              (T 1))
                                                           (PLUS mxStrWidth (CHARWIDTH (CHARCODE
                                                                                        0)
                                                                                   (@ font)]
                                              (STRINGWIDTH "x-10-00  ??" (@ font)])
         (_@ width (IMAX (@ width)
                         (@ width%:,min)))
         (_@ range (_@ scaleWidth (IPLUS (InteriorWidth self)
                                         -2
                                         (ITIMES -2 (@ scaleLeft)))))
         (_@ displayVal (_@ lower (ADD1 (@ scaleLeft))))
         (_@ height%:,min (HEIGHTIFWINDOW (IPLUS (@ spaceForLabelScale)
                                                 (@ scaleHeight)
                                                 (COND
                                                    ((@ ticks)
                                                             (* add 8 to tickLength for extra 

                                                           space on each end of tick.)

                                                     (PLUS 8 (@ ticks%:,tickLength)))
                                                    (T 3))
                                                 (FONTHEIGHT (@ font)))
                                 (@ title)))
         (_@ height (IMAX (@ height)
                          (@ height%:,min)))])

(Method ((HorizontalScale ShowReading)
 self)             (* ; "edited: 15-May-86 00:45")

   "dgb:  9-JUN-83 22:37"                                    (* ; 

                         "show the line at initial level. intrnal displayVal is really line height")

   (LineRight (ADD1 (@ scaleLeft))
          (_@ displayVal (_ self ComputeDisplayVal (@ reading)))
          (ADD1 (@ scaleBottom))
          (@ window)
          (SUB1 (@ scaleHeight))
          (@ shade)))

(Method ((VerticalScale DrawInstrument)
 self)            (* ; "dgb: 30-JAN-83 12:40")

   "Draw a vertical tube for instrument"
   (DrawBox (@ scaleLeft)
          (@ scaleBottom)
          (@ scaleWidth)
          (ADD1 (@ scaleHeight))
          1
          'PAINT
          (@ window)))

(Method ((VerticalScale OutOfBounds)
 self outFlg)        (* ; "edited: 27-Jan-87 11:38")

   "Print ? if out, space other wise"
   [LET* ((font (@ font))
          (strWidth (STRINGWIDTH "??" font))
          (leftPos (IDIFFERENCE (@ width%:,min)
                          (PLUS (TIMES 2 (WINDOWPROP (@ window)
                                                'BORDER))
                                strWidth)))
          (window (@ window)))
         (COND
            (outFlg (MOVETO leftPos 1 window)
                   (PRIN1 "??" (@ window)))
            (T (BITBLT NIL NIL NIL window leftPos 0 strWidth (FONTHEIGHT font)
                      'TEXTURE
                      'REPLACE WHITESHADE])

(Method ((VerticalScale Set)
 self reading)               (* ; "edited: 15-May-86 00:54")

   "show reading on vertical scale"
   (_@ reading reading)
   [PROG ((x (ADD1 (@ scaleLeft)))
          (w (SUB1 (@ scaleWidth)))
          (displayVal (@ displayVal))
          (newSetting (_ self ComputeDisplayVal reading)))
         (_@ displayVal newSetting)
         (COND
            ((GREATERP displayVal newSetting)
             (LineLower x displayVal newSetting (@ window)
                    w))
            ((GREATERP newSetting displayVal)
             (LineRaise x displayVal newSetting (@ window)
                    w
                    (@ shade)])

(Method ((VerticalScale SetParameters)
 self)             (* ; "edited: 28-Oct-86 16:59")

   "Set scale height from height"
   (_Super )
   (_@ height%:,min (HEIGHTIFWINDOW [PLUS (@ spaceForLabelScale)
                                          (TIMES (ADD1 (@ ticks))
                                                 (FONTHEIGHT (@ font)]
                           (@ title)))                       (* ; 

                  "need to ADD1 here to make sure that lowest label does not run into label scale.")

   (_@ height (IMAX (@ height)
                    (@ height%:,min)))
   (_@ scaleBottom (PLUS (IQUOTIENT (FONTHEIGHT (@ font))
                                2)
                         (@ spaceForLabelScale)))
   (_@ range (_@ scaleHeight (IDIFFERENCE (InteriorHeight self)
                                    (IPLUS (FONTHEIGHT (@ font))
                                           (@ scaleBottom)))))
   (_@ displayVal (_@ lower (ADD1 (@ scaleBottom))))
   (_@ width%:,min [WIDTHIFWINDOW (IMAX (IPLUS (@ scaleLeft)
                                               (@ scaleWidth)
                                               (COND
                                                  ((@ ticks)
                                                   (IPLUS (@ ticks%:,tickLength)
                                                          8))
                                                  (T 4))
                                               (MAXSTRINGWIDTH (@ labels)
                                                      (@ font)))
                                        (STRINGWIDTH "x-10-00  ??" (@ font)])
   (_@ width (IMAX (@ width)
                   (@ width%:,min))))

(Method ((VerticalScale ShowReading)
 self)               (* ; "edited: 15-May-86 01:06")

   "show the line at initial level. intrnal displayVal is really line heigt"
   (ChangeVerticalSetting (ADD1 (@ scaleLeft))
          (ADD1 (@ scaleBottom))
          (_@ displayVal (_ self ComputeDisplayVal (@ reading)))
          (@ window)
          (SUB1 (@ scaleWidth))
          (@ shade)))

(\UnbatchMethodDefs)
(PUTPROPS GAUGESCALES COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL)))
STOP