;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; a demo of "with-gtk",  a macro to use gtk-server from clisp
;;
;;This script is a simple rewriting of demo1.lisp at the homepage of
;; GTK server
;; by T.Shido;  Sat, 22 May 2004 22:51:13 +0900
;;------------------------------------------------
;;
;;!!!!
;; before use, chage *gtk-server* according to your system
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; definition of "with-gtk"
;;; change *gtk-server* according to your system

(defvar *gtk-server* "C:\\bin\\gtk-server\\gtk-server.exe")
(defvar *gtk-socket* 50000)

;; macro "let+fn" makes nested let with function, like
;;(let+fn func ((a0 a1 a2 a3) (b0 b1 b2 b3) (c0 c1 c2 c3)) &body body
;; is expanded to 
;; (let ((a0 (func a1)))
;;    (func a2)
;;    (func a3)
;;    (let ((b0 (func b1)))
;;      (func b2)
;;      (func b3)
;;      (let ((c0 (func c1)))
;;        (func c2)
;;        (func c3)
;;        ,@body)))
;;
(defmacro let+fn (fn argvs &body body)
  (if argvs
      `(let ((,(first (car argvs)) (,fn ,@(second (car argvs)))))
	 ,@(mapcar #'(lambda (x) `(,fn ,@x))
		   (nthcdr 2 (car argvs)))
	 (let+fn ,fn ,(cdr argvs) ,@body))
    `(progn ,@body)))


(defmacro with-gtk (widgets &body body)
  (let ((socket (gensym)))
    `(let ((,socket (gtk-start *gtk-server* *gtk-socket*)))

;; gtk is defined in a closure, so that it refers socket.
;; gtk can be used like "format" function
       (defun gtk (&rest av)                 
	 (princ (apply #'format nil av) ,socket)
	 (read-line ,socket))
       
       (gtk "gtk_init(NULL, NULL)")
       (let+fn gtk ,widgets ,@body)
       (princ "gtk_exit(0)" ,socket))))


;; Start the gtk-server, it returns socket
;; (gtk-start *gtk-server* *gtk-socket*)
(defun gtk-start (server nsocket) ;
  (ext:run-program server :arguments (list "tcp" (format nil "localhost:~D" nsocket)) :wait nil)
  (sleep 1) ; Wait a little so the server can initialize
  (socket:socket-connect nsocket))



;; rewrite using with-gtk
;; Design the GUI
(with-gtk ((win ("gtk_window_new(0)")
		("gtk_window_set_title (~A, This is a title)" win) 
		("gtk_window_set_default_size (~A, 100, 100)" win)
		("gtk_window_set_position (~A, 1)" win))
	   
	   (table ("gtk_table_new(30, 30, 1 )")
		  ("gtk_container_add (~A,~A)" win table))
	   
	   (button1 ("gtk_button_new_with_label (Exit)")
		    ("gtk_table_attach_defaults(~A,~A, 17, 28, 20, 25)" table button1))
	   
	   (button2 ("gtk_button_new_with_label (Print text)")
		    ("gtk_table_attach_defaults (~A,~A, 2, 13, 20, 25)" table button2))  

	   (entry  ("gtk_entry_new()") 
		   ("gtk_table_attach_defaults (~A,~A, 2, 28, 5, 15)" table entry))) 
;;body	  
	  (gtk "gtk_widget_show_all(~A)" win)
	  (terpri)
;; This is the mainloop
	  (loop
	    (gtk  "gtk_main_iteration()") ; this should be at the top of the loop
	    (if (or (< 0 (parse-integer (gtk  "gtk_server_callback(~A)" button1)))
		    (< 0 (parse-integer (gtk  "gtk_server_callback(~A)" win))))
		(return))
	    (if (< 0 (parse-integer (gtk  "gtk_server_callback(~A)"  button2)))
		(format t "This is the contents: ~A~%" (gtk  "gtk_entry_get_text(~A)" entry)))))