;; -*- geiser-scheme: chicken -*- (module menu * (import scheme (chicken base) (chicken plist) srfi-1 (prefix sdl2 "sdl2:") (prefix sdl2-image "img:") (prefix sdl2-ttf "ttf:")) (ttf:init!) (define logo-font (ttf:open-font "resources/ui/SourceSerifPro-Regular.otf" 80)) (define button-font (ttf:open-font "resources/ui/SourceSerifPro-Regular.otf" 50)) (define (render-button renderer text) (let*-values (((button) (img:load "resources/ui/button.png")) ((button-hover) (img:load "resources/ui/button-hover.png")) ((button-w) (sdl2:surface-w button)) ((button-h) (sdl2:surface-h button)) ((text-w text-h) (ttf:size-utf8 button-font text)) ((text-x) (round (- (/ button-w 2) (/ text-w 2)))) ((text-y) (round (- (/ button-h 2) (/ text-h 2))))) (sdl2:blit-surface! (ttf:render-utf8-blended button-font text (sdl2:make-color 0 0 0)) #f button (sdl2:make-rect text-x text-y text-w text-h)) (sdl2:blit-surface! (ttf:render-utf8-blended button-font text (sdl2:make-color 0 0 0)) #f button-hover (sdl2:make-rect text-x text-y text-w text-h)) (list (cons surface: (sdl2:create-texture-from-surface renderer button)) (cons surface-hover: (sdl2:create-texture-from-surface renderer button-hover)) (cons width: button-w) (cons height: button-h)))) (define (make-button renderer text offset-x offset-y on-click) (let* ((blist (render-button renderer text)) (blist (alist-cons rect: (sdl2:make-rect offset-x offset-y (cdr (assoc width: blist)) (cdr (assoc height: blist))) blist)) (blist (alist-cons offset-x: offset-x blist)) (blist (alist-cons offset-y: offset-y blist)) (blist (alist-cons on-click: on-click blist))) blist)) (define background #f) (define flower #f) (define flower-rotation 0) (define buttons #f) (define (prepare! renderer) (set! background (sdl2:create-texture-from-surface renderer (img:load "resources/ui/zikkurat.png"))) (set! flower (sdl2:create-texture-from-surface renderer (img:load "resources/tiles/flower.png"))) (set! buttons (list (make-button renderer "Test" 650 300 (lambda () (put! 'progprops 'next-state board:))) (make-button renderer "Test 2" 650 400 (lambda () (print "Button Test 2 clicked")))))) (define (check-buttonclick) (for-each (lambda (button) (if (sdl2:point-in-rect? (get 'sdlprops 'mouse-point) (cdr (assoc rect: button))) ((cdr (assoc on-click: button))))) buttons)) (define (handle-event ev) (case (sdl2:event-type ev) ((mouse-button-up) (check-buttonclick)))) (define (render-logo! window) (let*-values (((text-w text-h) (ttf:size-utf8 logo-font "The Royal Game of Ur"))) (sdl2:render-copy-ex! window flower #f (sdl2:make-rect 50 50 100 100) flower-rotation) (sdl2:render-copy-ex! window flower #f (sdl2:make-rect 1770 50 100 100) flower-rotation) (sdl2:render-copy! window (sdl2:create-texture-from-surface window (ttf:render-utf8-blended logo-font "The Royal Game of Ur" (sdl2:make-color 0 0 0))) #f (sdl2:make-rect (- (/ 1920 2) (/ text-w 2)) 10 text-w text-h)) )) (define (update-scene!) (set! flower-rotation (modulo (ceiling (/ (get 'sdlprops 'ticks) 50)) 360))) (define (draw-scene! window) ;; Background (sdl2:render-copy! window background) ;; Logo (render-logo! window) ;; Buttons (for-each (lambda (button) (sdl2:render-copy! window (if (sdl2:point-in-rect? (get 'sdlprops 'mouse-point) (cdr (assoc rect: button))) (cdr (assoc surface-hover: button)) (cdr (assoc surface: button))) #f (sdl2:make-rect (cdr (assoc offset-x: button)) (cdr (assoc offset-y: button)) (cdr (assoc width: button)) (cdr (assoc height: button))))) buttons) ))