(require 'format)
(load "x11")
(load "xt")
(load "ol")
(load "olsubs")
(load "xevent")

(define (say x) (display x) (newline) (force-output))

(define (go)
  (xt:realize-widget top-level)
  (xt:main-loop))

(define top-level (ol:initialize "Test" "test"))

(define control-pane
  (xt:create-managed-widget
   "control pane" ol:control-area top-level
   xt:n-h-space 20))

(define (event-demo)
  (let ((stub-widget
	 (xt:create-managed-widget
	  "stub" ol:stub control-pane
	  xt:n-height 100
	  xt:n-width 200))
	(msg-widget
	 (xt:create-managed-widget
	  "text" ol:static-text control-pane)))
    (xt:add-event-handler
     stub-widget x:leave-window-mask 0
     (lambda args
       (display "leaveWindow: ")
       (display args)
       (newline)))
    (xt:add-event-handler
     stub-widget x:pointer-motion-mask 0
     (lambda args
       (display "pointerMotion: ")
       (display args)
       (newline)))))

(define (rubbertile-demo)
  (let ((base
	 (xt:create-managed-widget
	  "base"
	  ol:rubber-tile
	  control-pane)))
    (do ((i 0 (1+ i)))
    	((= i 3))
    	(let* ((rt (xt:create-managed-widget
		    (format #f "Tile ~A" i)
		    ol:rubber-tile base
		    xt:n-orientation ol:horizontal)))
      	  (do ((j 0 (1+ j)))
	      ((= j 3))
	    (xt:create-managed-widget
	     (format #f "Button ~A" (+ j (* i 3)))
	     ol:rect-button rt))))
    #t))

(define (menu-demo)
  (let* ((st (xt:create-managed-widget
	      "st" ol:static-text control-pane
      	      xt:n-string "Press MENU here"))
	 (menu (xt:create-popup-shell
	       	"popup" ol:menu-shell st
		"pushpin" ol:out))
	 (menu-pane (xt:get-value menu xt:n-menu-pane xt:widget)))
    (make-button "New" menu-pane (lambda (w) (say "New")))
    (make-button "Open" menu-pane (lambda (w) (say "Open")))
    (make-button "Save" menu-pane (lambda (w) (say "Save")))
    (make-button "Print" menu-pane (lambda (w) (say "Print")))))
	
(define (textfield-demo)
  (for-each
   (lambda (x)
     (let* ((name (car x))
	    (text (cadr x))
	    (label (xt:create-managed-widget
		    name ol:static-text control-pane
		    xt:n-string name
		    xt:n-width 70
		    xt:n-gravity "east"))
	    (field (xt:create-managed-widget
		    name ol:text-field control-pane
		    xt:n-string text)))
       (xt:add-callback
	field "verification"
	(lambda (w) (say "Yokes!")))))
   '(("MAKE:" "Acme") ("MODEL:" "Deluxe") ("SERIAL NO." "")))
  (xt:set-values control-pane
		 xt:n-layout-type ol:fixedcols
		 "measure" 2
		 "charsVisible" 10))

(define (footerpanel-demo)
  (let* ((footer-panel
	  (xt:create-managed-widget
	   "footerpanel" ol:footer-panel control-pane))
    	 (control-area
	  (xt:create-managed-widget
     	   "control" ol:control-area footer-panel))
	 (form
	  (xt:create-managed-widget
	   "form" ol:form footer-panel))
	 (status
	  (xt:create-managed-widget
	   "status" ol:oblong-button control-area))
	 (mode
	  (xt:create-managed-widget
	   "mode" ol:oblong-button control-area))
	 (st
	  (xt:create-managed-widget
	   "st" ol:static-text form
	   xt:n-x-vary-offset #t
	   xt:n-y-vary-offset #t))
	 (mo
	  (xt:create-managed-widget
	   "mo" ol:static-text form
	   xt:n-x-vary-offset #t
	   xt:n-y-vary-offset #t
	   xt:n-x-attach-right #t)))
    (xt:add-callback
     status xt:n-select
     (let* ((msglist '("Status 1" "Status 2" "Status 3"))
	    (msg msglist))
       (lambda (w)
	 (if (null? msg)
	     (set! msg msglist))
	 (xt:set-values st xt:n-string (car msg))
	 (set! msg (cdr msg)))))
    (xt:add-callback
     mode xt:n-select
     (let* ((msglist '("Mode 1" "Mode 2" "Mode 3"))
	    (msg msglist))
       (lambda (w)
	 (if (null? msg)
	     (set! msg msglist))
	 (xt:set-values mo xt:n-string (car msg))
	 (set! msg (cdr msg)))))))
			    

;(xt:realize-widget top-level)
;(xt:main-loop)
