Basic combat

README.org

@@ -15,61 +15,31 @@ Once both of those dependencies are installed, run:
   ./bitter-duel
 #+end_src
 
-* Design & Gameplay
+* How To Play
+First to 3 hits wins.
 
-In Bitter Duel, you control a single character on a 5 by 5 grid. There is a single opponent facing off against you.
+You are blue.
 
-Each character has a stance and hand position, and can move, attack, or assume a stance on their turn.
+Each unit on the board has a stance and a hand position.
-Each character has 3 health.
+
+The stance can be high, mid, or low. You can change your stance each turn.
+
+Hand position can be high-right, high-left, mid-right, mid-left, low-right, low-left --- forming a circle.
+Each turn you can choose to attack from your current hand position, or from an adjacent one on the circle.
+For example, from high-right, you can attack from high-right, high-left, or mid-right.
+After the attack, your hand moves to the opposite position.
+For example, attacking from high-right, your hand becomes low-left.
+
+You can move 1 square on each turn.
+
+Build your order: move, change stance, and attack.
+
+Orders are submitted simultaneously and then resolved: movement first, then stance change, then attack if in range (neighboring squares).
 
 ** Stances
-Stances are initial striking positions, and provide some intrinsic bonus offense and defense on the turn that the stance is assumed.
+Your chance to hit is higher if your attack matches your stance. A mid-right attack has a lower chance of hidding from a high stance than a high-right attack.
 
-After attacking or moving, your stance is broken until you next assume it.
+Your stance also determines your defense.
-
+A high stance has bonus defense against high attacks, but weak defense against low attacks.
-There are 4 stances:
+A low stance is the opposite.
-- High (Up-Left/Up-Right)
+A mid stance has bonus defense against mid attacks, but weak defense against high and low.
-  - The High stance has a higher defense (70) against High and (60) Stab attacks, but low defense against Low attacks (30).
-  - The High stance adds additional offense to your High attacks (80).
-- Low (Down-Left/Down-Right)
-  - The Low stance has higher defense (70) against Low and (60) Stab attacks, but low defense against High attacks (30).
-  - The low stance adds additional offense to your Low attacks (70).
-- Side (Mid-Left/Mid-Right)
-  - The Side stance has higher defense (70) against swing attacks, but low defense (30) against High and Low attacks.
-  - The Side stance adds additional offense to your Swing attacks (70)
-    
-** Hand Position
-Your hand position adds defense against attacks coming from that direction (60) and dictates what next attacks you can perform.
-
-The hand positions are:
-- Up-left:
-  - Defense against top and right attacks.
-- Up-right
-  - Defense against top and left attacks.
-- Mid-right
-  - Defense against mid and left attacks.
-- Mid-left
-  - Defense against mid and right attacks.
-- Down-left
-  - Defense against bottom and right attacks.
-- Down-right
-  - Defense against bottom and left attacks.
-
-** Attacks
-Each of the hand positions is also a type of attack. You may perform an attack from the 3 positions near the hand position.
-For example, Up-Left can attack from Up-Left, Up-Right, or Mid-Left.
-After an attack, your hand position changes to the opposite of the attack. So Up-Left becomes Down-Right.
-
-** Attacking and Turns
-Both players lock in their actions, then the turn is resolved like so:
-1. Handle any stance changes
-2. Handle any movement.
-3. Resolve attacks.
-
-To resolve an attack, get the offense of the attack and defense for that attack from the defender.
-Subtract Defense from Offense, divide by 10, and add 5. Call this the "target number".
-Roll a number between 1 and 10. If the roll is lower than the target number, the attack goes through and the defender takes a hit.
-Characters always attack and defend from the hand position they start in at the beginning of the turn.
-
-* Credits
-- https://sethbb.itch.io/32rogues

modules/attack.scm

@@ -0,0 +1,143 @@
+(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)))
+)

modules/grid.scm

