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

(provide "mkCheck")

(define (mkCheck)
  (catch (destroy .top-check))
  (toplevel ".top-check")
  (dpos .top-check)
  (wm 'title ".top-check" "Checkbutton demonstration")
  (wm 'iconname .top-check "Checkbuttons")
  (message ".top-check.m"
	   :font "-Adobe-times-medium-r-normal--*-180*"
	   :aspect 300
	   :text "Three checkbuttons are displayed below.  If you click on a button, it will toggle the button's selection state and set a STk variable to a value indicating the state of the checkbutton.\n\nClick the \"See Variables\" button to see the current values of the variables.\n\nClick the \"OK\" button when you've seen enough.")
  (frame ".top-check.f" :borderwidth 10)
  (pack 'append .top-check.f
	[checkbutton ".top-check.f.b1"
		     :text "Wipers OK" :variable 'wipers :relief "flat"]
	"top pady 4 expand frame w"
	[checkbutton ".top-check.f.b2"
		     :text "Brakes OK" :variable 'brakes :relief "flat"]
	"top pady 4 expand frame w"
	[checkbutton ".top-check.f.b3"
		     :text "Driver Sober" :variable 'sober :relief "flat"]
	"top pady 4 expand frame w")
  (frame ".top-check.f2")
  (pack 'append .top-check.f2
	[button ".top-check.f2.ok" :text "OK" :command '(destroy .top-check)]

; Pour ne pas se prendre le message:
; X Error of failed request:  BadMatch (invalid parameter attributes)...
; il faut faire:
;	[button ".top-check.f2.ok" :text "OK" 
;		:command '(begin
;			    (catch (destroy .top-check.d))
;			    (destroy .top-check))]

	"left expand fill"
	[button ".top-check.f2.vars"
		:text "See Variables"
		:command '(showVars ".top-check.d" 'wipers 'brakes 'sober)]
	"left expand fill")
  (button ".top-check.ok" :text "OK" :command '(begin
						(catch (destroy .top-check.d))
						(destroy .top-check)))
  (pack 'append .top-check
	.top-check.m "top fill"
	.top-check.f "top expand fill"
	.top-check.f2 "bottom fill"))