;;; Examples from the GTK tutorial. First load interface by doing:
;;; SBCL:    (load "gtkffi-cmusbcl")
;;; CMUCL:   (load "gtkffi-cmusbcl") 
;;; OPENMCL: (load "gtkffi-openmcl")

;;;
;;; Example 1, Hello World

(gtk:define-signal-handler bye1 :void (widget data)
  widget data  ; stop unused var compiler nagging
  (format t "bye!~%")
  (gtk:main-quit))

(gtk:define-signal-handler delev1 :int (widget event data)
  widget event data
  (format t "delete-event ocurred~%")
  gtk:+false+)

(gtk:define-signal-handler hellomsg :void (widget data)
  widget data
  (format t "Hello world!~%"))

(defun hello-world ()
  (gtk:init-ensure) ; make sure gtk is initialized before calling api
  (let ((window (gtk:window-new gtk:window-toplevel))
        (button (gtk:button-new-with-label "Hello World!")))
    (gtk:container-add window button)
    (gtk:container-set-border-width window 10)
    (gtk:widget-show button)
    (gtk:widget-show window)
    (g:signal-connect button "clicked" (g:callback hellomsg)
                      (g:nullptr))
    (g:signal-connect window "delete-event" (g:callback delev1)
                      (g:nullptr))
    (g:signal-connect window "destroy" (g:callback bye1)
                      (g:nullptr))
    (gtk:main)))

; (hello-world)

;;;
;;; Example 2, mnemonic check box

(gtk:define-signal-handler tbtell :void (widget data)
  data
  (if (gtk:toggle-button-get-active widget)
    (format t "active.~%")
    (format t "not active.~%")))

(gtk:define-signal-handler bye2 :void (widget data)
  widget data
  (format t "bye!~%")
  (gtk:main-quit))

(defun check-button ()
  (gtk:init-ensure)
  (let ((window (gtk:window-new gtk:window-toplevel))
        (button (gtk:check-button-new-with-mnemonic
                 "m_nemonic check button")))
    (gtk:container-add window button)
    (gtk:container-set-border-width window 20)
    (gtk:toggle-button-set-active button t)
    (g:signal-connect button "clicked" (g:callback tbtell)
                      (g:nullptr))
    (g:signal-connect window "destroy" (g:callback bye2)
                      (g:nullptr))
    (gtk:widget-show button)
    (gtk:widget-show window)
    (gtk:main)))

; (check-button)


;;;
;;; Example 3, radio buttons and packing boxes

(gtk:define-signal-handler rbtell :void (widget data)
  data                       
  (if (gtk:toggle-button-get-active widget)
    (format t "active.~%")))

(gtk:define-signal-handler bye3 :void (widget data)
  widget data
  (format t "bye!~%")
  (gtk:main-quit))

(gtk:define-signal-handler delev2 :void (data)
  (gtk:widget-destroy data))

(defun radio-buttons ()
  (gtk:init-ensure)
  (let* ((win (gtk:window-new gtk:window-toplevel))
         (vb1 (gtk:vbox-new nil  0))
         (vb2 (gtk:vbox-new nil 10))
         (vb3 (gtk:vbox-new nil 10))
         (rb1 (gtk:radio-button-new-with-label 
               (g:nullptr) "Button 1"))
         (rb2 (gtk:radio-button-new-with-label-from-widget
               rb1 "Button 2"))
         (rb3 (gtk:radio-button-new-with-label-from-widget
               rb1 "Button 3"))
         (sep (gtk:hseparator-new))
         (qui (gtk:button-new-with-label "Quit")))
    (gtk:window-set-title win "Radio Buttons")
    (gtk:container-set-border-width win 0)
    (gtk:container-add win vb1)
    (gtk:widget-show vb1)
    (gtk:container-set-border-width vb2 10)
    (gtk:box-pack-start vb1 vb2 t t 0)
    (gtk:widget-show vb2)
    (gtk:box-pack-start vb2 rb1 t t 0)
    (gtk:widget-show rb1)
    (gtk:toggle-button-set-active rb2 t)
    (gtk:box-pack-start vb2 rb2 t t 0)
    (gtk:widget-show rb2)
    (gtk:box-pack-start vb2 rb3 t t 0)
    (gtk:widget-show rb3)
    (gtk:box-pack-start vb1 sep nil t 0)    
    (gtk:widget-show sep)
    (gtk:container-set-border-width vb3 10)
    (gtk:box-pack-start vb1 vb3 nil t 0)
    (gtk:widget-show vb3)
    (gtk:box-pack-start vb3 qui t t 0)
    (gtk:widget-show qui)
    (g:signal-connect rb1 "toggled" (g:callback rbtell) (g:nullptr))
    (g:signal-connect rb2 "toggled" (g:callback rbtell) (g:nullptr))
    (g:signal-connect rb3 "toggled" (g:callback rbtell) (g:nullptr))
    (g:signal-connect-swapped qui "clicked" (g:callback delev2) win)
    (g:signal-connect win "destroy" (g:callback bye3) (g:nullptr))
    (gtk:widget-show win)
    (gtk:main)))

