summaryrefslogtreecommitdiff
path: root/lisparuga/game.scm
diff options
context:
space:
mode:
Diffstat (limited to 'lisparuga/game.scm')
-rw-r--r--lisparuga/game.scm273
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)