(defpackage :snow-showcase
  (:use :common-lisp :snow :java :ext :named-readtables :cells)
  (:shadowing-import-from :snow #:make-dialog-prompt-stream #:self))

(in-package :snow-showcase)
(in-readtable snow:syntax)

(defvar *examples* (list))

(defmacro define-example (name &body body)
  (cl-utilities:with-unique-names (original-code show-source-p)
    `(pushnew
      (list ,name
	    (lambda ()
	      (let ((,original-code ',body) (,show-source-p (make-var nil)))
		(panel (:layout-manager '(:mig "fill"))
		  (panel (:layout "hidemode 3"
			  :visible-p
			  ;;TODO handle booleans more transparently
			  $(c? (jbool (not (var ,show-source-p)))))
		    (panel (:layout-manager '(:mig "fill") :layout "grow, wrap")
		      ,@body)
		    (button :text "Show source"
			    :layout "dock south"
			    :on-action (lambda ()
					 (setf (var ,show-source-p) t))))
		  (panel (:layout "dock south, hidemode 3"
			  :visible-p $(c? (jbool (var ,show-source-p))))
		    (scroll (:layout "grow, wrap")
		      (text-area :text
				 ,(with-output-to-string (str)
				    (let ((*print-case* :downcase))
				      (dolist (form body)
					(pprint form str)
					(terpri str))))))
		    (button :text "Hide source"
			    :layout "dock south"
			    :on-action (lambda ()
					 (setf (var ,show-source-p) nil))))))))
      *examples*
      :test #'equal
      :key #'car)))

(defmodel my-model ()
  ((a :accessor aaa :initform (c-in "4"))
   (b :accessor bbb :initform (c? (concatenate 'string (aaa cells:self) "2")))))

(defvar *bean* (new "snow.showcase.SnowExample"))
(defvar *variable* (make-var "42"))
(defvar *cells-object* (make-instance 'my-model))

(define-example "Data Binding"
  (panel ()
    (label :text "bean binding")
    (label :binding ${*bean*.property1}
	   :layout "wrap")
    (label :text "EL binding")
    (label :binding ${*bean*.nested.property1}
	   :layout "wrap")
    (label :text "cells bindings: aaa and bbb")
    (label :binding $(c? (aaa *cells-object*)))
    (label :binding $(cell (c? (bbb *cells-object*)))
	   :layout "wrap")
    (label :text "simple binding to a variable")
    (label :binding $*variable*
	   :layout "wrap")
    (button :text "another one" :layout "wrap")
    (label :text "set property1")
    (text-field :binding ${*bean*.property1}
		:layout "growx, wrap")
    (label :text "set nested.property1")
    (text-field :binding ${*bean*.nested.property1}
		:layout "growx, wrap")
    (button :text "Test!"
	    :layout "wrap"
	    :on-action (lambda ()
			 (setf (jproperty-value *bean* "property1")
			       "Test property")
			 (setf (jproperty-value
				(jproperty-value *bean* "nested")
				"property1")
			       "Nested property")
			 (setf (var *variable*) "Test var")
			 (setf (aaa *cells-object*) "Test cell")))))

(define-example "Mouse Events"
  (panel (:layout "grow"
	  :on-mouse-click (lambda () (format t "Click! ~A~%" *event*)))
     (label :text "Click here!")))

(define-example "Lists and trees"
  (scroll (:layout "grow")
    (list-widget :model (make-list-model '(1 2 (c (a b)) 3))
		 :prototype-cell-value "abcdefghijklmnopq"))
  (scroll (:layout "grow")
    (tree :model (make-tree-model '(1 2 (c (a b)) 3)))))

(define-example "Layout & Borders"
  (label :text "BorderLayout" :layout "wrap")
  (panel (:layout-manager :border :layout "wrap" :border :bevel)
    (button :text "borderlayout - center")
    (button :text "borderlayout - east"
	    :layout (jfield "java.awt.BorderLayout" "EAST"))))

(define-example "Events"
  (button :text "push me"
	  :on-action (lambda ()
		       (princ "Thanks for pushing me! ")
		       (finish-output))))

(defun showcase (&optional exit-on-close-p)
  (with-gui ()
    (frame (:id frame :title "Snow Showcase" :visible-p t :size #C(800 600)
	    :layout-manager '(:mig "fill")
	    :on-close (when exit-on-close-p :exit))
      (tabs (:layout "grow")
       (dolist (x (reverse *examples*))
	 (tab (car x) (funcall (cadr x))))))))

#||
(let ((fr (frame (:title "pippo" :visible-p t)
	      (panel (:layout "wrap")
	        (button :text "ciao" :enabled nil)
		(button :text "mondo" :enabled 42
			:on-action (lambda (event)
				     (print "Hello, world!")
				     (print event)))
		(text-field :binding (make-bean-data-binding *bean* "property1"))
		(text-field :binding
			    (make-cell-data-binding (c? (aaa *cells-object*))
						    #'(lambda (x)
							(setf (aaa *cells-object*) x))))
		(text-field :binding (make-slot-data-binding *cells-object* 'aaa))
		(text-field :binding (make-simple-data-binding *variable*)
			    :layout "wrap")
		(label :text "haha")
		(panel (:layout-manager :mig :layout "grow")
		  (button :text "Test Location" :location #(30 30)))
		(label :text "hihi")))))
    (let ((lbl1 (label :text "a label"))
	  (lbl2 (label :text "another")))
      (add-child lbl1 fr "growx")
      (add-child lbl2 fr "wrap"))
    (pack fr))||#