@@ -0,0 +1,74 @@
+(module (bd grid) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	raylib
+	(imugi core)
+	(imugi drawing)
+	(imugi math)
+	(srfi 1)
+	(srfi 99))
+
+(export grid)
+(define (grid len wid default)
+  (define (iter i acc)
+    (if (= len i)
+	acc
+	(iter
+	 (+ 1 i)
+	 (cons (make-list wid default) acc))))
+  (iter 0 '()))
+
+(export gv)
+(define (gv grd x y)
+  (list-ref (list-ref grd y) x))
+
+(export gv!)
+(define (gv! grd x y val)
+  (set! (list-ref (list-ref grd y) x) val))
+
+(define (draw-grid-square offset width x y entity)
+  (let ((square-pos (v+ offset
+			(vec (* x width)
+			     (* y width)))))
+    (push-render-object
+     'screen
+     0
+     (lambda ()
+       (draw-rectangle-2d
+	square-pos
+	width
+	width
+	(cond
+	 ((eqv? entity 'player) (make-color 0 0 1 1))
+	 ((eqv? entity 'foe) (make-color 1 0 0 1))
+	 (else (make-color 0 0 0 1)))
+	(not (eqv? entity 'none))
+	2)))))
+
+(export draw-grid)
+(define draw-grid
+  (make-system
+   'draw-grid
+   10
+   'entity
+   '(<grid-view>)
+   (lambda (_ grid-view)
+     (let ((gd (grid-view-grid grid-view))
+	   (width (grid-view-width grid-view))
+	   (pos (grid-view-pos grid-view)))
+       (do ((i 0 (+ 1 i)))
+	   ((= i (length gd)) gd)
+	 (let ((row (list-ref gd i)))
+	   (do ((j 0 (+ 1 j)))
+	       ((= j (length row)) row)
+	     (draw-grid-square pos width i j (list-ref row j)))))))))
+
+(export grid-view grid-view-grid)
+(define-record-type <grid-view>
+  (grid-view start-pos gd width)
+  grid-view?
+  (start-pos grid-view-pos set-grid-view-pos!)
+  (gd grid-view-grid set-grid-view-grid!)
+  (width grid-view-width set-grid-view-width!))
+)

modules/random.scm

@@ -0,0 +1,15 @@
+(module (bd random) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	(chicken random))
+
+(export random)
+(export rand-int)
+(define random pseudo-random-real)
+(define rand-int pseudo-random-integer)
+
+(export pick-random)
+(define (pick-random lst)
+  (list-ref lst (rand-int (length lst))))
+)

modules/ui.scm

@@ -29,6 +29,22 @@
   (color label-color set-label-color!)
   (text label-text set-label-text!))
 
+(export process-dynamic-labels)
+(define process-dynamic-labels
+  (make-system
+   'process-dynamic-labels
+   9
+   'entity
+   '(<label> <dynamic-label>)
+   (lambda (_ label d-label)
+     (set-label-text! label ((label-func d-label))))))
+
+(export dynamic-label)
+(define-record-type <dynamic-label>
+  (dynamic-label func)
+  dynamic-label?
+  (func label-func))
+
 ;; Title/subtitle/footer etc are basically just different styles
 (export title)
 (define (title position text

src/arena.scm

@@ -0,0 +1,361 @@
+(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)
+	(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
+  (unit
+    player
+    3
+    ;; Place player
+    (vec (rand-int grid-size)
+	 (rand-int grid-size))
+    (hand-direction 'mid 'right)
+    'mid))
+
+(define 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))
+
+(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 (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)))
+	(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)
+  (scene
+   push-actions
+   process-dynamic-labels
+   update-grid-entities
+   draw-labels
+   draw-grid
+   handle-buttons
+   
+   ;; 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)
+   ))
+)

src/bitter-duel.scm

@@ -4,12 +4,14 @@
 	raylib
 	(imugi core)
 	(imugi input)
-	(main-menu))
+	(main-menu)
+	(arena))
 
 (register-action 'click 'mouse-press MOUSE_BUTTON_LEFT)
 
 ((main-menu (lambda ()
 	      (display "Loading game scene...")
-	      (newline))))
+	      (newline)
+	      ((arena)))))
 
 (create-window))