;******************************************************************************
;
; File name    : mkButton.stk
; Creation     : 29 Juillet 1993
; Modification : 29 Juillet 1993
;
;******************************************************************************
;
; STk adaptation of the Tk widget demo.
;
; mkButton:
; Create a top-level window that displays a bunch of buttons.
;
;******************************************************************************

(provide "mkButton")

(define (mkButton)
  (catch (destroy .top-button))
  (toplevel ".top-button")
  (dpos .top-button)
  (wm 'title .top-button "Button Demonstration")
  (wm 'iconname .top-button "Buttons")
  (message ".top-button.m"
	   :font "-Adobe-times-medium-r-normal--*-180*"
	   :aspect 300
	   :text "Four buttons are displayed below.  If you click on a button, it will change the background of the button area to the color indicated in the button.\n\nClick the \"OK\" button when you've seen enough.")
  (frame ".top-button.f" :borderwidth 10)
  (pack 'append .top-button.f
	[button ".top-button.f.b1"
		:text "Peach Puff"
		:command '(tk-set! .top-button.f :bg "PeachPuff1")]
	"top pady 4 expand"
	[button ".top-button.f.b2"
		:text "Light Blue"
		:command '(tk-set! .top-button.f :bg "LightBlue1")]
	"top pady 4 expand"
	[button ".top-button.f.b3"
		:text "Sea Green"
		:command '(tk-set! .top-button.f :bg "SeaGreen2")]
	"top pady 4 expand"
	[button ".top-button.f.b4"
		:text "Yellow"
		:command '(tk-set! .top-button.f :bg "Yellow1")]
	"top pady 4 expand")
  (button ".top-button.ok" :text "OK" :command '(destroy .top-button))
  (pack 'append .top-button
	.top-button.m "top fill"
	.top-button.f "top expand fill"
	.top-button.ok "bottom fill"))