diff --git a/engine/core.scm b/engine/core.scm index 613aa9d..bfedf65 100644 --- a/engine/core.scm +++ b/engine/core.scm @@ -304,6 +304,8 @@ (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)) @@ -366,6 +368,45 @@ 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/drawing.scm b/engine/drawing.scm index b3bc88c..758ac5d 100644 --- a/engine/drawing.scm +++ b/engine/drawing.scm @@ -189,29 +189,6 @@ (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!) @@ -223,13 +200,13 @@ (layer visual-2d-layer int:set-visual-2d-layer!)) (define (make-visual-2d draw color layer) - (assert ((disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw)) + (assert ((disjoin 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 text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?))) + (guarded-mutator visual-2d? 'draw (disjoin 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! @@ -237,7 +214,7 @@ ;; Drawing functions ;; Helper wrappers for raylib functions -(export draw-circle-2d draw-rectangle-2d draw-text-2d) +(export draw-circle-2d) (define (draw-circle-2d pos-vec radius color filled) (assert (vec2? pos-vec)) (assert (number? radius)) @@ -245,35 +222,9 @@ (assert (boolean? filled)) ((if filled draw-circle - draw-circle-lines) + draw-circle-2d) (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/engine/input.scm b/engine/input.scm deleted file mode 100644 index 0cf6abe..0000000 --- a/engine/input.scm +++ /dev/null @@ -1,61 +0,0 @@ -(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 0d93c18..4562f39 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -5,7 +5,6 @@ (engine core) (engine components core) (engine math) - (engine input) (engine drawing) (engine scene) (srfi 1) diff --git a/samples/tic-tac-toe.scm b/samples/tic-tac-toe.scm deleted file mode 100644 index f929e93..0000000 --- a/samples/tic-tac-toe.scm +++ /dev/null @@ -1,172 +0,0 @@ -(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) -)