106 lines
4.3 KiB
Scheme
106 lines
4.3 KiB
Scheme
;; -*- 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)
|
|
))
|