;  Copyright (c) 2014 Edward Langley
;  All rights reserved.

;  Redistribution and use in source and binary forms, with or without
;  modification, are permitted provided that the following conditions
;  are met:

;  Redistributions of source code must retain the above copyright notice,
;  this list of conditions and the following disclaimer.

;  Redistributions in binary form must reproduce the above copyright
;  notice, this list of conditions and the following disclaimer in the
;  documentation and/or other materials provided with the distribution.

;  Neither the name of the project's author nor the names of its
;  contributors may be used to endorse or promote products derived from
;  this software without specific prior written permission.

;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
;  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;  HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(asdf:load-system :cl-cffi-gtk)

(defpackage :gtk-tutorial
  (:use :gtk :gdk :gdk-pixbuf :gobject
        :glib :gio :pango :cairo :common-lisp))

(in-package :gtk-tutorial)

;(macroexpand-1 '(on (clicked button) (__)
;                    (declare (ignore __))
;                    (format t "Button 1 was pressed")))

(defmacro on ((sig target) bind &body body)
  "Bind a signal handler: note that this intentionally shadows whatever the 'bind' argument is"
  `(g-signal-connect ,target ,(string-downcase (symbol-name sig))
                     (lambda ,bind
                       ,@body)))

(let ((surface nil))
  (defun example-drawing ()
    (within-main-loop
      (let ((window (make-instance 'gtk-window
                                   :type :toplevel
                                   :title "Example Drawing"))
            (frame (make-instance 'gtk-frame
                                  :shadow-type :in))
            (area (make-instance 'gtk-drawing-area
                                 :width-request 250
                                 :height-request 200)))

        (on (destroy window) (__)
          (declare (ignore __))
          (leave-gtk-main))

        (on (draw area) (widget cr)
          (declare (ignore widget))
          (let ((cr (pointer cr)))
            (cairo-set-source-surface cr surface 0.0 0.0)
            (cairo-paint cr)
            (cairo-destroy cr)
            +gdk-event-propagate+))

        (on (configure-event area) (widget event)
          (declare (ignore widget))
          (when surface
            (format t "surface is not nil~%")
            (cairo-surface-destroy surface))
          (setf surface (gdk-window-create-similar-surface
                          (gtk-widget-window widget)
                          :color
                          (gtk-widget-get-allocated-width widget)
                          (gtk-widget-get-allocated-height widget)))
          (let ((cr (cairo-create surface)))
            (cairo-set-source-rgb cr 1.0 1.0 1.0)
            (cairo-paint cr)
            (cairo-destroy cr)))

        (on (motion-notify-event area) (widget event)
          (format t "MOTION-NOTIFY-EVENT")
          (when (member :button1-mask (gdk-event-motion-state event))
            (let ((cr (cairo-create surface))
                  (x (gdk-event-motion-x event))
                  (y (gdk-event-motion-y event)))
              (cairo-rectangle cr (- x 3.0) (- y 3.0) 6.0 6.0)
              (cairo-fill cr)
              (cairo-destroy cr)
              (gtk-widget-queue-draw-area widget
                                          (truncate (- x 3.0))
                                          (truncate (- y 3.0))
                                          6
                                          6)))
          +gdk-event-stop+)

        (on (button-press-event area) (widget event)
          (format t "BUTTON-PRESS-EVENT ~A~%" event)
          (if (eql 1 (gdk-event-button-button event))
            (let ((cr (cairo-create surface))
                  (x (gdk-event-button-x event))
                  (y (gdk-event-button-y event)))
              (cairo-rectangle cr (- x 3.0) (- y 3.0) 6.0 6.0)
              (cairo-fill cr)
              (cairo-destroy cr)
              (gtk-widget-queue-draw-area widget
                                          (truncate (- x 3.0))
                                          (truncate (- y 3.0))
                                          6
                                          6))
            (let ((cr (cairo-create surface)))
              (cairo-set-source-rgb cr 1.0 1.0 1.0)
              (cairo-paint cr)
              (cairo-destroy cr)
              (gtk-widget-queue-draw widget))))

            (gtk-widget-add-events area '(:button-press-mask :pointer-motion-mask))
            (gtk-container-add frame area)
            (gtk-container-add window frame)
            (gtk-widget-show-all window)))))

(example-drawing)