Main menu for tic-tac-toe and text/rectangle drawing functions

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