diff options
Diffstat (limited to 'lisparuga/game.scm')
| -rw-r--r-- | lisparuga/game.scm | 281 |
1 files changed, 232 insertions, 49 deletions
diff --git a/lisparuga/game.scm b/lisparuga/game.scm index 5b14edd..9e79898 100644 --- a/lisparuga/game.scm +++ b/lisparuga/game.scm @@ -22,9 +22,11 @@ ;;; Code: (define-module (lisparuga game) + #:use-module (chickadee) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee render color) + #:use-module (chickadee render particles) #:use-module (chickadee render texture) #:use-module (chickadee scripting) #:use-module (ice-9 format) @@ -42,17 +44,36 @@ start-player-shooting stop-player-shooting toggle-player-polarity - fire-player-homing-missiles)) + fire-player-homing-missiles + spawn-enemies + start-stage + game-over? + complete?)) (define-asset clouds (load-image (scope-asset "images/clouds.png"))) (define-asset player-bullet-atlas (load-tile-atlas (scope-asset "images/player-bullets.png") 16 16)) (define-asset enemy-bullet-atlas (load-tile-atlas (scope-asset "images/enemy-bullets.png") 24 24)) +(define-asset explosion-texture + (load-image (scope-asset "images/explosion.png"))) ;; nodes needed: ;; scrolling background -(define-class <game> (<node-2d>)) +(define-class <game> (<canvas>) + (player-control? #:accessor player-control? #:init-value #f) + (complete? #:accessor complete? #:init-value #f)) + +(define-method (initialize (game <game>) initargs) + (next-method) + (set! (views game) + ;; Game happens on a 160x240 pixel screen. + (list (make <view-2d> + #:camera (make <camera-2d> + #:width 160 + #:height 240) + #:area (make-rect 80 0 160 240) + #:clear-color (make-color 0.0 0.0 0.0 1.0))))) (define-method (on-boot (game <game>)) (let* ((player-bullets (make <bullet-field> @@ -60,58 +81,79 @@ #:rank 2 #:capacity 500 #:texture-atlas player-bullet-atlas)) - (player (make-player player-bullets)) (enemy-bullets (make <bullet-field> #:name 'enemy-bullets - #:rank 4 + #:rank 5 #:capacity 1000 #:texture-atlas enemy-bullet-atlas)) + (explosions (make <particles> + #:name 'explosions + #:rank 3 + #:particles + (make-particles 1000 + #:texture (asset-ref explosion-texture) + #:end-color (make-color 1.0 1.0 1.0 0.0) + #:speed-range (vec2 0.5 5.0) + #:lifetime 12))) (ui (make <node-2d> #:name 'ui #:rank 999))) - (set! (rank player) 1) (attach-to game (make <sprite> #:name 'clouds #:rank 0 #:texture clouds) - player player-bullets (make <node-2d> #:name 'enemies - #:rank 3) + #:rank 4) + explosions enemy-bullets ui) ;; Setup UI elements + ;; TODO: Move this out of here. (attach-to ui (make <label> #:name 'score - #:position (vec2 2.0 226.0)) + #:position (vec2 2.0 242.0) + #:vertical-align 'top) (make <label> #:name 'chain - #:position (vec2 2.0 210.0)) + #:position (vec2 158.0 242.0) + #:align 'right + #:vertical-align 'top) (make <label> #:name 'energy - #:position (vec2 2.0 18.0)) + #:position (vec2 158.0 2.0) + #:align 'right) (make <label> #:name 'lives #:position (vec2 2.0 2.0))) + (start-stage game))) + +(define-method (start-stage (game <game>)) + (let ((player (make-player (& game player-bullets)))) + (set! (rank player) 1) + (attach-to game player) (update-ui game) - ;; Test enemy - (spawn-enemy game (make-utatsugumi 'white 10.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 30.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 50.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 70.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 90.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 110.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 130.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 150.0 180.0)))) - -(define (update-ui game) + (play-stage-1 game))) + +(define-method (spawn-enemies (game <game>)) + ;; Test enemies + (spawn-enemy game (make-utatsugumi 'white 10.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 30.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 50.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 70.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 90.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 110.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 130.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 150.0 180.0))) + +(define-method (update-ui (game <game>)) (set! (text (& game ui score)) - (format #f "~9,'0d" (score (& game player)))) + (format #f "~7,'0d" (score (& game player)))) (set! (text (& game ui chain)) - (format #f "CHAIN ~a: ~a" + (format #f "~a CHAIN (~a)" (let ((n (chain (& game player)))) (if (< n 9) (number->string n) "MAX")) (list->string @@ -121,48 +163,189 @@ #\B)) (chain-progress (& game player)))))) (set! (text (& game ui energy)) - (format #f "E~d" (quotient (energy (& game player)) 10))) + (format #f "ENERGY ~d" (quotient (energy (& game player)) 10))) (set! (text (& game ui lives)) - (format #f "x~d" (max (- (lives (& game player)) 1) 0)))) + (format #f "SHIP x~d" (max (- (lives (& game player)) 1) 0)))) + +(define-method (explode (game <game>) (actor <actor>)) + (let* ((p (position actor)) + (emitter (make-particle-emitter (make-rect (- (vec2-x p) 8.0) + (- (vec2-y p) 8.0) + 16.0 16.0) + 8 5))) + (add-particle-emitter (particles (& game explosions)) emitter))) (define-method (update (game <game>) dt) (let ((refresh-ui? #f) (player (& game player))) - ;; enemy -> player bullet collision - ;; enemy -> player collision - (for-each (lambda (enemy) - (cond - ((and (collide (& game player-bullets) enemy) - (dead? enemy)) - (on-kill player enemy) - (fire-parting-shots-maybe enemy player) - (detach enemy) - (set! refresh-ui? #t)) - ((collide player enemy) - (set! refresh-ui? #t)))) - (children (& game enemies))) - ;; player -> enemy bullet collision - (when (collide (& game enemy-bullets) (& game player)) - (set! refresh-ui? #t)) - (when refresh-ui? - (update-ui game)))) + (when player + ;; enemy -> player bullet collision + ;; enemy -> player collision + (for-each (lambda (enemy) + (cond + ((and (collide (& game player-bullets) enemy) + (dead? enemy)) + (on-kill player enemy) + (fire-parting-shots-maybe enemy player) + (explode game enemy) + (detach enemy) + (set! refresh-ui? #t)) + ((collide player enemy) + (set! refresh-ui? #t)))) + (children (& game enemies))) + ;; player -> enemy bullet collision + (when (collide (& game enemy-bullets) (& game player)) + (set! refresh-ui? #t)) + (when refresh-ui? + (update-ui game))) + (next-method))) (define-method (spawn-enemy (game <game>) enemy) (set! (bullet-field enemy) (& game enemy-bullets)) (attach-to (& game enemies) enemy)) (define-method (steer-player (game <game>) up? down? left? right?) - (steer (& game player) up? down? left? right?)) + (when (player-control? game) + (steer (& game player) up? down? left? right?))) (define-method (start-player-shooting (game <game>)) - (start-shooting (& game player))) + (when (player-control? game) + (start-shooting (& game player)))) (define-method (stop-player-shooting (game <game>)) - (stop-shooting (& game player))) + (when (player-control? game) + (stop-shooting (& game player)))) (define-method (toggle-player-polarity (game <game>)) - (toggle-polarity (& game player))) + (when (player-control? game) + (toggle-polarity (& game player)))) (define-method (fire-player-homing-missiles (game <game>)) - (fire-homing-missiles (& game player) (children (& game enemies))) - (update-ui game)) + (when (player-control? game) + (fire-homing-missiles (& game player) (children (& game enemies))) + (update-ui game))) + +(define-method (game-over? (game <game>)) + (let ((player (& game player))) + (and player (dead? player)))) + +(define-method (play-stage-1 game) + (run-script game + (do-intro game) + (do-tutorial game) + (do-phase-1 game) + (do-win game))) + +(define-method (do-intro (game <game>)) + (hide (& game ui)) + (teleport (& game player) 80.0 -24.0) + (move-to (& game player) 80.0 32.0 50) + (steer (& game player) #f #f #f #f) + (set! (player-control? game) #t) + (show (& game ui))) + +(define *skip-tutorial?* #t) + +(define-method (do-tutorial (game <game>)) + (define* (instruct text continue? #:optional (post-delay 60)) + (let ((instructions (make <label> + #:text text + #:align 'center + #:vertical-align 'center + #:position (vec2 80.0 120.0)))) + (attach-to (& game ui) instructions) + (while (not (continue?)) + (sleep 10)) + (sleep post-delay) + (detach instructions) + (sleep 60))) + (unless *skip-tutorial?* + (sleep 30) + (instruct "use arrow keys to move" + (let ((v (velocity (& game player)))) + (lambda () + (not (and (= (vec2-x v) 0.0) + (= (vec2-y v) 0.0)))))) + (instruct "press Z to shoot" + (lambda () + (shooting? (& game player)))) + (instruct "press X to change color" + (let ((starting-polarity (polarity (& game player)))) + (lambda () + (not (eq? (polarity (& game player)) starting-polarity))))) + (instruct "avoid opposite energy" (const #t) 120) + (instruct "absorb same energy" (const #t) 120) + (add-energy (& game player) 120) + (update-ui game) + (instruct "press C to release energy" + (lambda () + (zero? (energy (& game player))))) + (instruct "get ready!" (const #t) 120))) + +(define-method (do-phase-1 (game <game>)) + (define (utatsugumi-sweep x polarity) + (let loop ((i 0)) + (when (< i 6) + (let ((utatsugumi (make-utatsugumi polarity x 260.0))) + (spawn-enemy game utatsugumi) + (set-vec2! (velocity utatsugumi) 0.0 -3.0) + (script + (sleep (* 10 60)) + (detach utatsugumi)) + (sleep 10)) + (loop (+ i 1))))) + (utatsugumi-sweep 140.0 'white) + (sleep 60) + (utatsugumi-sweep 20.0 'black) + (sleep 60) + (utatsugumi-sweep 140.0 'white) + (sleep 60) + (utatsugumi-sweep 20.0 'black) + (sleep (* 3 60))) + +(define-method (do-win (game <game>)) + (set! (player-control? game) #f) + (steer (& game player) #f #f #f #f) + (stop-shooting (& game player)) + (hide (& game ui)) + (let ((battle-report (make <node-2d> + #:name 'battle-report + #:rank 999))) + (define (add-row y name value) + (attach-to battle-report + (make <label> + #:rank 999 + #:text name + #:align 'left + #:position (vec2 16.0 y)) + (make <label> + #:rank 999 + #:text value + #:align 'left + #:position (vec2 96.0 y)))) + (let ((backdrop (make <filled-rect> + #:region (make-rect 0.0 0.0 160.0 240.0)))) + (attach-to battle-report backdrop) + (attach-to game battle-report) + (tween 45 (make-color 0.0 0.0 0.0 0.0) (make-color 0.0 0.0 0.0 0.8) + (lambda (c) + (set! (color backdrop) c)) + #:interpolate color-lerp)) + (attach-to battle-report + (make <label> + #:rank 999 + #:text "BATTLE REPORT" + #:align 'center + #:position (vec2 80.0 180.0))) + (sleep 30) + (add-row 140.0 "SCORE" (number->string (score (& game player)))) + (sleep 30) + (add-row 110.0 "MAX CHAIN" (number->string (max-chain (& game player)))) + (sleep 30) + (attach-to battle-report + (make <label> + #:rank 999 + #:text "press ENTER to play again" + #:position (vec2 80.0 60.0) + #:align 'center)) + (set! (complete? game) #t))) |