(module (arena) ()
(import scheme
	(chicken base)
	(chicken module)
	(chicken string)
	(imugi core)
	(imugi input)
	(imugi scene)
	(imugi math)
	(bd ui)
	(bd random)
	(bd attack)
	(bd grid)
	(bd music)
	(win-screen)
	(lose-screen)
	(srfi 1)
	(srfi 99))

(define battle-state 'active)

(define player 'player)
(define enemy 'foe)
(define empty 'none)

(define grid-size 5)

(define field (grid grid-size grid-size empty))

(define-record-type <unit>
  (unit type health pos hand-pos stance)
  unit?
  (type unit-type)
  (health unit-health set-unit-health!)
  (pos unit-pos set-unit-pos!)
  (hand-pos unit-hand-pos set-unit-hand-pos!)
  (stance unit-stance set-unit-stance!))

(define player-unit
  '())

(define enemy-unit
  '())

(define-record-type <order>
  (order movement attack stance)
  order?
  (movement order-mov set-order-mov!)
  (attack order-atk set-order-atk!)
  (stance order-stance set-order-stance!))

(define (empty-order)
  (order #f
	 #f
	 #f))

(define player-order
  (empty-order))

(define (possible-enemy-moves)
  (filter
   (lambda (p)
     (let ((res (v+ p (unit-pos enemy-unit))))
       (and (> 5 (v-x res) -1)
	    (> 5 (v-y res) -1))))
   (list (vec 0 1)
	 (vec 0 -1)
	 (vec 1 0)
	 (vec -1 0))))

(define (distance-between-units)
  (let* ((p-pos (unit-pos player-unit))
	 (e-pos (unit-pos enemy-unit))
	 (d-x (abs (- (v-x p-pos) (v-x e-pos))))
	 (d-y (abs (- (v-y p-pos) (v-y e-pos)))))
    (+ d-x d-y)))

(define (enemy-order)
  (let ((o (empty-order)))
    ;; Movement AI
    (set-order-mov! o
		    (if (= 1 (unit-health enemy-unit))
			(pick-random (possible-enemy-moves))
			(if (and (< 0.4 (random))
				 (< 1 (distance-between-units)))
			    (pick-random (possible-enemy-moves))
			    #f)))
    (when (< 0.5 (random))
      (set-order-stance! o (pick-random '(high mid low))))
    (set-order-atk!
     o
     (let ((roll (random)))
       (cond
	((> 0.6 roll) (unit-hand-pos enemy-unit))
	((> 0.8 roll) (rotate-pos-cc (unit-hand-pos enemy-unit)))
	(else (rotate-pos (unit-hand-pos enemy-unit))))))
    o))

(define (win)
  (display "Win!")
  (newline))

(define (lose)
  (display "Lose!")
  (newline))

(define (attempt-attack attack-dir unit)
  (display (unit-type unit))
  (newline)
  (let* ((target (if (eqv? (unit-type unit) player) enemy-unit player-unit))
	 (outcome (resolve-combat (attack-from-stance attack-dir (unit-stance unit))
				  (defense-from-stance attack-dir
				    (unit-hand-pos target)
				    (unit-stance unit)))))
    (if (eqv? outcome 'hit)
	(begin
	  (display (conc (unit-type unit) " hits!"))
	  (set-unit-health! target (- (unit-health target) 1))
	  (when (= 0 (unit-health target))
	    (set! battle-state 'ended)
	    (if (eqv? player (unit-type target))
		(lose)
		(win))))
	(display (conc (unit-type unit) " misses!")))
    (newline)
    (set-unit-hand-pos! unit (opposite-pos attack-dir))))

(define (move-unit unit pos)
  (let ((target (if (eqv? (unit-type unit) player) enemy-unit player-unit)))
    (unless (v= (unit-pos target) pos)
      (set-unit-pos! unit pos))))

(define (apply-order order unit)
  (when (order-mov order)
    (move-unit unit (v+ (unit-pos unit) (order-mov order))))
  (when (order-stance order)
    (set-unit-stance! unit (order-stance order)))
  (when (and (order-atk order)
	     (= 1 (distance-between-units)))
    (attempt-attack (order-atk order) unit)))

(define update-grid-entities
  (make-system
   'update-grid-entities
   0
   'entity
   '(<grid-view>)
   (lambda (_ g)
     (let ((gd (grid-view-grid g)))
       (do ((i 0 (+ 1 i)))
	   ((= i (length gd)) gd)
	 (let ((row (list-ref gd i)))
	   (do ((j 0 (+ 1 j)))
	       ((= j (length row)) row)
	     (gv! gd j i (cond
			  ((v= (unit-pos player-unit) (vec j i)) player)
			  ((v= (unit-pos enemy-unit) (vec j i)) enemy)
			  (else empty))))))))))

(export arena)
(define (arena menu-scene)
  ;; Reset state
  (set! battle-state 'active)
  (set! player-unit
    (unit
      player
      3
      ;; Place player
      (vec (rand-int grid-size)
	   (rand-int grid-size))
      (hand-direction 'mid 'right)
      'mid))
  (set! enemy-unit
    (unit
      enemy
      3
      ;; Place enemy
      (let loop ()
	(let ((p-x (rand-int grid-size))
	      (p-y (rand-int grid-size)))
	  (if (not (v= (vec p-x p-y)
		       (unit-pos player-unit)))
	      (vec p-x p-y)
	      (loop))))
      (hand-direction 'mid 'left)
      'mid))
  
  (set! win (lambda ()
	      ((win-screen arena menu-scene))))
  (set! lose (lambda ()
	       ((lose-screen arena menu-scene))))
  
  (scene
   push-actions
   process-dynamic-labels
   update-grid-entities
   draw-labels
   draw-grid
   handle-buttons
   handle-music-players
   
   (entity
    (music-player
     "../res/music/Fight.wav"))
   
   ;; Level heading
   (entity
    (subtitle
     (vec
      0
      10)
     "Fight!"
     centered: (cons #t #f)))
   
   ;; Grid view
   (entity
    (grid-view
     (vec 190 100)
     field
     75))

   ;; Stance inputs
   (entity
    (button
     (vec 50
	  460)
     (footer (vec 0 0)
	     "High Stance!")
     (lambda ()
       (set-order-stance! player-order 'high))
     size: (vec 100 30)))
   (entity
    (button
     (vec 50
	  500)
     (footer (vec 0 0)
	     "Mid Stance!")
     (lambda ()
       (set-order-stance! player-order 'mid))
     size: (vec 100 30)))
   (entity
    (button
     (vec 50
	  540)
     (footer (vec 0 0)
	     "Low Stance!")
     (lambda ()
       (set-order-stance! player-order 'low))
     size: (vec 100 30)))
   
   ;; Attack inputs
   (entity
    (button
     (vec 12
	  320)
     (footer (vec 0 0)
	     "Atk: Counter-clockwise")
     (lambda ()
       (set-order-atk! player-order (rotate-pos-cc (unit-hand-pos player-unit))))
     size: (vec 175 30)))
   (entity
    (button
     (vec 12
	  360)
     (footer (vec 0 0)
	     "Atk: From position!")
     (lambda ()
       (set-order-atk! player-order (unit-hand-pos player-unit)))
     size: (vec 175 30)))
   (entity
    (button
     (vec 12
	  400)
     (footer (vec 0 0)
	     "Atk: Clockwise!")
     (lambda ()
       (set-order-atk! player-order (rotate-pos (unit-hand-pos player-unit))))
     size: (vec 175 30)))

   ;; Move inputs
   (entity
    (button
     (vec 185
	  517)
     (footer (vec 0 0)
	     "<")
     (lambda ()
       (when (< 0 (v-y (unit-pos player-unit)))
	 (set-order-mov! player-order (vec 0 -1))))
     size: (vec 30 30)))
   (entity
    (button
     (vec 255
	  517)
     (footer (vec 0 0)
	     ">")
     (lambda ()
       (when (> 4 (v-y (unit-pos player-unit)))
	 (set-order-mov! player-order (vec 0 1))))
     size: (vec 30 30)))
   (entity
    (button
     (vec 220
	  500)
     (footer (vec 0 0)
	     "^")
     (lambda ()
       (when (< 0 (v-x (unit-pos player-unit)))
	 (set-order-mov! player-order (vec -1 0))))
     size: (vec 30 30)))
   (entity
    (button
     (vec 220
	  535)
     (footer (vec 0 0)
	     "v")
     (lambda ()
       (when (> 4 (v-x (unit-pos player-unit)))
	 (set-order-mov! player-order (vec 1 0))))
     size: (vec 30 30)))
   
   ;; End turn button
   (entity
    (button
     (vec (- (/ (car (*window-size*))
		2)
	     50)
	  500)
     (footer (vec 0 0)
	     "Submit Order")
     (lambda ()
       (when (eqv? battle-state 'active)
	 (let ((o (enemy-order)))
	   (apply-order player-order player-unit)
	   (apply-order o enemy-unit)
	   (set! player-order (empty-order)))))))
   
   ;; Player data display
   (entity
    (footer
     (vec 0 0)
     ""
     centered: (cons #f #t))
    (dynamic-label
     (lambda ()
       (conc (unit-health player-unit) "/3\n"
	     "Your hand is "
	     (direction-to-string (unit-hand-pos player-unit))
	     "\nStance: " (symbol->string (unit-stance player-unit))))))

   ;; Player order display
   (entity
    (footer
     (vec 0 0)
     "")
    (dynamic-label
     (lambda ()
       (conc "Order:\n Move: "
	     (if (order-mov player-order)
		 (let ((m (order-mov player-order)))
		   (cond
		    ((v= (vec 1 0) m) "Down")
		    ((v= (vec -1 0) m) "Up")
		    ((v= (vec 0 1) m) "Right")
		    ((v= (vec 0 -1) m) "Left")))
		 "No change")
	     "\nAttack: " (if (order-atk player-order)
			      (direction-to-string (order-atk player-order))
			      "No change")
	     "\nStance: " (if (order-stance player-order)
			      (order-stance player-order)
			      "No change")))))
   
   ;; Enemy data display
   (entity
    (footer
     (vec 600 0)
     ""
     centered: (cons #f #t))
    (dynamic-label
     (lambda ()
       (conc (unit-health enemy-unit) "/3\n"
	     "Their hand is "
	     (direction-to-string (unit-hand-pos enemy-unit))
	     "\nStance: " (symbol->string (unit-stance enemy-unit))))))

   (entity
    player-unit)
   (entity
    enemy-unit)
   ))
)