; (radio-buttons)

;;;
;;; Example 4, sliders.

(gtk:define-signal-handler bye4 :void (widget data)
  widget data
  (format t "bye!~%")
  (gtk:main-quit))

(gtk:define-signal-handler valuechange :void (widget data)
  data                       
  (let* ((adjust (gtk:range-get-adjustment widget))
         (value (gtk:adjustment-get-value adjust)))
  (format t "Value is: ~S~%" value)))

(gtk:define-signal-handler digitchange :void (widget data)
  (let ((digits (gtk:adjustment-get-value
                 (gtk:range-get-adjustment widget))))
    (gtk:scale-set-digits data (truncate digits))))

(defun sliders ()
  (gtk:init-ensure)
  (let ((win (gtk:window-new gtk:window-toplevel))
        (box (gtk:vbox-new nil 10))
        (scl1 (gtk:hscale-new-with-range 0.0d0 10.0 0.1d0))
        (scl2 (gtk:hscale-new-with-range 0.0d0 13.0d0 1.0d0)))
    (gtk:container-add win box)
    (gtk:box-pack-start box scl1 t t 0)
    (gtk:box-pack-start box scl2 t t 0)
    (gtk:window-set-title win "Ooooo, sliders in Lisp!")
    (gtk:widget-set-size-request scl1 300 50)
    (gtk:scale-set-value-pos scl1 gtk:pos-bottom)
    (gtk:adjustment-set-value (gtk:range-get-adjustment scl2) 0)
    (gtk:scale-set-digits scl1 0)
    (gtk:widget-show scl1)
    (gtk:widget-show scl2)
    (gtk:widget-show box)
    (gtk:widget-show win)
    (g:signal-connect scl1 "value-changed" (g:callback valuechange)
                      (g:nullptr))
    (g:signal-connect scl2 "value-changed" (g:callback digitchange)
                      scl1)
    (g:signal-connect win "destroy" (g:callback bye4) (g:nullptr))
    (gtk:main)))

; (sliders)


;;;
;;; Example 5, text entry

(gtk:define-signal-handler bye5 :void (widget data)
  widget data
  (format t "bye!~%")
  (gtk:main-quit))

(gtk:define-signal-handler togedit :void (wid data)
  (gtk:editable-set-editable data
                             (gtk:toggle-button-get-active wid)))

(gtk:define-signal-handler togvisi :void (wid data)
  (gtk:entry-set-visibility data
                         (gtk:toggle-button-get-active wid)))

(gtk:define-signal-handler showit :void (wid data)
  wid
  (format t "Text entry: ~S~%" (gtk:entry-get-text data)))

(defun textentry ()
  (let* ((win (gtk:window-new gtk:window-toplevel))
         (vbox (gtk:vbox-new nil 0))
         (hbox (gtk:hbox-new nil 0))
         (txt (gtk:entry-new))
         (ed (gtk:check-button-new-with-label "Editable"))
         (vi (gtk:check-button-new-with-label "Visible"))
         (get (gtk:button-new-with-label "Get")))
    (gtk:widget-set-size-request win 200 100)
    (gtk:window-set-title win "GTK Entry")
    (gtk:container-set-border-width win 10)
    (gtk:container-add win vbox)
    (gtk:box-pack-start vbox txt t t 0)
    (gtk:box-pack-start vbox hbox t t 0)
    (gtk:box-pack-start vbox get t t 0)
    (gtk:box-pack-start hbox ed t t 0)
    (gtk:box-pack-start hbox vi t t 0)
    (gtk:entry-set-max-length txt 30)
    (gtk:entry-set-text txt "hello world")
    (g:signal-connect win "destroy" (g:callback bye4) (g:nullptr))
    (g:signal-connect ed "clicked" (g:callback togedit) txt)
    (g:signal-connect vi "clicked" (g:callback togvisi) txt)
    (g:signal-connect get "clicked" (g:callback showit) txt)
    (gtk:toggle-button-set-active ed t)
    (gtk:toggle-button-set-active vi t)
    (gtk:widget-show-all win)
    (gtk:main)))

; (textentry)


;;;
;;; Example 6, scribble-simple

(defparameter *pixmap* nil)

