diff options
Diffstat (limited to 'lisparuga/game.scm')
-rw-r--r-- | lisparuga/game.scm | 273 |
1 files changed, 256 insertions, 17 deletions
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) |