From 5b461c68e3194aef85bd175d51a30f205adb327f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Thu, 16 Apr 2020 22:01:22 -0400
Subject: Day 6 progress.

---
 lisparuga/actor.scm   |  10 +-
 lisparuga/bullets.scm |  12 +--
 lisparuga/enemy.scm   |  79 +++++++++++++--
 lisparuga/game.scm    | 273 ++++++++++++++++++++++++++++++++++++++++++++++----
 lisparuga/player.scm  |  31 +++---
 5 files changed, 358 insertions(+), 47 deletions(-)

(limited to 'lisparuga')

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)))
-- 
cgit v1.2.3