;; -*- geiser-scheme: chicken -*-
(include "menu.scm")
(include "board.scm")

(import scheme
        (chicken base)
        (chicken plist)
        (chicken condition)
        (chicken format)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-image "img:")
        (prefix sdl2-ttf "ttf:")
        (prefix menu "menu:")
        (prefix board "board:")
        miscmacros)

(sdl2:set-main-ready!)
(sdl2:init! '(video timer events))
(ttf:init!)
(sdl2:set-hint! 'render-scale-quality "best")

(on-exit sdl2:quit!)
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))

(define window (sdl2:create-window! "The Royal Game of Alnothur" 'centered 'centered 1920 1080 '(opengl)))
(define renderer (sdl2:create-renderer! window -1 '(accelerated target-texture)))

(sdl2:render-draw-colour-set! renderer (sdl2:make-colour 128 128 128 0))
(sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 1920 1080))
(sdl2:delay! 10)

(put! 'sdlprops 'mouse-point (sdl2:make-point 0 0))
(put! 'sdlprops 'old-ticks (sdl2:get-ticks))

(put! 'progprops 'current-state #f)
(put! 'progprops 'next-state menu:)

(define (draw-scene!)
  (when (not (equal? (get 'progprops 'current-state)
                     (get 'progprops 'next-state)))
    (put! 'progprops 'current-state (get 'progprops 'next-state))
    (sdl2:render-draw-colour-set! renderer (sdl2:make-colour 128 128 128 0))
    (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 1920 1080))
    (case (get 'progprops 'next-state)
      ((menu:) (menu:prepare! renderer))
      ((board:) (board:prepare! renderer))))

  (case (get 'progprops 'current-state)
    ((menu:) (menu:draw-scene! renderer))
    ((board:) (board:draw-scene! renderer)))
  (sdl2:render-present! renderer))

(define (update-scene!)
  (case (get 'progprops 'current-state)
    ((menu:) (menu:update-scene!))
    ((board:) (board:update-scene!))))

(define (handle-event ev exit-main-loop!)
  (case (sdl2:event-type ev)
    ((window) (draw-scene!))
    ((quit) (exit-main-loop! #t))
    ((mouse-motion)
     (put! 'sdlprops 'mouse-x (sdl2:mouse-motion-event-x ev))
     (put! 'sdlprops 'mouse-y (sdl2:mouse-motion-event-y ev))
     (put! 'sdlprops 'mouse-point (sdl2:make-point (get 'sdlprops 'mouse-x) (get 'sdlprops 'mouse-y))))
    ((key-down)
     (case (sdl2:keyboard-event-sym ev))
     (draw-scene!)))
  (case (get 'progprops 'current-state)
    ((menu:) (menu:handle-event ev))
    ((board:) (board:handle-event ev))))

(let/cc exit-main-loop!
        (while #t
          (sdl2:pump-events!)
          (while (sdl2:has-events?)
            (handle-event (sdl2:poll-event!) exit-main-loop!))
          (put! 'sdlprops 'ticks (sdl2:get-ticks))
          (put! 'sdlprops 'tickdelta (- (get 'sdlprops 'ticks)
                                        (get 'sdlprops 'old-ticks)))
          (draw-scene!)
          (update-scene!)
          (put! 'sdlprops 'old-ticks (get 'sdlprops 'ticks))
          (sdl2:delay! 10)))

(sdl2:destroy-renderer! renderer)
(sdl2:quit!)