imugi/samples/tic-tac-toe.scm

(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 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
   '(<screen-transform> <grid-square>)
   (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 <grid-square>
  (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-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
   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)
)