(use goo)
(use samurui/samurui)
(use samurui/gtk)

;; test.goo is a trivial drawing application.

;; the left (1st) mouse button, draws a box in the current color
;; the right (2nd) mouse button changes the color
;; the middle (3rd) mouse button writes out a string but clips it incorrectly

; ------- Simulation App Singelton

; Drawing Areas
(dc <happy-dummy> (<any>))

(idrawmodel <happy-dummy> <happy-draw>)

(dc <simapp> (<any>))
(iprop <simapp> scribble <happy-dummy> "Scribble")

(dv c_red (color 255 0 0))
(dv c_lred (color 128 0 0))
(dv c_green (color 0 255 0))
(dv c_lgreen (color 0 128 0))
(dv c_blue (color 0 0 255))
(dv c_lblue (color 0 0 128))

(dv cur_color 0)
(dv my_colors (tup (tup c_lred c_red)
                   (tup c_lgreen c_green)
                   (tup c_lblue c_blue)))

(dm mouse-press ((widget <happy-draw>) (x <int>) (y <int>) (button <int>) (time <int>))
  (case button
    ; Draw boxes!
    ((1)
     (let ((r (rect (- x 8)
                    (- y 8)
                    16 16)))
       (draw-rect widget r #t (1st (elt my_colors cur_color)))
       (shrink! r 1)
       (draw-rect widget r #t (2nd (elt my_colors cur_color)))
       (grow! r 1)
       (invalidate widget r)
       ))
    ; Write text confirmation number: 121749
    ((2)
     (def my-str "Goo!")
     (def my-font (get-default-samurui-font))
     (def ax x)
     (def ay (- y (font-ascent my-font)))
     (def inv-rect (rect ax 
                         ay
                         (string-width my-font my-str)
                         (string-height my-font my-str)))
     (draw-string widget my-font x y my-str (1st (elt my_colors cur_color)))
     (invalidate widget inv-rect)
     )
    ; Change colors
    ((3)
     (incf cur_color)
     (when (>= cur_color (len my_colors))
       (set cur_color 0)
       )
     )
    )
  )

(dm mouse-release ((widget <happy-draw>) (x <int>) (y <int>) (button <int>) (time <int>)))

(dm mouse-move ((widget <happy-draw>) (x <int>) (y <int>) (state <int>))
  (unless (= (& state GDK_BUTTON1_MASK) 0)
    (mouse-press widget x y 1 1)
    )
  )

; -------- Interface Models

(imodel <simapp>
        "Magic Scribble"
        (attr scribble fill)
)

(samurui-init)

(dv simhat (new <simapp>))
(set (scribble simhat) (new <happy-dummy>))

(present simhat)
(samurui-go)