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) +)