diff options
Diffstat (limited to 'lisparuga')
| -rw-r--r-- | lisparuga/actor.scm | 10 | ||||
| -rw-r--r-- | lisparuga/bullets.scm | 12 | ||||
| -rw-r--r-- | lisparuga/enemy.scm | 79 | ||||
| -rw-r--r-- | lisparuga/game.scm | 273 | ||||
| -rw-r--r-- | lisparuga/player.scm | 31 |
5 files changed, 358 insertions, 47 deletions
diff --git a/lisparuga/actor.scm b/lisparuga/actor.scm index 5439e6b..625a2a1 100644 --- a/lisparuga/actor.scm +++ b/lisparuga/actor.scm @@ -93,7 +93,7 @@ (world-hitboxes #:accessor world-hitboxes #:init-form '()) (bullet-field #:accessor bullet-field #:init-keyword #:bullet-field)) -(define (sync-hitboxes actor) +(define-method (sync-hitboxes (actor <actor>)) ;; Sync hitboxes to world coordinates. (let ((pos (position actor))) (for-each (lambda (world-hitbox) @@ -106,6 +106,14 @@ (map make-world-hitbox (hitboxes actor))) (sync-hitboxes actor)) +(define-method (move-to (actor <actor>) x y) + (next-method) + (sync-hitboxes actor)) + +(define-method (teleport (actor <actor>) x y) + (next-method) + (sync-hitboxes actor)) + (define-method (update (actor <actor>) dt) (let ((v (velocity actor))) (unless (and (= (vec2-x v) 0.0) diff --git a/lisparuga/bullets.scm b/lisparuga/bullets.scm index 6645f0d..4fee7c1 100644 --- a/lisparuga/bullets.scm +++ b/lisparuga/bullets.scm @@ -73,15 +73,15 @@ (define small-dot (make-bullet 'small-dot (make-rect -1.0 -1.0 2.0 2.0) 0 1)) (define medium-dot - (make-bullet 'medium-dot (make-rect 0.0 0.0 0.0 0.0) 0 1)) + (make-bullet 'medium-dot (make-rect -2.0 -2.0 4.0 4.0) 6 7)) (define large-dot - (make-bullet 'large-dot (make-rect 0.0 0.0 0.0 0.0) 0 1)) -(define tapered-shot - (make-bullet 'tapered-shot (make-rect 0.0 0.0 0.0 0.0) 0 1)) + (make-bullet 'large-dot (make-rect -7.0 -7.0 14.0 14.0) 10 11)) +;; (define tapered-shot +;; (make-bullet 'tapered-shot (make-rect 0.0 0.0 0.0 0.0) 0 1)) ;; Do lasers need a special data type? maybe I won't even get around ;; to implementing them... -(define big-laser - (make-bullet 'big-laser (make-rect 0.0 0.0 0.0 0.0) 0 1)) +;; (define big-laser +;; (make-bullet 'big-laser (make-rect 0.0 0.0 0.0 0.0) 0 1)) ;;; diff --git a/lisparuga/enemy.scm b/lisparuga/enemy.scm index 06533ea..9213890 100644 --- a/lisparuga/enemy.scm +++ b/lisparuga/enemy.scm @@ -41,7 +41,9 @@ dead? fire-parting-shots-maybe - make-utatsugumi)) + make-utatsugumi + make-toratsugumi + make-renjyaku)) ;;; @@ -107,15 +109,22 @@ (set! (fire-parting-shots? enemy) #t))) #t) -(define %enemy-tiles - ;; 0: Utatsugumi - white - `((0.0 0.0 24.0 24.0) - ;; 1: Utatsugumi - black - (24.0 0.0 24.0 24.0))) - -(define (load-enemy-atlas file-name) - (let ((texture (load-image file-name))) - (list->texture-atlas texture %enemy-tiles))) +(define-method (load-enemy-atlas file-name) + (let ((texture (load-image file-name)) + (enemy-tiles + ;; 0: Utatsugumi - white + `((0.0 0.0 24.0 24.0) + ;; 1: Utatsugumi - black + (24.0 0.0 24.0 24.0) + ;; 2: Toratsugumi - white + (0.0 24.0 24.0 24.0) + ;; 3: Toratsugumi - black + (24.0 24.0 24.0 24.0) + ;; 4: Renjyaku - white + (48.0 0.0 48.0 48.0) + ;; 5: Renjyaku - black + (96.0 0.0 48.0 48.0)))) + (list->texture-atlas texture enemy-tiles))) (define-asset enemy-atlas (load-enemy-atlas (scope-asset "images/enemies.png"))) @@ -144,3 +153,53 @@ #:hitboxes (list (make-hitbox 'utatsugumi (make-rect -10.0 -10.0 20.0 20.0))) #:position (vec2 x y))) + + +;;; +;;; Toratsugumi +;;; + +(define-class <toratsugumi> (<enemy>)) + +(define-method (on-boot (toratsugumi <toratsugumi>)) + (attach-to toratsugumi + (make <atlas-sprite> + #:atlas enemy-atlas + #:index (if (eq? 'white (polarity toratsugumi)) 2 3) + #:origin (vec2 12.0 12.0)))) + +(define (make-toratsugumi polarity x y) + (make <toratsugumi> + #:name (gensym "toratsugumi-") + #:health 1 + #:points 20 + #:parting-shots 5 + #:polarity polarity + #:hitboxes + (list (make-hitbox 'toratsugumi (make-rect -5.5 -5.5 11.0 11.0))) + #:position (vec2 x y))) + + +;;; +;;; Renjyaku +;;; + +(define-class <renjyaku> (<enemy>)) + +(define-method (on-boot (renjyaku <renjyaku>)) + (attach-to renjyaku + (make <atlas-sprite> + #:atlas enemy-atlas + #:index (if (eq? 'white (polarity renjyaku)) 4 5) + #:origin (vec2 24.0 24.0)))) + +(define (make-renjyaku polarity x y) + (make <renjyaku> + #:name (gensym "renjyaku-") + #:health 20 + #:points 100 + #:parting-shots 7 + #:polarity polarity + #:hitboxes + (list (make-hitbox 'renjyaku (make-rect -16.0 -12.0 32.0 25.0))) + #:position (vec2 x y))) diff --git a/lisparuga/game.scm b/lisparuga/game.scm index f5b3082..bad080a 100644 --- a/lisparuga/game.scm +++ b/lisparuga/game.scm @@ -24,6 +24,7 @@ (define-module (lisparuga game) #:use-module (chickadee) #:use-module (chickadee math) + #:use-module (chickadee math easings) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee render color) @@ -31,6 +32,7 @@ #:use-module (chickadee render texture) #:use-module (chickadee scripting) #:use-module (ice-9 format) + #:use-module (ice-9 match) #:use-module (lisparuga actor) #:use-module (lisparuga asset) #:use-module (lisparuga bullets) @@ -48,6 +50,7 @@ fire-player-homing-missiles spawn-enemies start-stage + stop-stage game-over? complete?)) @@ -64,7 +67,8 @@ (define-class <game> (<canvas>) (player-control? #:accessor player-control? #:init-value #f) (complete? #:accessor complete? #:init-value #f) - (skip-tutorial? #:accessor skip-tutorial? #:init-value #f)) + (skip-tutorial? #:accessor skip-tutorial? #:init-value #f) + (stage-script #:accessor stage-script #:init-value #f)) (define-method (reset (game <game>)) (set! (player-control? game) #f) @@ -147,6 +151,9 @@ (update-ui game) (play-stage-1 game)) +(define-method (stop-stage (game <game>)) + (cancel-script (stage-script game))) + (define-method (update-ui (game <game>)) (set! (text (& game ui score)) (format #f "~7,'0d" (score (& game player)))) @@ -185,6 +192,7 @@ (on-kill player enemy) (fire-parting-shots-maybe enemy player) (explode game enemy) + (stop-scripts enemy) (detach enemy) (set! refresh-ui? #t)) ((collide player enemy) @@ -193,6 +201,9 @@ ;; player -> enemy bullet collision (when (collide (& game enemy-bullets) (& game player)) (set! refresh-ui? #t)) + (when (game-over? game) + (steer (& game player) #f #f #f #f) + (stop-shooting (& game player))) (when refresh-ui? (update-ui game)) (next-method))) @@ -226,17 +237,48 @@ (dead? (& game player))) (define-method (play-stage-1 game) - (run-script game - (do-intro game) - (do-tutorial game) - (do-phase-1 game) - (do-win game))) + (set! (stage-script game) + (run-script game + (do-intro game) + ;;(do-tutorial game) + (do-phase-1 game) + (do-phase-2 game) + (toratsugumi-sweep game '((() (white white white) 45) + ((black black black) () 60))) + (interstitial game) + (phase-3 game) + (toratsugumi-sweep game '((() (white white white) 45) + ((black black black) () 60))) + ;; utatsugumi wall + (toratsugumi-sweep game '((() (white white white) 45) + ((black black black) () 60))) + ;; torafuzuku attack + (toratsugumi-sweep + game + '(((white white black) (white black black) 30) + ((white black black) (white white black) 30) + ((black white white) (black black white) 30) + ((white white black) (white black black) 180))) + ;; small renjyaku attack + ;; utatsugumi ring + ;; toratsugumi line + ;; ajisashi attack + ;; toratsugumi lines + ;; toratsugumi wall + ;; eboshidori intro + ;; eboshidori phase 1 + ;; eboshidori phase 2 + ;; eboshidori phase 3 + ;; eboshidori phase 4 + (do-win game)))) (define-method (do-intro (game <game>)) (hide (& game ui)) + (set! (bounds-check? (& game player)) #f) (teleport (& game player) 80.0 -24.0) (move-to (& game player) 80.0 32.0 50) - (steer (& game player) #f #f #f #f) + (set! (bounds-check? (& game player)) #t) + ;;(steer (& game player) #f #f #f #f) (set! (player-control? game) #t) (show (& game ui))) @@ -309,7 +351,7 @@ (set-vec2! (velocity utatsugumi) (* (cos (* pi 1.5)) speed) (* (sin (* pi 1.5)) speed)) - (script + (run-script utatsugumi (sleep 5) (let loop ((i 0)) (when (< i 25) @@ -331,15 +373,212 @@ (utatsugumi-sweep 140.0 -1.0 'white) (sleep 15) (utatsugumi-sweep 20.0 1.0 'black) - (sleep 15) - (utatsugumi-sweep 140.0 -1.0 'white) - (sleep 15) - (utatsugumi-sweep 20.0 1.0 'black) - (sleep 15) - (utatsugumi-sweep 140.0 -1.0 'white) - (sleep 15) - (utatsugumi-sweep 20.0 1.0 'black) - (sleep 60)) + (sleep 60)) + +(define-method (do-phase-2 (game <game>)) + (define (spawn-toratsugumi polarity row column start-x dx-factor) + (let ((toratsugumi (make-toratsugumi polarity + (+ start-x (* column 20.0)) + (+ 240.0 (* row 20.0))))) + (spawn-enemy game toratsugumi) + (run-script toratsugumi + (set-vec2! (velocity toratsugumi) (* dx-factor 1.8) -1.4) + (sleep 80) + (tween 10 (* dx-factor 1.8) 0.0 + (lambda (dx) + (set-vec2! (velocity toratsugumi) dx -0.5))) + (sleep 10) + (tween 60 0.0 (* dx-factor -1.8) + (lambda (dx) + (set-vec2-x! (velocity toratsugumi) dx))) + (sleep 60) + (detach toratsugumi)))) + (let row-loop ((row 0)) + (when (< row 6) + (let column-loop ((column 0)) + (when (< column 3) + (spawn-toratsugumi 'white row column 160.0 -1.0) + (spawn-toratsugumi 'black row (- column) 0.0 1.0) + (column-loop (+ column 1)))) + (sleep 3) + (row-loop (+ row 1)))) + (sleep 180)) + +(define-method (toratsugumi-sweep (game <game>) pattern) + (define (sweep x dir polarities) + (script + (let loop ((polarities polarities)) + (match polarities + (() #t) + ((polarity . rest) + (let ((toratsugumi (make-toratsugumi polarity x 250.0)) + (speed 2.0)) + (spawn-enemy game toratsugumi) + (run-script toratsugumi + (script + (tween 60 speed 4.0 + (lambda (s) + (set! speed s)))) + (script + (tween 50 (* pi 1.5) (+ (* pi 1.5) (* dir .35 pi)) + (lambda (theta) + (set-vec2! (velocity toratsugumi) + (* (cos theta) speed) + (* (sin theta) speed))) + #:ease ease-out-sine) + (sleep 60) + (detach toratsugumi))) + (sleep 8) + (loop rest))))))) + (let loop ((pattern pattern)) + (match pattern + (() #t) + (((left right dt) . rest) + (sweep 130.0 -1.0 right) + (sweep 30.0 1.0 left) + (sleep dt) + (loop rest))))) + +(define-method (phase-3 (game <game>)) + ;; Renjyaku attack + (define (fly-away renjyaku dir) + (let ((theta (if (= dir 1.0) (* pi 1.1) (* 2pi .9)))) + (tween 10 0.0 2.0 + (lambda (speed) + (set-vec2! (velocity renjyaku) + (* (cos theta) speed) + (* (sin theta) speed)))))) + (define* (triangle polarities ox oy dir #:optional (proc (lambda (ren) (sleep 20)))) + (for-each (lambda (polarity x y) + (let* ((sx (+ 80.0 (* dir 96.0))) + (sy 256.0) + (dx (- x sx)) + (dy (- y sy)) + (ren (make-renjyaku polarity sx sy))) + (spawn-enemy game ren) + (run-script ren + (set-vec2! (velocity ren) (/ dx 40.0) (/ dy 40.0)) + (sleep 40) + (set-vec2! (velocity ren) 0.0 0.0) + (proc ren) + (fly-away ren dir) + (sleep 90) + (detach ren))) + (sleep 10)) + polarities + (if (= dir 1.0) + (list (- ox 18.0) (+ ox 18.0) ox) + (list (+ ox 18.0) (- ox 18.0) ox)) + (list (- oy 14.0) (- oy 14.0) (+ oy 14.0)))) + (define (shoot-at-player ren) + (sleep 45) + (let* ((player (& game player)) + (ppos (position player)) + (epos (position ren)) + (bullets (& game enemy-bullets)) + (speed 4.0)) + (repeat 12 + (let* ((dx (- (vec2-x ppos) (vec2-x epos))) + (dy (- (vec2-y ppos) (vec2-y epos))) + (theta (+ (atan dy dx) (- (* (random:uniform) (/ pi 32.0)) (/ pi 64.0))))) + (spawn-bullet bullets medium-dot (polarity ren) + (vec2-x epos) (- (vec2-y epos) 12.0) + (* (cos theta) speed) + (* (sin theta) speed))) + (sleep 3)))) + (define (straight-down polarity x) + (let ((ren (make-renjyaku polarity x 256.0))) + (spawn-enemy game ren) + (run-script ren + (set-vec2! (velocity ren) 0.0 -3.0) + (sleep 180) + (detach ren)))) + (define (sine-wave polarity x dir) + (let ((ren (make-renjyaku polarity x 256.0))) + (spawn-enemy game ren) + (run-script ren + (let loop ((i 0.0)) + (when (< i (* 3.0 pi)) + (let ((dx (* (sin (* i dir)) 2.0)) + (dy -1.0)) + (set-vec2! (velocity ren) dx dy)) + (sleep 3) + (loop (+ i 0.1)))) + (detach ren)) + (run-script ren + (sleep 30) + (let ((pos (position ren)) + (bullets (& game enemy-bullets))) + (forever + (repeat 12 + (spawn-bullet bullets medium-dot polarity + (vec2-x pos) (- (vec2-y pos) 12.0) + 0.0 -3.0) + (sleep 4)) + (sleep 13)))))) + (triangle '(white white white) 70.0 130.0 1.0) + (sleep 50) + (triangle '(white white white) 90.0 140.0 -1.0) + (sleep 50) + (triangle '(black black black) 70.0 130.0 1.0) + (sleep 50) + (triangle '(black black black) 90.0 140.0 -1.0) + (sleep 60) + (triangle '(white white white) 40.0 200.0 1.0 shoot-at-player) + (sleep 60) + (triangle '(black black black) 120.0 200.0 -1.0 shoot-at-player) + (sleep 60) + (script + (triangle '(black black white) 40.0 200.0 -1.0 shoot-at-player)) + (triangle '(black white white) 120.0 200.0 1.0 shoot-at-player) + (sleep 60) + (sine-wave 'white 20.0 1.0) + (sleep 60) + (sine-wave 'white 140.0 -1.0) + (sleep 60) + (sine-wave 'white 20.0 1.0) + (sleep 60) + (script + (sleep 60) + (straight-down 'black 20.0) + (straight-down 'black 140.0) + (sleep 30) + (straight-down 'black 20.0) + (straight-down 'black 140.0) + (sleep 30) + (straight-down 'black 20.0) + (straight-down 'black 140.0)) + (sine-wave 'white 20.0 1.0) + (sleep 40) + (sine-wave 'black 140.0 -1.0) + (sleep 40) + (sine-wave 'white 20.0 1.0) + (sleep 40) + (sine-wave 'black 140.0 -1.0) + (sleep 180)) + +(define-method (interstitial (game <game>)) + (let ((container (make <node-2d> #:rank 999))) + (define (show-text text y) + (let ((label (make <label> + #:text text + #:position (vec2 80.0 y) + #:align 'center + #:vertical-align 'center))) + (attach-to container label) + (run-script label + (sleep 90) + (move-by label 0.0 200.0 20)))) + (sleep 120) + (attach-to game container) + (show-text "- Lisparuga -" 120.0) + (sleep 50) + (show-text "Made for Lisp Game Jam" 104.0) + (sleep 50) + (show-text "Spring 2020" 88.0) + (sleep 120) + (detach container) + (sleep 60))) (define-method (do-win (game <game>)) (set! (player-control? game) #f) diff --git a/lisparuga/player.scm b/lisparuga/player.scm index 6a85cc4..ae126e2 100644 --- a/lisparuga/player.scm +++ b/lisparuga/player.scm @@ -47,6 +47,7 @@ speed invincible? shooting? + bounds-check? steer start-shooting stop-shooting @@ -77,9 +78,11 @@ (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)) + (shoot-time #:accessor shoot-time #:init-value 0) + (bounds-check? #:accessor bounds-check? #:init-value #t)) (define-method (reset (player <player>)) + (show player) (set! (polarity player) 'white) (set-vec2! (velocity player) 0.0 0.0) (set! (score player) 0) @@ -91,6 +94,7 @@ (set! (invincible? player) #f) (set! (shooting? player) #f) (set! (shoot-time player) 0) + (set! (bounds-check? player) #t) (refresh-sprite player)) (define-method (dead? (player <player>)) @@ -124,18 +128,19 @@ (define-method (update (player <player>) dt) ;; Adjust velocity to force player to stay within the bounds of the ;; screen. - (let ((p (position player)) - (v (velocity player))) - (cond - ((< (+ (vec2-x p) (vec2-x v)) 0.0) - (set-vec2-x! v (- (vec2-x p)))) - ((> (+ (vec2-x p) (vec2-x v)) 160.0) - (set-vec2-x! v (- 160.0 (vec2-x p))))) - (cond - ((< (+ (vec2-y p) (vec2-y v)) 0.0) - (set-vec2-y! v (- (vec2-y p)))) - ((> (+ (vec2-y p) (vec2-y v)) 240.0) - (set-vec2-y! v (- 240.0 (vec2-y p)))))) + (when (bounds-check? player) + (let ((p (position player)) + (v (velocity player))) + (cond + ((< (+ (vec2-x p) (vec2-x v)) 0.0) + (set-vec2-x! v (- (vec2-x p)))) + ((> (+ (vec2-x p) (vec2-x v)) 160.0) + (set-vec2-x! v (- 160.0 (vec2-x p))))) + (cond + ((< (+ (vec2-y p) (vec2-y v)) 0.0) + (set-vec2-y! v (- (vec2-y p)))) + ((> (+ (vec2-y p) (vec2-y v)) 240.0) + (set-vec2-y! v (- 240.0 (vec2-y p))))))) ;; Shooting logic (when (shooting? player) (let ((t (shoot-time player))) |