;******************************************************************************
;
; File name    :  mkVScale.stk
; Creation     : Jul-30-1993
; Modification : Jul-30-1993
;
;******************************************************************************
;
; STk adaptation of the Tk widget demo.
;
; mkVScale:
; Create a top-level window that displays a vertical scale.
;
;******************************************************************************

(provide "mkVScale")

(define (mkVScale)
  (catch (destroy .top-vscale))
  (toplevel ".top-vscale")
  (dpos .top-vscale)
  (wm 'title .top-vscale "Vertical Scale Demonstration")
  (wm 'iconname .top-vscale "Scale")
  (message ".top-vscale.m"
	   :font "-Adobe-times-medium-r-normal--*-180*" :aspect 300
	   :text "A bar and a vertical scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the height of the bar.\n\nClick the \"OK\" button when you're finished.")
  (frame ".top-vscale.f" :borderwidth 10)
  (button ".top-vscale.ok" :text "OK" :command '(destroy .top-vscale))
  (pack .top-vscale.m .top-vscale.f .top-vscale.ok)
  
  (scale ".top-vscale.f.s" 
	 :orient "vertical" :length 280 :from 0 :to 250 :tickinterval 50
	 :command "setHeight .top-vscale.f.right.inner")
  (frame ".top-vscale.f.right" :bd 15)
  (pack .top-vscale.f.s :side "left" :anchor "ne")
  (pack .top-vscale.f.right :side "left" :anchor "nw")
  (.top-vscale.f.s 'set 20)

  (frame ".top-vscale.f.right.inner"
	 :geometry "40x20" :relief "raised" :bd 2 :bg "SteelBlue1")
  (pack .top-vscale.f.right.inner :expand "yes" :anchor "nw"))


(define (setHeight w height)
    (tk-set! w :geometry (& "40x" height)))