(use-modules (srfi srfi-1)
             (oop goops)
             (cairo)
             (gnome-2)
             (gnome gobject)
             (gnome gtk))

;;; The following commands may sometimes be very useful:
;;;   (gtype-class-get-signal-names <gtk-drawing-area>)
;;;   (get-property-names <gtk-drawing-area>)

;;; 3.1415926
(define pi (* 4 (atan 1)))

(define (draw-sample cr width height)
  (let ((radius 3)
        (x (/ width 2))
        (y (/ height 2)))
    ;; Use (cairo-antialias-get-values) to define the value of the
    ;; type <cairo-antialias-t> you need.
    (cairo-set-antialias cr 'none)

    ;; Set background color
    (cairo-set-source-rgba cr 0 .7 .4 .5)
    ;; Paint all area with it
    (cairo-paint cr)

    ;; paint a circle
    (cairo-set-source-rgba cr 1 1 0 1)
    (cairo-arc cr x y radius 0 (* 2 pi))
    ;; set background color and fill it
    (cairo-fill-preserve cr)
    ;; set margin color and stroke it
    (cairo-set-source-rgb cr 0 0 0)
    (cairo-set-line-width cr 1)
    (cairo-stroke cr)
    ))

(define (create-sample-surface-similar-to global-cr size scale)
  (let* ((width (* size scale))
         (height width)
         ;; create a new local surface that is as compatible as possible
         ;; with an existing one for the global context;
         ;; (cairo-get-target) gets the cairo surface for the given
         ;; cairo context
         (surface (cairo-surface-create-similar
                   (cairo-get-target global-cr)
                   ;; Use (cairo-content-get-values) to define the
                   ;; value of the type <cairo-content-t> you need.
                   'color-alpha
                   width
                   height))
         ;; create a new cairo context for the new surface
         (cr (cairo-create surface)))

    ;; This sample will become the pattern repeated over the canvas
    (draw-sample cr width height)
    surface))

(define (dots-pattern global-cr size scale)
  ;; next, create a pattern for the local surface we have
  (let ((pattern (cairo-pattern-create-for-surface
                  (create-sample-surface-similar-to global-cr
                                                    size
                                                    scale))))
    ;; Adjust the pattern to make it be repeated.
    ;; Use (cairo-extend-get-values) to define the value of the
    ;; type <cairo-extend-t> you need.
    (cairo-pattern-set-extend pattern 'repeat)
    pattern))

(define (draw cr width height size scale)
  (let ((halfway (/ (* size scale) 2))
        (pattern (dots-pattern cr size scale)))
    (cairo-translate cr halfway halfway)
    ;; set the pattern as a source for the global context
    (cairo-set-source cr pattern)
    (cairo-translate cr (- halfway) (- halfway))
    ;; create a path in the global cairo context (I use the whole
    ;; area)
    (cairo-rectangle cr 0 0 width height)
    ;; and fill it with the pattern
    (cairo-fill cr)
    ))

;;; Get size of GDK-WINDOW
;;; We could use something like
;;;   (event-coord-info (vector->list
;;;                      (fourth
;;;                       (vector->list
;;;                        (gdk-event->vector event)))))
;;; However there is a more specialized way.
;;; The function gdk-drawable-get-size used here is deprecated in
;;; new gtk+ versions, but I use it since guile-cairo on my Debian
;;; system is slightly old and doesn't support its replacements
;;; gdk-window-get-width and gdk-window-get-height.
(define (get-size gdk-window)
  (call-with-values
      (lambda () (gdk-drawable-get-size gdk-window))
    (lambda (a b) (cons a b))))


(define (grid-pattern-expose widget event)
  (let* ((size 15)
         (scale 3)
         (gdk-window (get widget 'window))
         ;; get cairo context for gtk widget
         (cr (gdk-cairo-create gdk-window))
         (window-size (get-size gdk-window))
         (width (car window-size))
         (height (cdr window-size)))
    (apply draw cr `(,width ,height ,size ,scale))
    #f))

(define-class <grid-pattern> (<gtk-drawing-area>)
  #:gsignal '(hi #f))
(define-method (grid-pattern:hi (entry <grid-pattern>))
  (format #t "Hi, all! I'm here! My name is ~A\n" entry))

(define (make-widget)
  (let ((widget (make <grid-pattern>)))
    (connect widget 'expose-event grid-pattern-expose)
    widget))


(define (make-window)
  (let* ((window (make <gtk-window> #:type 'toplevel #:title "Guile Cairo"))
	 ;;;; (button (make <gtk-button> #:label "Hello, World!"))
         )

    (set window 'border-width 10)
    ;;;; (add window button)

    ;;;; (gtype-instance-signal-connect button 'clicked (lambda (b) (gtk-main-quit)))
    (connect window 'destroy (lambda (b) (gtk-main-quit)))

    window))


;;; Make a window and a widget for it.
(define w (make-window))
(define widget (make-widget))
(add w widget)

(show-all w)
(emit widget 'hi)

;;; Threading
(gdk-threads-init)
;;; The above command (gdk-threads-init) is not sufficient to
;;; prevent crashes in multy-threaded environment.  The following
;;; pair of commands must be used in the Guile REPL to prevent
;;; crashes while working in Geiser (using a socket):
;;;   (gdk-threads-enter)
;;;   (gdk-threads-leave)
;;; Convenience procedures
(define -> (gdk-threads-enter))
(define <- (gdk-threads-leave))
;;; Use the following sequence:
;;; -> (your-command) <-

;;; Run main gtk loop yourself if you're working in Geiser
(gtk-main)