(module (bd attack) ()
(import scheme
	(chicken base) 
	(chicken module)
	(chicken string)
	(bd random)
	(srfi 99))

(export hand-direction hand-vert hand-horiz)
(define-record-type <hand-direction>
  (hand-direction vert horiz)
  hand-direction?
  (vert hand-vert)
  (horiz hand-horiz))

(export direction-to-string)
(define (direction-to-string dir)
  (conc (hand-vert dir)
	" : "
	(hand-horiz dir)))

(define (opposite-horiz h)
  (if (eqv? h 'right)
      'left
      'right))

(define (opposite-vert v)
  (cond
   ((eqv? v 'high) 'low)
   ((eqv? v 'mid) 'mid)
   ((eqv? v 'low) 'high)))

(export opposite-pos)
(define (opposite-pos h)
  (hand-direction
   (opposite-vert (hand-vert h))
   (opposite-horiz (hand-horiz h))))

(define (pos-= h1 h2)
  (and (eqv? (hand-vert h1) (hand-vert h2))
       (eqv? (hand-horiz h1) (hand-horiz h2))))

(define (pos-to-int h)
  (cond
   ((pos-= h (hand-direction 'high 'right)) 0)
   ((pos-= h (hand-direction 'high 'left)) 1)
   ((pos-= h (hand-direction 'mid 'left)) 2)
   ((pos-= h (hand-direction 'low 'left)) 3)
   ((pos-= h (hand-direction 'low 'right)) 4)
   ((pos-= h (hand-direction 'mid 'right)) 5)))

(define (int-to-pos i)
  (case i
    ((0) (hand-direction 'high 'right))
    ((1) (hand-direction 'high 'left))
    ((2) (hand-direction 'mid 'left))
    ((3) (hand-direction 'low 'left))
    ((4) (hand-direction 'low 'right))
    ((5) (hand-direction 'mid 'right))))

(export rotate-pos rotate-pos-cc)
(define (rotate-pos p)
  (let ((pos (pos-to-int p)))
    (if (= pos 5)
	(int-to-pos 0)
	(int-to-pos (+ 1 pos))))) 

(define (rotate-pos-cc p)
  (let ((pos (pos-to-int p)))
    (if (= pos 0)
	(int-to-pos 5)
	(int-to-pos (- pos 1)))))

(export attack attack-direction attack-offense)
(define-record-type <attack>
  (attack direction offense)
  attack?
  (direction attack-direction)
  (offense attack-offense))

(define (high-stance-attack dir)
  (if (eqv? 'high (hand-vert dir))
      80
      50))

(define (mid-stance-attack dir)
  (if (eqv? 'mid (hand-vert dir))
      80
      50))

(define (low-stance-attack dir)
  (if (eqv? 'low (hand-vert dir))
      80
      50))

(export attack-from-stance)
(define (attack-from-stance attack-direction stance)
  (attack attack-direction
	  (cond
	   ((eqv? stance 'high) (high-stance-attack attack-direction))
	   ((eqv? stance 'mid) (mid-stance-attack attack-direction))
	   ((eqv? stance 'low) (mid-stance-attack attack-direction))
	   (else 50))))

(define (high-stance-defense dir)
  (cond
   ((eqv? 'high (hand-vert dir)) 20)
   ((eqv? 'low (hand-vert dir)) -30)
   (else 0)))

(define (mid-stance-defense dir)
  (cond
   ((eqv? 'mid (hand-vert dir)) 20)
   (else -30)))

(define (low-stance-defense dir)
  (cond
   ((eqv? 'low (hand-vert dir)) 20)
   ((eqv? 'high (hand-vert dir)) -30)
   (else 0)))

(export defense-from-stance)
(define (defense-from-stance attack-dir hand-pos stance)
  (+ 40
     (if (or (eqv? (hand-vert attack-dir)
		   (opposite-vert (hand-vert hand-pos)))
	     (eqv? (hand-horiz attack-dir)
		   (opposite-horiz (hand-horiz hand-pos))))
	 20
	 0)
     (cond
      ((eqv? stance 'high) (high-stance-defense attack-dir))
      ((eqv? stance 'mid) (mid-stance-defense attack-dir))
      ((eqv? stance 'low) (low-stance-defense attack-dir))
      (else 0))))

(export resolve-combat)
(define (resolve-combat attack defense)
  (let ((tn (+ 5 (/ (- (attack-offense attack) defense) 10))))
    (if (> tn (+ 1 (rand-int 10)))
	'hit
	'miss)))
)