(module (tic-tac-toe) ()
(import scheme
	(chicken base)
	(chicken random)
	(imugi core)
	(imugi math)
	(imugi components core)
	(imugi drawing)
	(imugi input)
	(imugi scene)
	raylib
	(srfi 1)
	(srfi 99))

(register-event-bus 'turn-change)

(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 (get-grid-value x y)
  (list-ref (list-ref grid y) x))

(define (set-grid-value! x y val)
  (set! (list-ref (list-ref grid y) x) val))

(define (game-complete?)
  (or
   (any (lambda (x) (and (not (= (car x) 0)) (apply = x))) grid)
   (any (lambda (x) (and (not (= (car x) 0)) (apply = x)))
	(list (map (lambda (x) (list-ref x 0)) grid)
	      (map (lambda (x) (list-ref x 1)) grid)
	      (map (lambda (x) (list-ref x 2)) grid)))
   (and (not (= (get-grid-value 0 0) 0))
	(= (get-grid-value 0 0)
	   (get-grid-value 1 1)
	   (get-grid-value 2 2)))
   (and (not (= (get-grid-value 2 0) 0))
	(= (get-grid-value 2 0)
	   (get-grid-value 1 1)
	   (get-grid-value 0 2)))
   (every (lambda (x) (not (= 0 x)))
	  (flatten grid))))

(define (find-free-space)
  (let* ((empty-spaces (filter
			(lambda (x)
			  (= 0
			     (get-grid-value (car x)
					     (cdr x))))
			(map
			 (lambda (x)
			   (cons (modulo x 3)
				 (floor (/ x 3))))
			 (iota 9)))))
    (list-ref empty-spaces (pseudo-random-integer (length empty-spaces)))))

(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-record-type <turn-display>
  (make-turn-display)
  turn-display?)

(define-record-type <turn>
  (make-turn)
  turn?)

(define-record-type <bot>
  (make-bot)
  bot?)

(define-record-type <timer>
  (make-timer current max timeout done running)
  timer?
  (current timer-current set-timer-current!)
  (max timer-max)
  (timeout timer-timeout)
  (done timer-done set-timer-done!)
  (running timer-running set-timer-running!))

(define update-turn-display
  (make-system
   'update-turn-display
   1
   'entity
   '(<visual-2d> <turn-display>)
   (lambda (_ vis-2d _)
     (let ((draw (visual-2d-draw vis-2d)))
       (when (text-2d? draw)
	 (set-text-2d-text! draw
			    (case turn
			      ((player) "Your Turn!")
			      ((bot) "Bot Turn!")
			      ((end) "Game over!")
			      (else "Whose turn is it anyway??"))))))))

(define check-game-state
  (make-system
   'check-game-state
   0
   'global
   '()
   (lambda ()
     (when (game-complete?)
       (set! turn 'end)))))

(define tick-timers
  (make-system
   'tick-timers
   1
   'entity
   '(<timer>)
   (lambda (_ timer)
     (cond
      ((> (timer-current timer) (timer-max timer))
       (set-timer-done! timer #t)
       (set-timer-running! timer #f)
       (set-timer-current! timer 0)
       ((timer-timeout timer)))
      ((timer-running timer)
       (set-timer-current! timer
			   (+ (get-frame-time) (timer-current timer))))))))

(define toggle-bot
  (make-system
   'toggle-bot
   1
   'entity
   '(<timer> <bot>)
   (lambda (_ timer _)
     (when (pop-event 'turn-change 'bot)
       (set-timer-done! timer #f)
       (set-timer-running! timer #t)))))

(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 ()
      (when (and (eqv? turn 'player) (= 0 (get-grid-value x y)))
	(set-grid-value! x y 1)
	(set! turn 'bot)
	(push-event 'turn-change 'bot (make-turn)))))))

(define (game)
  (scene
   draw-rectangles
   draw-text-entities
   update-turn-display
   draw-grid-squares
   toggle-bot
   click-buttons
   tick-timers
   push-actions
   check-game-state

   (entity
    (make-turn-display)
    (make-visual-2d
     (make-text-2d
      (vec 0 0)
      "<turn>"
      24)
     (make-color 0 0 0 1)
     0)
    (make-screen-transform
     (vec 550 150)
     (vec 0 0)
     0
     (vec 1 1)
     'center
     '()))

   (entity
    (make-bot)
    (make-timer
     0
     2
     (lambda ()
       (when
	   (let ((target (find-free-space)))
	     (set-grid-value! (car target) (cdr target) 2)
	     (set! turn 'player))))
     #f
     #f))
   
   (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)
)