Commenting
This commit is contained in:
parent
d450a0d155
commit
31a0bd9a34
2 changed files with 24 additions and 3 deletions
|
|
@ -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))))
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -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))
|
||||||
))
|
))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue