diff options
Diffstat (limited to 'lisparuga/player.scm')
| -rw-r--r-- | lisparuga/player.scm | 152 |
1 files changed, 133 insertions, 19 deletions
diff --git a/lisparuga/player.scm b/lisparuga/player.scm index a810e48..ca57891 100644 --- a/lisparuga/player.scm +++ b/lisparuga/player.scm @@ -21,14 +21,17 @@ ;;; Code: (define-module (lisparuga player) + #:use-module (chickadee math) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee scripting) #:use-module (chickadee render texture) + #:use-module (ice-9 match) #:use-module (lisparuga actor) #:use-module (lisparuga asset) #:use-module (lisparuga bullets) #:use-module (lisparuga config) + #:use-module (lisparuga enemy) #:use-module (lisparuga node) #:use-module (lisparuga node-2d) #:use-module (oop goops) @@ -44,21 +47,23 @@ start-shooting stop-shooting toggle-polarity - fire-homing-missiles)) + fire-homing-missiles + kill-maybe + on-kill)) (define-asset ship (load-image (scope-asset "images/player.png"))) (define-asset ship-atlas (load-tile-atlas (scope-asset "images/player.png") 24 24)) -(define kill-hitbox (make-hitbox 'kill (make-rect 0.0 0.0 0.0 0.0))) -(define graze-hitbox (make-hitbox 'graze (make-rect 0.0 0.0 0.0 0.0))) +(define kill-hitbox (make-hitbox 'kill (make-rect -2.0 -2.0 4.0 4.0))) +(define graze-hitbox (make-hitbox 'graze (make-rect -12.0 -12.0 24.0 24.0))) (define-class <player> (<actor>) (score #:accessor score #:init-value 0) - (lives #:accessor lives #:init-value 2) + (lives #:accessor lives #:init-value 3) (energy #:accessor energy #:init-value 0) (chain #:accessor chain #:init-value 0) (chain-progress #:accessor chain-progress #:init-form '()) - (speed #:accessor speed #:init-value 1.75) + (speed #:accessor speed #:init-value 2.5) (invincible? #:accessor invincible? #:init-value #f) (shooting? #:accessor shooting? #:init-value #f) (shoot-time #:accessor shoot-time #:init-value 0)) @@ -153,11 +158,75 @@ ;; Change sprite (set! (index (& player ship)) (if (eq? old 'white) 4 0)))))) -(define-method (fire-homing-missiles (player <player>)) +(define-method (fire-homing-missiles (player <player>) enemies) (let* ((e (energy player)) - (n (quotient e 10))) - (set! (energy player) (- e (* n 10))) - ;; TODO: search for nearest enemy and fire missiles + (n (quotient e 10)) + (p (position player)) + (bullets (bullet-field player))) + (define (distance-to-player enemy) + ;; We don't need the true distance here so no need to use an + ;; expensive sqrt call. + (let ((ep (position enemy))) + (+ (expt (- (vec2-x ep) (vec2-x p)) 2) + (expt (- (vec2-y ep) (vec2-y p)) 2)))) + (define (find-closest-enemy enemies) + (let loop ((enemies enemies) + (closest-enemy #f) + (distance 999999999.0)) + (match enemies + ((enemy . rest) + (if (dead? enemy) + (loop rest closest-enemy distance) + (let ((d (distance-to-player enemy))) + (if (< d distance) + (loop rest enemy d) + (loop rest closest-enemy distance))))) + (() + closest-enemy)))) + (define (fire-missiles n enemy) + (let ((speed 10.0)) + (if enemy + (let* ((ep (position enemy))) + (define (aim-at-enemy bp bv) + (let ((dir (atan (- (vec2-y ep) (vec2-y bp)) + (- (vec2-x ep) (vec2-x bp))))) + (set-vec2! bv (* (cos dir) speed) (* (sin dir) speed)))) + (run-script player + (let loop ((i 0)) + (when (< i n) + (spawn-bullet bullets ikaruga-missile (polarity player) + (vec2-x p) (vec2-y p) 0.0 0.0 aim-at-enemy) + (sleep 3) + (loop (+ i 1)))))) + (let loop ((i 0)) + (when (< i n) + (let ((theta (+ (* (random:uniform) .5 pi) + (* .25 pi)))) + (spawn-bullet bullets ikaruga-missile (polarity player) + (vec2-x p) (vec2-y p) + (* (cos theta) speed) (* (sin theta) speed)) + (loop (+ i 1)))))))) + ;; Distribute missiles amongst closest enemies + (let loop ((enemies enemies) + (missiles-remaining (quotient e 10)) + (missiles-used 0)) + (if (zero? missiles-remaining) + (set! (energy player) (- e (* missiles-used 10))) + (let ((closest-enemy (find-closest-enemy enemies))) + (if closest-enemy + ;; Either kill the enemy or use all missiles. + (let ((missiles-to-fire (min (inexact->exact + (ceiling + (/ (health closest-enemy) 10.0))) + missiles-remaining))) + (fire-missiles missiles-to-fire closest-enemy) + (loop (delq closest-enemy enemies) + (- missiles-remaining missiles-to-fire) + (+ missiles-used missiles-to-fire))) + ;; No enemy available, fire missiles into the void + (begin + (fire-missiles missiles-remaining #f) + (loop enemies 0 (+ missiles-used missiles-remaining))))))) #t)) (define-method (increment-energy (player <player>)) @@ -165,18 +234,24 @@ (define-method (kill-maybe (player <player>)) (unless (invincible? player) - (set! (lives player) (- (lives player) 1)) - ;; Give player invincibility for a bit while they recover. - (run-script player - (set! (invincible? player) #t) - ;; 3 seconds of blinking - (blink 18 5) - (set! (invincible? player) #f)))) + (let ((new-lives (- (lives player) 1))) + (set! (lives player) new-lives) + (if (zero? new-lives) + (hide player) + ;; Give player invincibility for a bit while they recover. + (run-script player + (set! (invincible? player) #t) + ;; 3 seconds of blinking + (blink player 18 5) + (set! (invincible? player) #f)))))) (define-method (on-collision (player <player>) (other <actor>) hitbox other-hitbox) - (when (eq? hitbox kill-hitbox) - (kill-maybe player))) + (if (eq? hitbox kill-hitbox) + (begin + (kill-maybe player) + #t) + #f)) (define-method (on-collision (player <player>) bullet bullet-polarity hitbox) (cond @@ -184,9 +259,48 @@ ((and (eq? hitbox graze-hitbox) (eq? bullet-polarity (polarity player))) (increment-energy player) + ;; From what I can tell by watching youtube replays at .25 speed, + ;; each bullet absorbed is worth 100 points. + (set! (score player) (+ (score player) 100)) #t) ;; If a bullet makes it to the kill hitbox, lose a life. - ((eq? hitbox kill-hitbox) + ((and (eq? hitbox kill-hitbox) + (not (invincible? player))) (kill-maybe player) #t) (else #f))) + +(define (add-to-chain player polarity) + (let ((current-chain (cons polarity (chain-progress player)))) + (match current-chain + ;; complete chain. + ((or ('white 'white 'white) + ('black 'black 'black)) + (let ((new-chain (+ (chain player) 1))) + (set! (chain player) new-chain) + (set! (chain-progress player) '()) + (set! (score player) + (+ (score player) + ;; Chain formula yields these results: + ;; + ;; - 1 Chain --- 100 points + ;; - 2 Chain --- 200 points + ;; - 3 Chain --- 400 points + ;; - 4 Chain --- 800 points + ;; - 5 Chain --- 1,600 points + ;; - 6 Chain --- 3,200 points + ;; - 7 Chain --- 6,400 points + ;; - 8 Chain --- 12,800 points + ;; - 9+ Chain -- 25,600 points + (* (expt 2 (- (min new-chain 9) 1)) 100))))) + ;; 1st or 2nd kill of the chain. + ((or ('white) ('black) ('white 'white) ('black 'black)) + (set! (chain-progress player) current-chain)) + ;; failed chain, start over. + (_ + (set! (chain-progress player) '()) + (set! (chain player) 0))))) + +(define-method (on-kill (player <player>) (enemy <enemy>)) + (set! (score player) (+ (score player) (points enemy))) + (add-to-chain player (polarity enemy))) |