(import scheme)
(cond-expand
 (chicken-4
  (use (prefix sdl2 sdl2:)
       (prefix kiwi kw:))
  (import (only sdl2-internals unwrap-renderer unwrap-window)))
 (chicken-5
  (import (chicken base))
  (import (chicken format))
  (import (prefix sdl2 sdl2:))
  (import (prefix kiwi kw:))
  (import (only sdl2-internals unwrap-renderer unwrap-window))))

(sdl2:set-main-ready!)
(sdl2:init! '(everything))

(define width 320)
(define height 240)

(define-values (window renderer)
  (sdl2:create-window-and-renderer! width height '(resizable)))

(sdl2:render-draw-color-set! renderer (sdl2:make-color 100 200 100 1))

(define driver (kw:create-sdl2-driver (unwrap-renderer renderer)
                                      (unwrap-window window)))

(define tileset (kw:load-surface driver "tileset.png"))
(define gui (kw:init! driver tileset))

(define font (kw:load-font driver "SourceSansPro-Semibold.ttf" 12))
(kw:gui-font-set! gui font)

(define (->int x) (inexact->exact (floor x)))

(define (squash-rect! rect)
  (set! (kw:rect-x rect) (abs (->int (* (kw:rect-w rect) 0.0625))))
  (set! (kw:rect-y rect) (abs (->int (* (kw:rect-h rect) 0.0625))))
  (set! (kw:rect-w rect) (->int (* (kw:rect-w rect) 0.875)))
  (set! (kw:rect-h rect) (- (kw:rect-h rect) 30))
  (set! (kw:rect-h rect) (->int (* (kw:rect-h rect) 0.875))))

(define geometry (kw:rect 0 0 width height))
(squash-rect! geometry)

(define frame (kw:scrollbox gui #f geometry))
(kw:enable-widget-debug! frame #t)

(define button-geometry (kw:rect 0 0 230 40))
(define (add-button-clicked button _mbutton)
  (let* ((text (format "geometry: ~ax~a+~ax~a"
                       (kw:rect-x button-geometry)
                       (kw:rect-y button-geometry)
                       (kw:rect-w button-geometry)
                       (kw:rect-h button-geometry)))
         (w (kw:button gui frame text button-geometry)))
    (kw:enable-widget-debug! w #t)
    (set! (kw:rect-y button-geometry)
          (- (kw:rect-y button-geometry) (kw:rect-h button-geometry)))))

(define add-button-geometry (kw:rect (- 160 50) (- 240 40) 100 40))
(define add-button (kw:button gui #f "Add button" add-button-geometry))
(kw:handler-set! add-button 'mouse-down add-button-clicked)

(set! (kw:rect-x geometry) 10)
(set! (kw:rect-y geometry) 0)
(set! (kw:rect-w geometry) 40)
(set! (kw:rect-h geometry) 230)
(set! (kw:rect-y button-geometry) (kw:rect-h geometry))

(let loop ()
  (when (not (sdl2:quit-requested?))
    (let loop ((event (sdl2:make-event)))
      (when (sdl2:poll-event! event)
        (when (and (eqv? (sdl2:event-type event) 'window)
                   (eqv? (sdl2:window-event-event event) 'size-changed))
          (set! (kw:rect-w geometry) (sdl2:window-event-data1 event))
          (set! (kw:rect-h geometry) (sdl2:window-event-data2 event))
          (squash-rect! geometry)
          (set! (kw:widget-geometry frame) geometry)
          (set! (kw:rect-x add-button-geometry)
                (abs (->int (- (/ (sdl2:window-event-data1 event) 2)
                               (/ (kw:rect-w add-button-geometry) 2)))))
          (set! (kw:rect-y add-button-geometry)
                (abs (- (sdl2:window-event-data2 event)
                        (kw:rect-h add-button-geometry))))
          (set! (kw:widget-geometry add-button) add-button-geometry))
        (loop event)))
    (sdl2:render-clear! renderer)
    (kw:process-events! gui)
    (kw:paint! gui)
    (sdl2:render-present! renderer)
    (sdl2:delay! 1)
    (loop)))

(kw:quit! gui)
(sdl2:quit!)