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 <text-2d>
+  (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)))
 )

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
+   '(<visual-2d> <screen-transform>)
+   (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
+   '(<visual-2d> <screen-transform>)
+   (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 <button-region>
+  (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
+   '(<button-region> <screen-transform>)
+   (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)
+)