#!/usr/local/bin/stk -f
;;
;; a quick demo of the composite widgets
;; This code is a contribution of Drew.Whitehouse@anu.edu.au
;;
(require "Tk-classes")

(define main-frame (make <Frame>))
(define title (make <Label> :parent main-frame :text "Composite Widgets Demo"))
(define button-box (make <Frame> :parent main-frame :geometry "200x100"))
(define quit (make <Button> :parent main-frame 
                   :text " quit "
                   :command '(destroy *root*)))

(define composite-widgets '(Choicebox 
                            Defbutton 
                            Filebox 
                            Lentry 
                            Paned 
                            Scrollbox))
(for-each (lambda (x) 
            (let ((cmd (string-append "(demo-" (symbol->string x) ")")))
              (pack (make <Button> :parent button-box :text x :command cmd)
                    :fill 'x :padx 5 )))
          composite-widgets)

(pack title button-box :fill 'x :padx 10 :pady 10 )
(pack quit :padx 10 :pady 10 )
(pack main-frame)

(define (demo-choicebox)
  (let* ((tl (make <Toplevel> :title "Choice Box"))
         (cb (make <Choice-box> :value "empty for now!" :parent tl)))
    ;; add some entries
    (for-each (lambda (x) (add-choice cb (symbol->string x))) 
	      composite-widgets)
    (pack cb)))

(define (demo-defbutton)
  (pack (make <Default-button> 
	      :text "button"
	      :width 20
	      :parent (make <Toplevel> :title "Default Button"))))
         
(define (demo-filebox)
  (let ((f (make-file-box)))
    (if f
	(format #t "You have selected ~S\n" f)
	(format #t "Cancel\n"))))

(define (demo-lentry)
  (pack (make <Labeled-entry> 
	      :title "title" 
	      :parent (make <Toplevel> :title "Labeled entry"))))
    
(define (demo-paned)
  (let* ((tl (make <Toplevel> :title "Paned demo"))
         (hp (make <HPaned> :fraction 0.3 :geometry "300x300" :parent tl))
         (f1 (make <Label> :text "top pane" :parent (top-frame-of hp)))
         (f2 (make <Label> :text "bottom-pane" :parent (bottom-frame-of hp)))
         (vp (make <VPaned> :fraction 0.3 :geometry "300x300" :parent tl))
         (f3 (make <Label> :text "left pane" :parent (left-frame-of vp)))
         (f4 (make <Label> :text "right-pane" :parent (right-frame-of vp))))
    (pack f1 f2 f3 f4 :expand #t)
    (pack hp vp)))

(define (demo-scrollbox)
  (let* ((tl (make <Toplevel> :title "Scroll box"))
         (sb (make <Scroll-listbox> :parent tl :geometry "20x6")))
    ;; add some entries into the listbox
    (for-each (lambda (x) 
                (insert (listbox-of sb) 0 x))
              (append composite-widgets composite-widgets))
    (pack sb)))