Commenting

This commit is contained in:
Jakub 2026-05-17 20:59:36 +08:00
parent d450a0d155
commit 31a0bd9a34
2 changed files with 24 additions and 3 deletions

View file

@ -12,8 +12,12 @@
(srfi 4) (srfi 4)
(srfi 99)) (srfi 99))
;; The main font for the game.
(define base-font (font "../res/fonts/Felipa-Regular.ttf")) (define base-font (font "../res/fonts/Felipa-Regular.ttf"))
;; Label is a generic text container.
;; Centered? here is a pair of booleans, basically
;; a mask saying which axis to center.
(define-record-type <label> (define-record-type <label>
(int:make-label position centered? layer font font-size color text) (int:make-label position centered? layer font font-size color text)
label? label?
@ -25,6 +29,7 @@
(color label-color set-label-color!) (color label-color set-label-color!)
(text label-text set-label-text!)) (text label-text set-label-text!))
;; Title/subtitle/footer etc are basically just different styles
(export title) (export title)
(define (title position text (define (title position text
#!key #!key
@ -55,6 +60,7 @@
(color (make-color 0 0 0 1))) (color (make-color 0 0 0 1)))
(int:make-label position centered layer font size color text)) (int:make-label position centered layer font size color text))
;; This needs to be added to actually draw entities with labels
(export draw-labels) (export draw-labels)
(define draw-labels (define draw-labels
(make-system (make-system
@ -96,6 +102,8 @@
(label-color label) (label-color label)
(label-font label)))))))) (label-font label))))))))
;; Button container
;; state is in '(ready hovered clicked)
(define-record-type <button> (define-record-type <button>
(int:make-button position size layer label state click-fn colors) (int:make-button position size layer label state click-fn colors)
button? button?
@ -107,6 +115,7 @@
(click-fn button-click-fn set-button-click-fn!) (click-fn button-click-fn set-button-click-fn!)
(colors button-colors set-button-colors!)) (colors button-colors set-button-colors!))
;; Shortcut for making a button
(export button) (export button)
(define (button position label click-fn (define (button position label click-fn
#!key #!key
@ -117,6 +126,7 @@
(make-color 0.39 0.39 0.39 1)))) (make-color 0.39 0.39 0.39 1))))
(int:make-button position size layer label 'ready click-fn colors)) (int:make-button position size layer label 'ready click-fn colors))
;; Helper function for updating the button state
(define (check-button-state button) (define (check-button-state button)
(let ((x-range (cons (v-x (button-pos button)) (let ((x-range (cons (v-x (button-pos button))
(+ (v-x (button-pos button)) (+ (v-x (button-pos button))
@ -125,6 +135,7 @@
(+ (v-y (button-pos button)) (+ (v-y (button-pos button))
(v-y (button-size button))))) (v-y (button-size button)))))
(mouse-pos (cons (get-mouse-x) (get-mouse-y)))) (mouse-pos (cons (get-mouse-x) (get-mouse-y))))
;; Is the mouse in the rect drawn by x-range and y-range?
(if (and (< (car x-range) (car mouse-pos) (cdr x-range)) (if (and (< (car x-range) (car mouse-pos) (cdr x-range))
(< (car y-range) (cdr mouse-pos) (cdr y-range))) (< (car y-range) (cdr mouse-pos) (cdr y-range)))
(if (peek-event 'input 'click) (if (peek-event 'input 'click)
@ -132,6 +143,7 @@
(set-button-state! button 'hovered)) (set-button-state! button 'hovered))
(set-button-state! button 'ready)))) (set-button-state! button 'ready))))
;; Helper function to render the button and its text
(define (draw-button button) (define (draw-button button)
(push-render-object (push-render-object
'screen 'screen
@ -149,12 +161,14 @@
#t #t
1))) 1)))
(let* ((txt (button-label button)) (let* ((txt (button-label button))
;; Figure out the length of the text
(text-length (f32vector->list (text-length (f32vector->list
(measure-text-ex (measure-text-ex
(resource-contents (label-font txt)) (resource-contents (label-font txt))
(label-text txt) (label-text txt)
(label-size txt) (label-size txt)
1))) 1)))
;; Determine a centre offset internal to the button
(center-offset (vec (- (/ (v-x (button-size button)) (center-offset (vec (- (/ (v-x (button-size button))
2) 2)
(/ (car text-length) (/ (car text-length)
@ -165,7 +179,7 @@
2))))) 2)))))
(push-render-object (push-render-object
'screen 'screen
(+ 1 (button-layer button)) (+ 1 (button-layer button)) ;; always draw text above the button
(lambda () (lambda ()
(draw-font-text-2d (draw-font-text-2d
(v+ (button-pos button) (v+ (button-pos button)
@ -175,16 +189,18 @@
(label-color txt) (label-color txt)
(label-font txt)))))) (label-font txt))))))
;; If button is clicked, exec button click func
(define (do-button-callback button) (define (do-button-callback button)
(when (eqv? 'clicked (button-state button)) (when (eqv? 'clicked (button-state button))
((button-click-fn button)))) ((button-click-fn button))))
;; Needs to be added to do buttons
(export handle-buttons) (export handle-buttons)
(define handle-buttons (define handle-buttons
(make-system (make-system
'handle-buttons 'handle-buttons
10 10
'batch 'batch ;; batch because we check for events for every button
'(<button>) '(<button>)
(lambda (buttons) (lambda (buttons)
(for-each (for-each
@ -194,5 +210,6 @@
(draw-button button) (draw-button button)
(do-button-callback button))) (do-button-callback button)))
buttons) buttons)
;; At the end of the function, clear click events
(pop-event 'input 'click)))) (pop-event 'input 'click))))
) )

View file

@ -47,16 +47,20 @@
"By Jakub Nowak with Imugi+Raylib" "By Jakub Nowak with Imugi+Raylib"
centered: (cons #t #f))) centered: (cons #t #f)))
;; Play button
(entity (entity
(button (button
;; Roughly centered.
;; these are ugly, hardcoded values.
(vec (- (/ (car (*window-size*)) (vec (- (/ (car (*window-size*))
2) 2)
50) 50)
(- (/ (car (*window-size*)) (- (/ (car (*window-size*))
2) 2)
100)) 100))
;; Nested footer text
(footer (footer
(vec 0 0) (vec 0 0) ;; this vec doesn't matter, it's overwritten internally
"Start Game!") "Start Game!")
play-callback)) play-callback))
)) ))