(import scheme)
(import (chicken base))
(import (chicken process signal))
(import gtk-server)

;; Define SIGUSR1 here and perform an exit if this
;; signal occurs. Handy for debugging.
(set-signal-handler! 10 (lambda x (exit)))

(define gtk-server (start-gtk-server! args: '("-log=/tmp/hug-test1.log")))
(define (gtk #!rest args) (apply gtk-send! gtk-server args))

;; Define GUI - mainwindow
(define win (gtk "m_window" "'HUG demo'" 400 300))
;; Attach frame
(define frame (gtk "m_frame" 390 245))
(gtk "m_attach" win frame 5 5)
(gtk "m_frame_text" frame "' Draw on canvas '")
;; Create buttons
(define exit (gtk "m_button" "_Exit" 70 40))
(gtk "m_attach" win exit 325 255)
(define about (gtk "m_button" "_Button" 70 40))
(gtk "m_attach" win about 5 255)
(gtk "m_bgcolor" about "#00CC00" "#009900" "#00FF00")
(gtk "m_fgcolor" about "#FFFF00" "#FFFF00" "#FFFF00")
;; Label
(define label (gtk "m_label" "'Created with HUG!'" 220 20))
(gtk "m_font" label "'Courier Italic 12'")
(gtk "m_fgcolor" label "#0000EE")
(gtk "m_attach" win label 100 275)
;; Check button
(define check (gtk "m_check" "'Check button'" 200 20))
(gtk "m_bgcolor" check "#00CC00" "#009900" "#00ff00")
(gtk "m_fgcolor" check "#0000EE" "#0000EE" "#0000EE")
(gtk "m_attach" win check 100 255)
;; Setup the drawing canvas, draw stuff
(define canvas (gtk "m_canvas" 380 225))
(gtk "m_attach" win canvas 10 20)
(gtk "m_circle" "#FF0000" 100 100 100 50 1)
(gtk "m_square" "#FFFF00" 200 50 60 60 1)
(gtk "m_line" "#0000FF" 10 180 60 60)
(gtk "m_font" canvas "'Arial Italic 18'")
(gtk "m_out" "'Hello cruel world'" "#0000FF" "#E0E000" 10 10)

;; Mainloop
(let loop ()
  (let ((event (gtk "m_event")))
    (when (not (member event (list exit win)))
      (cond
       ((equal? event "button-press")
        (let ((mbut (gtk "m_mouse 2"))
              (x (gtk "m_mouse 0"))
              (y (gtk "m_mouse 1")))
          (print "Mouse button " mbut " pressed at coords " x ", " y)))
       ((equal? event "scroll-event")
        (let ((mbut (gtk "m_mouse 3"))
              (x (gtk "m_mouse 0"))
              (y (gtk "m_mouse 1")))
          (print "Mouse scroll " mbut " used at coords " x ", " y))))
      (loop))))

;; Exit GTK
(gtk "m_end")
(stop-gtk-server! gtk-server)