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

(provide "mkHScale")

(define (mkHScale)
  (catch (destroy .top-hscale))
  (toplevel ".top-hscale")
  (dpos .top-hscale)
  (wm 'title .top-hscale "Horizontal Scale Demonstration")
  (wm 'iconname .top-hscale "Scale")
  (message ".top-hscale.m"
	   :font "-Adobe-times-medium-r-normal--*-180*" :aspect 300
	   :text "A bar and a horizontal scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the width of the bar.\n\nClick the \"OK\" button when you're finished.")
  (frame ".top-hscale.f" :bd 10)
  (button ".top-hscale.ok" :text "OK" :command '(destroy .top-hscale))
  (pack .top-hscale.m .top-hscale.f .top-hscale.ok :side "top" :fill "x")

  (frame ".top-hscale.f.top" :bd 15)
  (scale ".top-hscale.f.s" 
	 :orient "horizontal" :length 280 :from 0 :to 250 :tickinterval 50
	 :command "setWidth .top-hscale.f.top.inner")
  (pack .top-hscale.f.top :side "top" :expand "yes" :anchor "sw")
  (pack .top-hscale.f.s :side "bottom" :expand "yes" :anchor "nw")

  (frame ".top-hscale.f.top.inner"
	 :geometry "20x40" :relief "raised" :bd 2 :bg "SteelBlue1")
  (pack .top-hscale.f.top.inner :expand "yes" :anchor "sw")
  (.top-hscale.f.s 'set 20))


(define (setWidth w width)
  (tk-set! w :geometry (& width "x40")))