;;; -*-Scheme-*-
;;;
;;; Demo with arrow, vpw, and push button

(require 'xwidgets)
(load-widgets arrow sash shell pbutton vpw)

(define con (create-context))
(define dpy (initialize-display con #f 'arrow 'demo))
(define top (create-shell 'arrow 'demo (find-class 'application-shell) dpy))
(set-values! top 'allow-shell-resize #t)

(define pane (create-managed-widget (find-class 'vpw) top))

(define button (create-managed-widget (find-class 'push-button) pane))
(set-values! button 'width 150 'label "Rotate Arrow")

(set-values! (name->widget pane 'sash) 'background "black")

(define arrow (create-managed-widget (find-class 'arrow) pane))
(set-values! arrow 'height 150 'traversal-type "highlight_enter"
	           'highlight-thickness 3)

(add-callback arrow 'select (lambda (w) (print '[select])))
(add-callback arrow 'release (lambda (w) (print '[release])))

(define curr (list 'arrow_up 'arrow_right 'arrow_down 'arrow_left))
(set-cdr! (last-pair curr) curr)
(set! curr (cdr curr))

(add-callback button 'select
  (lambda (w)
    (set-values! arrow 'arrow-direction (car curr))
    (set! curr (cdr curr))))

(realize-widget top)
(context-main-loop con)