(gtk:define-signal-handler bye5 :void (widget data)
  widget data
  (format t "bye!~%")
  (gtk:main-quit))

(gtk:define-signal-handler configure-event :int (widget ev)
  widget ev
  (when *pixmap* (g:object-unref *pixmap*))
  (setf *pixmap* (gdk:pixmap-new (gtk:Widget.window widget)
                                 (gtk:Widget.allocation.width widget)
                                 (gtk:Widget.allocation.height widget)
                                 -1))
  (gdk:draw-rectangle *pixmap*
                      (gtk:Style.white-gc (gtk:Widget.style widget))
                      t
                      0
                      0
                      (gtk:Widget.allocation.width widget)
                      (gtk:Widget.allocation.height widget))

  gtk:+true+)

(gtk:define-signal-handler expose-event :int (widget ev)
  widget ev     
  (gdk:draw-drawable (gtk:Widget.window widget)
                     (gtk:Style.fg-gc (gtk:Widget.style widget)
                                     (gtk:Widget.state widget))
                     *pixmap*
                     (gdk:EventExpose.area.x ev)
                     (gdk:EventExpose.area.y ev)
                     (gdk:EventExpose.area.x ev)
                     (gdk:EventExpose.area.y ev)
                     (gdk:EventExpose.area.width ev)
                     (gdk:EventExpose.area.height ev))

  gtk:+false+)

(defun draw-brush (widget x y)
  (let ((updatex (floor (- x 5)))
        (updatey (floor (- y 5)))
        (updatewidth 8)
        (updateheight 8))
    (gdk:draw-rectangle *pixmap*
                        (gtk:Style.black-gc
                         (gtk:Widget.style widget))
                        t
                        updatex 
                        updatey
                        updatewidth
                        updateheight)
    (gtk:widget-queue-draw-area widget
                                updatex
                                updatey
                                updatewidth
                                updateheight)))

(gtk:define-signal-handler button-press-event :int ( widget ev)
  widget ev                       
  (when (and (= (gdk:EventButton.button ev) 1)
             *pixmap*)
    (draw-brush widget (gdk:EventButton.x ev)
                (gdk:EventButton.y ev)))
  gtk:+true+)

(gtk:define-signal-handler motion-notify-event :int (widget ev)
  widget ev                       
  (let (w x y s)
    w
    (if (eql (gdk:EventMotion.is-hint ev) gtk:+true+)
      (multiple-value-setq (w x y s)
        (gdk:window-get-pointer (gdk:EventMotion.window ev)
                                0 0 0))
      (progn
        (setq x (gdk:EventMotion.x ev))
        (setq y (gdk:EventMotion.y ev))
        (setq s (gdk:EventMotion.state ev))))
    (if (and (logtest s gdk:button1-mask) *pixmap*)
      (draw-brush widget x y))
    gtk:+true+))

(gtk:define-signal-handler delev3 :void ( widget)
  ;; widget is toplevel window
  (gtk:widget-destroy widget))

(defun scribble-simple ()
  (gtk:init-ensure)
  (let (window drawing-area vbox button)
    (setq window (gtk:window-new gtk:window-toplevel))
    (gtk:window-set-title window "Scribble Simple")
    (setq vbox (gtk:vbox-new nil 0))
    (gtk:container-add window vbox)
    (gtk:widget-show vbox)
    (setq drawing-area (gtk:drawing-area-new))
    (gtk:widget-set-size-request drawing-area 200 200)
    (gtk:box-pack-start vbox drawing-area t t 0)
    (gtk:widget-show drawing-area)
    (g:signal-connect drawing-area "expose_event" 
                      (g:callback expose-event)
                      (g:nullptr))
    (g:signal-connect drawing-area "configure_event" 
                      (g:callback configure-event)
                      (g:nullptr))
    (g:signal-connect drawing-area "motion_notify_event" 
                      (g:callback motion-notify-event) (g:nullptr))
    (g:signal-connect drawing-area "button_press_event" 
                      (g:callback button-press-event) (g:nullptr))
    (gtk:widget-set-events drawing-area
                           (logior gdk:exposure-mask
                                   gdk:leave-notify-mask
                                   gdk:button-press-mask
                                   gdk:pointer-motion-mask
                                   gdk:pointer-motion-hint-mask))
    (setq button (gtk:button-new-with-label "Quit"))
    (gtk:box-pack-start vbox button nil nil 0)
    (g:signal-connect-swapped button "clicked" (g:callback delev3) 
                              window)
    (g:signal-connect window "destroy" (g:callback bye5)
                      (g:nullptr))
    (gtk:widget-show button)
    (gtk:widget-show window)
    (gtk:main)
    (values)))

; (scribble-simple)

;;;
;;; EOF