(in-package :clim-user)

(define-application-frame hello ()
  ()
  (:panes
   (main-area :application :display-time nil
			   :height 250 :width 600
			   :text-style (make-text-style :fix :roman :very-small))
   (interactor :interactor :height 550))
  (:layouts
   (default (vertically ()
	      main-area
	      interactor))))

(define-hello-command (com-moo :name t) ((who 'string))
  (format t "Moo ~A!~%" who))

(define-hello-command (com-foo :name t) ()
  (let (foo)
    (setf (climi::frame-manager-dialog-view
	   (frame-manager *application-frame*))
	  +textual-dialog-view+)
    (format
     t "RETURNED ~S~%"
     (accepting-values (*standard-input* :align-prompts :right
					 :exit-boxes '((:exit "All Done Here")
						       (:abort "Abort Abort!")))
      
       (setf foo
	     (list (accept '(float 20.0 100.0)
			   :view '(slider-view
				   :show-value-p t
				   :orientation :horizontal)
			   :query-identifier 'foo)
		   (accept '(subset foo bar baz quux)
			   :default '(foo baz)
			   :view 'check-box-view
			   :query-identifier 'bar)
		   (accept '(member-alist (("one" . eins)
					   ("two" . zwei)
					   ("three" . drei)
					   ("four" . vier)
					   ("five" . fünf)))
			   :default 'zwei
			   :view '(option-pane-view :width 100)
			   :prompt "Deutsch macht Spaß"
			   :query-identifier 'bar-1)
		   (accept '(subset eins zwei drei vier fünf)
			   :default '(zwei)
			   :view '(list-pane-view :width 100)
			   :prompt "Numbers")
		   (accept 'string :prompt "string"
			   :view 'text-field-view
			   :default "Hello there")
		   (accept 'boolean
			   :view 'toggle-button-view :query-identifier 'baz)
 		   (accept 'boolean
 			   :default t
 			   :view 'option-pane-view :query-identifier 'baz-1)))))
    (format t "FOO ~S~%" foo)))

(define-hello-command (com-foo-1 :name t) ((dview `(member
						   ,+gadget-dialog-view+
						   ,+textual-dialog-view+)
						  :default +gadget-dialog-view+))
  (setf (climi::frame-manager-dialog-view
	 (frame-manager *application-frame*))
	dview)
  (let (foo)
    (accepting-values (*standard-input* :align-prompts :right
					:own-window nil
					:resynchronize-every-pass nil)
      (setf foo
	    (list (accept '(float 10.0 400.0)
			  :query-identifier 'foo
			  ;:view '(slider-view :orientation :horizontal)
			  )
		  (accept '(subset foo bar baz quux)
			  :default '(foo baz)
			  :query-identifier 'bar)
		  (accept '(member-alist (("one" . eins)
					  ("two" . zwei)
					  ("three" . drei)
					  ("four" . vier)
					  ("five" . fünf)))
			  :default 'zwei
			  :prompt "Deutsch macht Spaß"
			  :query-identifier 'bar-1)
		  (accept '(subset eins zwei drei vier fünf)
			  :default '(zwei)
			  :prompt "Numbers")
		  (accept 'string :prompt "string"
				  :default "Hello There")
		  (accept 'boolean
			  :query-identifier 'baz)
		  (accept 'boolean
			  :query-identifier 'baz-1
			  :view +option-pane-view+
			  :default nil))))
    (format t "RETURNED ~S~%" foo)))

(define-hello-command (com-resync :name t) ()
  (let ((min -1.0)
	(max 1.0))
    (accepting-values (*standard-input* :align-prompts :right
					:resynchronize-every-pass t)
      (setf min (accept 'real :default min :prompt "min"))
      (setf max (accept 'real :default max :prompt "max"))
      (when (< max min)
	(rotatef min max)))
    (format t "(~A ~A)~%" min max)))


(define-presentation-type test-button ()
  :inherit-from t)

(define-presentation-method accept-present-default
    ((type test-button) stream view
     default default-supplied-p present-p query-identifier)
  (updating-output (stream :unique-id query-identifier
			   :cache-value default)
    (accept-values-command-button
     (nil :view +textual-dialog-view+) "compound test"
     (let (foo bar)
       (accepting-values (stream :align-prompts :right)
	 (setf foo (accept 'integer :default 10 :prompt "ni"
			   :query-identifier 'bar))
	 (setf bar (accept 'boolean :default t :prompt "nb"
			   :query-identifier 'baz))
	 )
       (break "afterf")
       (list foo bar)))))

(define-presentation-type test-compound ()
  :inherit-from t)

(define-presentation-method accept-present-default
    ((type test-compound) stream (view gadget-dialog-view)
     default default-supplied-p present-p query-identifier)
  (updating-output (stream :unique-id query-identifier
			   :cache-value default)
    (let (foo bar)
      (accepting-values (stream :align-prompts :right)
	(setf foo (accept 'integer :default 10 :prompt "ni"
			  :query-identifier 'bar))
	(setf bar (accept 'boolean :default t :prompt "nb"
			  :query-identifier 'baz)))
      (list foo bar))
;;     (let (foo bar)
;;       (funcall-presentation-generic-function
;;        accept-present-default
;;        'integer stream view 5 t present-p 'i-1)
;;       (terpri)
;;       (funcall-presentation-generic-function
;;        accept-present-default
;;        'boolean stream view nil t present-p 'b-1)
;;       (list foo bar))
    ))

(define-hello-command (com-compound-accept :name t) ()
  (let (foo)
    (accepting-values (*standard-input* :align-prompts :right)
      (setf (climi::frame-manager-dialog-view
	     (frame-manager *application-frame*))
	    +gadget-dialog-view+)
      (setf foo (accept 'test-compound :prompt "compound"
			:query-identifier 'foo)))
    (format t "RETURNED ~S~%" foo)))

(defun run-hello ()
  (run-frame-top-level (make-application-frame 'hello)))