(module (arena) ()
(import scheme
	(chicken base)
	(chicken module)
	(chicken string)
	raylib
	(imugi core)
	(imugi input)
	(imugi scene)
	(imugi resource)
	(imugi drawing)
	(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 'enemy)
(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)
  (newline)
  (play-sound (load-sound "../res/sfx/hit.wav"))
  (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
	  (case (unit-health target)
	    ((3) (play-sound (load-sound "../res/sfx/hurt1.wav")))
	    ((2) (play-sound (load-sound "../res/sfx/hurt2.wav")))
	    ((1) (play-sound (load-sound "../res/sfx/hurt3.wav"))))
	  (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)))))
    (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))))))))))

(define (build-sprite-path-for unit order)
  (let ((hand-to-use (if (and (eqv? (unit-type unit) player) (order-atk order))
			 (order-atk order)
			 (unit-hand-pos unit))))
    (conc "../res/sprites/" (unit-type unit) "/"
	  (case (hand-vert hand-to-use)
	    ((high) "up")
	    ((mid) "mid")
	    ((low) "down"))
	  "-" (hand-horiz hand-to-use)
	  ".png")))

(define draw-player-sprite
  (make-system
   'draw-player-sprite
   0
   'global
   '()
   (lambda ()
     (push-render-object 'screen
			 -1
			 (lambda ()
			   (draw-texture-2d
			    (vec 0 0)
			    (texture (build-sprite-path-for player-unit player-order))
			    (make-color 1 1 1 1)))))))

(define draw-enemy-sprite
  (make-system
   'draw-enemy-sprite
   0
   'global
   '()
   (lambda ()
     (push-render-object 'screen
			 -1
			 (lambda ()
			   (draw-texture-2d
			    (vec 600 0)
			    (texture (build-sprite-path-for enemy-unit (empty-order)))
			    (make-color 1 1 1 1)))))))

(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
   draw-player-sprite
   draw-enemy-sprite
   
   (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 600 400)
     "")
    (dynamic-label
     (lambda ()
       (conc "Your 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)
   ))
)