440 lines
9.7 KiB
Scheme
440 lines
9.7 KiB
Scheme
(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)
|
|
))
|
|
)
|