92 lines
3.0 KiB
Scheme
92 lines
3.0 KiB
Scheme
;; -*- 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!)
|