From 6ec23c8ff9a63bc4475615429512fb54d87981af Mon Sep 17 00:00:00 2001 From: BirDt_ Date: Sun, 19 Apr 2026 21:25:08 +0800 Subject: [PATCH 1/4] Move input to its own module --- engine/core.scm | 41 ------------------------------- engine/input.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++ samples/bounce.scm | 1 + 3 files changed, 62 insertions(+), 41 deletions(-) create mode 100644 engine/input.scm diff --git a/engine/core.scm b/engine/core.scm index bfedf65..613aa9d 100644 --- a/engine/core.scm +++ b/engine/core.scm @@ -304,8 +304,6 @@ (hash-table-set! event-buses name (make-hash-table)) name))) -(register-event-bus 'input) - ;; Remove an event bus (define (remove-event-bus name) (assert (symbol? name)) @@ -368,45 +366,6 @@ event) #f))) -;; Input actions alist -(define input-actions '()) - -;; Key-press type action -(define-record-type - (make-key-press key) - key-press? - (key key-press-key)) - -;; Add a new action to the input actions alist -(export register-action push-actions) -(define (register-action name type . data) - (assert (symbol? name)) - (assert (member type '(key-press))) - (set! input-actions - (cons (cons name - (apply (cond - ((eqv? type 'key-press) make-key-press)) - data)) - input-actions))) - -;; Default global system for simple input management -(define push-actions - (make-system - 'push-actions - 0 - 'global - '() - (lambda () - (for-each - (lambda (action) - (cond - ((key-press? (cdr action)) - (when (key-pressed? (key-press-key (cdr action))) - (push-event 'input - (car action) - (cdr action)))))) - input-actions)))) - ;; Render queue exports (export register-render-queue push-render-object evaluate-render-queue) diff --git a/engine/input.scm b/engine/input.scm new file mode 100644 index 0000000..0cf6abe --- /dev/null +++ b/engine/input.scm @@ -0,0 +1,61 @@ +(module (engine input) () +(import scheme + (chicken base) + (chicken module) + (engine core) + raylib + (srfi 99)) + +(register-event-bus 'input) + +;; Input actions alist +(define input-actions '()) + +;; Key-press type action +(define-record-type + (make-key-press key) + key-press? + (key key-press-key)) + +;; Mouse click type action +(define-record-type + (make-mouse-press button) + mouse-press? + (button mouse-press-button)) + +;; Add a new action to the input actions alist +(export register-action push-actions) +(define (register-action name type . data) + (assert (symbol? name)) + (assert (member type '(key-press mouse-press))) + (set! input-actions + (cons (cons name + (apply (cond + ((eqv? type 'key-press) make-key-press) + ((eqv? type 'mouse-press) make-mouse-press)) + data)) + input-actions))) + +;; Default global system for simple input management +(define push-actions + (make-system + 'push-actions + 0 + 'global + '() + (lambda () + (for-each + (lambda (action) + (cond + ((key-press? (cdr action)) + (when (key-pressed? (key-press-key (cdr action))) + (push-event 'input + (car action) + (cdr action)))) + ((mouse-press? (cdr action)) + (when (mouse-button-pressed? (mouse-press-button (cdr action))) + (push-event 'input + (car action) + (cdr action)))))) + input-actions)))) +) diff --git a/samples/bounce.scm b/samples/bounce.scm index 4562f39..0d93c18 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -5,6 +5,7 @@ (engine core) (engine components core) (engine math) + (engine input) (engine drawing) (engine scene) (srfi 1) From 0544429d0708b67e7bffcecaa0b172589c77558a Mon Sep 17 00:00:00 2001 From: BirDt_ Date: Sun, 19 Apr 2026 21:58:13 +0800 Subject: [PATCH 2/4] Main menu for tic-tac-toe and text/rectangle drawing functions --- engine/drawing.scm | 57 ++++++++++++- samples/tic-tac-toe.scm | 172 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 225 insertions(+), 4 deletions(-) create mode 100644 samples/tic-tac-toe.scm diff --git a/engine/drawing.scm b/engine/drawing.scm index 758ac5d..b3bc88c 100644 --- a/engine/drawing.scm +++ b/engine/drawing.scm @@ -189,6 +189,29 @@ (define set-triangle-2d-filled! (guarded-mutator triangle-2d? 'filled boolean?)) +;; 2D text drawing +(export text-2d? make-text-2d text-2d-position set-text-2d-position! + text-2d-text set-text-2d-text! text-2d-size set-text-2d-size!) +(define-record-type + (int:make-text-2d position text size) + text-2d? + (position text-2d-position int:set-text-2d-position!) + (text text-2d-text int:set-text-2d-text!) + (size text-2d-size int:set-text-2d-size!)) + +(define (make-text-2d position text size) + (assert (vec2? position)) + (assert (string? text)) + (assert ((conjoin integer? positive?) size)) + (int:make-text-2d position text size)) + +(define set-text-2d-position! + (guarded-mutator text-2d? 'position vec2?)) +(define set-text-2d-text! + (guarded-mutator text-2d? 'text string?)) +(define set-text-2d-size! + (guarded-mutator text-2d? 'size (conjoin integer? positive?))) + ;; Visual component (export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw! visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!) @@ -200,13 +223,13 @@ (layer visual-2d-layer int:set-visual-2d-layer!)) (define (make-visual-2d draw color layer) - (assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw)) + (assert ((disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw)) (assert (color? color)) (assert (integer? layer)) (int:make-visual-2d draw color layer)) (define set-visual-2d-draw! - (guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?))) + (guarded-mutator visual-2d? 'draw (disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?))) (define set-visual-2d-color! (guarded-mutator visual-2d? 'color color?)) (define set-visual-2d-layer! @@ -214,7 +237,7 @@ ;; Drawing functions ;; Helper wrappers for raylib functions -(export draw-circle-2d) +(export draw-circle-2d draw-rectangle-2d draw-text-2d) (define (draw-circle-2d pos-vec radius color filled) (assert (vec2? pos-vec)) (assert (number? radius)) @@ -222,9 +245,35 @@ (assert (boolean? filled)) ((if filled draw-circle - draw-circle-2d) + draw-circle-lines) (number->integer (v-x pos-vec)) (number->integer (v-y pos-vec)) (number->integer radius) (use-color color))) + +(define (draw-rectangle-2d pos-vec width height color filled thickness) + (assert (vec2? pos-vec)) + (assert ((conjoin integer? positive?) width)) + (assert ((conjoin integer? positive?) height)) + (assert ((conjoin integer? positive?) thickness)) + (assert (boolean? filled)) + (assert (color? color)) + (when filled + (draw-rectangle + (number->integer (v-x pos-vec)) + (number->integer (v-y pos-vec)) + width + height + (use-color color)))) + +(define (draw-text-2d pos-vec text size tint) + (assert (vec2? pos-vec)) + (assert (string? text)) + (assert ((conjoin integer? positive?) size)) + (assert (color? tint)) + (draw-text text + (number->integer (v-x pos-vec)) + (number->integer (v-y pos-vec)) + size + (use-color tint))) ) diff --git a/samples/tic-tac-toe.scm b/samples/tic-tac-toe.scm new file mode 100644 index 0000000..f929e93 --- /dev/null +++ b/samples/tic-tac-toe.scm @@ -0,0 +1,172 @@ +(module (tic-tac-toe) () +(import scheme + (chicken base) + (engine core) + (engine math) + (engine components core) + (engine drawing) + (engine input) + (engine scene) + raylib + (srfi 1) + (srfi 99)) + +(define draw-text-entities + (make-system + 'draw-text + 0 + 'entity + '( ) + (lambda (_ vis-2d transform) + (let ((draw (visual-2d-draw vis-2d))) + (when (text-2d? draw) + (push-render-object 'screen + (visual-2d-layer vis-2d) + (lambda () + (let ((draw-pos (v+ (position transform) + (text-2d-position draw)))) + (draw-text-2d + draw-pos + (text-2d-text draw) + (text-2d-size draw) + (visual-2d-color vis-2d)))))))))) + +(define draw-rectangles + (make-system + 'draw-rectangles + 0 + 'entity + '( ) + (lambda (_ vis-2d transform) + (let ((draw (visual-2d-draw vis-2d))) + (when (rectangle-2d? draw) + (push-render-object 'screen + (visual-2d-layer vis-2d) + (lambda () + (let ((draw-pos (v+ (position transform) + (rectangle-2d-origin draw)))) + (draw-rectangle-2d + draw-pos + (rectangle-2d-width draw) + (rectangle-2d-height draw) + (visual-2d-color vis-2d) + (rectangle-2d-filled? draw) + (rectangle-2d-thickness draw)))))))))) + +(register-action 'click 'mouse-press MOUSE_BUTTON_LEFT) + +(define-record-type + (make-button-region top-left bottom-right on-click) + button-region? + (top-left button-top-left) + (bottom-right button-bottom-right) + (on-click button-on-click)) + +(define click-buttons + (make-system + 'click-buttons + 1 + 'batch + '( ) + (lambda (buttons) + (when (pop-event 'input 'click) + (for-each + (lambda (button) + (let* ((btn (find button-region? button)) + (transform (find screen-transform? button)) + (top-left (v+ (position transform) + (button-top-left btn))) + (bottom-right (v+ (position transform) + (button-bottom-right btn))) + (m-x (get-mouse-x)) + (m-y (get-mouse-y))) + (when (and (< (v-x top-left) m-x (v-x bottom-right)) + (< (v-y top-left) m-y (v-y bottom-right))) + ((button-on-click btn))))) + buttons))))) + +(define (game) + (scene + draw-text-entities + + (entity + (make-screen-transform + (vec 350 250) + (vec 0 0) + 0 + (vec 1 1) + 'center + '()) + (make-visual-2d + (make-text-2d + (vec 0 0) + "You lost the game!" + 12) + (make-color 0 0 0 1) + 0)))) + +(define (main-menu) + (scene + draw-text-entities + click-buttons + draw-rectangles + push-actions + + (entity + (make-screen-transform + (vec 350 250) + (vec 0 0) + 0 + (vec 1 1) + 'center + '()) + (make-visual-2d + (make-text-2d + (vec 0 0) + "Start Game!" + 12) + (make-color 0 0 0 1) + 0)) + + (entity + (make-button-region + (vec 0 0) + (vec 100 80) + (lambda () + ((game)))) + (make-visual-2d + (make-rectangle-2d + (vec 0 0) + 100 + 80 + #t + 1) + (make-color 1 0 0 1) + 0) + (make-screen-transform + (vec 350 250) + (vec 0 0) + 0 + (vec 1 1) + 'center + '())) + + (entity + (make-visual-2d + (make-text-2d + (vec 0 0) + "Tic Tac Toe!" + 48) + (make-color 0 0 0 1) + 0) + (make-screen-transform + (vec 250 150) + (vec 0 0) + 0 + (vec 1 1) + 'center + '())))) + +((main-menu)) +(create-window) +) From 918f3ec8731cc7d4eb84387668f33a955370feae Mon Sep 17 00:00:00 2001 From: BirDt_ Date: Tue, 21 Apr 2026 17:33:32 +0800 Subject: [PATCH 3/4] Draw tic-tac-toe squares --- engine/drawing.scm | 22 ++++++---- samples/tic-tac-toe.scm | 92 +++++++++++++++++++++++++++++++++-------- 2 files changed, 89 insertions(+), 25 deletions(-) diff --git a/engine/drawing.scm b/engine/drawing.scm index b3bc88c..1b23039 100644 --- a/engine/drawing.scm +++ b/engine/drawing.scm @@ -258,13 +258,19 @@ (assert ((conjoin integer? positive?) thickness)) (assert (boolean? filled)) (assert (color? color)) - (when filled - (draw-rectangle - (number->integer (v-x pos-vec)) - (number->integer (v-y pos-vec)) - width - height - (use-color color)))) + (if filled + (draw-rectangle + (number->integer (v-x pos-vec)) + (number->integer (v-y pos-vec)) + width + height + (use-color color)) + (draw-rectangle-lines + (number->integer (v-x pos-vec)) + (number->integer (v-y pos-vec)) + width + height + (use-color color)))) (define (draw-text-2d pos-vec text size tint) (assert (vec2? pos-vec)) @@ -276,4 +282,4 @@ (number->integer (v-y pos-vec)) size (use-color tint))) -) + ) diff --git a/samples/tic-tac-toe.scm b/samples/tic-tac-toe.scm index f929e93..0cc9eb8 100644 --- a/samples/tic-tac-toe.scm +++ b/samples/tic-tac-toe.scm @@ -85,25 +85,83 @@ ((button-on-click btn))))) buttons))))) +(define grid '((0 0 0) + (0 0 0) + (0 0 0))) + +(define turn 'player) ;; Either 'player or 'bot + +(define grid-square-size (vec 150 150)) + +(define padding (vec 50 50)) + +(define draw-grid-squares + (make-system + 'draw-grid-squares + 0 + 'entity + '( ) + (lambda (_ transform sq) + (let ((check (list-ref (list-ref grid (g-y sq)) (g-x sq)))) + (push-render-object 'screen + 0 + (lambda () + (draw-text-2d + (v+ (v/ grid-square-size 4) (position transform)) + (cond + ((= check 1) "X") + ((= check 2) "O") + (else "")) + 64 + (make-color 0 0 0 1)))))))) + +(define-record-type + (make-g-s x y) + grid-square? + (x g-x) + (y g-y)) + +(define (make-grid-square x y) + (entity + (make-g-s x y) + (make-screen-transform + (v+ padding (v* (vec x y) grid-square-size)) + (vec 0 0) + 0 + (vec 1 1) + 'center + '()) + (make-visual-2d + (make-rectangle-2d + (vec 0 0) + (v-x grid-square-size) + (v-y grid-square-size) + #f + 10) + (make-color 0 0 0 1) + 0) + (make-button-region + (vec 0 0) + grid-square-size + (lambda () + (set! (list-ref (list-ref grid y) x) (+ 1 (list-ref (list-ref grid y) x))))))) + (define (game) (scene - draw-text-entities - - (entity - (make-screen-transform - (vec 350 250) - (vec 0 0) - 0 - (vec 1 1) - 'center - '()) - (make-visual-2d - (make-text-2d - (vec 0 0) - "You lost the game!" - 12) - (make-color 0 0 0 1) - 0)))) + draw-rectangles + draw-grid-squares + click-buttons + push-actions + + (make-grid-square 0 0) + (make-grid-square 1 0) + (make-grid-square 2 0) + (make-grid-square 0 1) + (make-grid-square 1 1) + (make-grid-square 2 1) + (make-grid-square 0 2) + (make-grid-square 1 2) + (make-grid-square 2 2))) (define (main-menu) (scene From 62c821e87b5509530576d75d2aa3ff35e82e7f94 Mon Sep 17 00:00:00 2001 From: BirDt_ Date: Wed, 22 Apr 2026 21:23:55 +0800 Subject: [PATCH 4/4] Finish tic-tac-toe --- samples/tic-tac-toe.scm | 155 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 154 insertions(+), 1 deletion(-) diff --git a/samples/tic-tac-toe.scm b/samples/tic-tac-toe.scm index 0cc9eb8..65b3ed3 100644 --- a/samples/tic-tac-toe.scm +++ b/samples/tic-tac-toe.scm @@ -1,6 +1,7 @@ (module (tic-tac-toe) () (import scheme (chicken base) + (chicken random) (engine core) (engine math) (engine components core) @@ -11,6 +12,8 @@ (srfi 1) (srfi 99)) +(register-event-bus 'turn-change) + (define draw-text-entities (make-system 'draw-text @@ -93,6 +96,43 @@ (define grid-square-size (vec 150 150)) +(define (get-grid-value x y) + (list-ref (list-ref grid y) x)) + +(define (set-grid-value! x y val) + (set! (list-ref (list-ref grid y) x) val)) + +(define (game-complete?) + (or + (any (lambda (x) (and (not (= (car x) 0)) (apply = x))) grid) + (any (lambda (x) (and (not (= (car x) 0)) (apply = x))) + (list (map (lambda (x) (list-ref x 0)) grid) + (map (lambda (x) (list-ref x 1)) grid) + (map (lambda (x) (list-ref x 2)) grid))) + (and (not (= (get-grid-value 0 0) 0)) + (= (get-grid-value 0 0) + (get-grid-value 1 1) + (get-grid-value 2 2))) + (and (not (= (get-grid-value 2 0) 0)) + (= (get-grid-value 2 0) + (get-grid-value 1 1) + (get-grid-value 0 2))) + (every (lambda (x) (not (= 0 x))) + (flatten grid)))) + +(define (find-free-space) + (let* ((empty-spaces (filter + (lambda (x) + (= 0 + (get-grid-value (car x) + (cdr x)))) + (map + (lambda (x) + (cons (modulo x 3) + (floor (/ x 3)))) + (iota 9))))) + (list-ref empty-spaces (pseudo-random-integer (length empty-spaces))))) + (define padding (vec 50 50)) (define draw-grid-squares @@ -121,6 +161,81 @@ (x g-x) (y g-y)) +(define-record-type + (make-turn-display) + turn-display?) + +(define-record-type + (make-turn) + turn?) + +(define-record-type + (make-bot) + bot?) + +(define-record-type + (make-timer current max timeout done running) + timer? + (current timer-current set-timer-current!) + (max timer-max) + (timeout timer-timeout) + (done timer-done set-timer-done!) + (running timer-running set-timer-running!)) + +(define update-turn-display + (make-system + 'update-turn-display + 1 + 'entity + '( ) + (lambda (_ vis-2d _) + (let ((draw (visual-2d-draw vis-2d))) + (when (text-2d? draw) + (set-text-2d-text! draw + (case turn + ((player) "Your Turn!") + ((bot) "Bot Turn!") + ((end) "Game over!") + (else "Whose turn is it anyway??")))))))) + +(define check-game-state + (make-system + 'check-game-state + 0 + 'global + '() + (lambda () + (when (game-complete?) + (set! turn 'end))))) + +(define tick-timers + (make-system + 'tick-timers + 1 + 'entity + '() + (lambda (_ timer) + (cond + ((> (timer-current timer) (timer-max timer)) + (set-timer-done! timer #t) + (set-timer-running! timer #f) + (set-timer-current! timer 0) + ((timer-timeout timer))) + ((timer-running timer) + (set-timer-current! timer + (+ (get-frame-time) (timer-current timer)))))))) + +(define toggle-bot + (make-system + 'toggle-bot + 1 + 'entity + '( ) + (lambda (_ timer _) + (when (pop-event 'turn-change 'bot) + (set-timer-done! timer #f) + (set-timer-running! timer #t))))) + (define (make-grid-square x y) (entity (make-g-s x y) @@ -144,14 +259,52 @@ (vec 0 0) grid-square-size (lambda () - (set! (list-ref (list-ref grid y) x) (+ 1 (list-ref (list-ref grid y) x))))))) + (when (and (eqv? turn 'player) (= 0 (get-grid-value x y))) + (set-grid-value! x y 1) + (set! turn 'bot) + (push-event 'turn-change 'bot (make-turn))))))) (define (game) (scene draw-rectangles + draw-text-entities + update-turn-display draw-grid-squares + toggle-bot click-buttons + tick-timers push-actions + check-game-state + + (entity + (make-turn-display) + (make-visual-2d + (make-text-2d + (vec 0 0) + "" + 24) + (make-color 0 0 0 1) + 0) + (make-screen-transform + (vec 550 150) + (vec 0 0) + 0 + (vec 1 1) + 'center + '())) + + (entity + (make-bot) + (make-timer + 0 + 2 + (lambda () + (when + (let ((target (find-free-space))) + (set-grid-value! (car target) (cdr target) 2) + (set! turn 'player)))) + #f + #f)) (make-grid-square 0 0) (make-grid-square 1 0)