From f08e14fd51e2b1f5920ac6816774c5e72cbee5c0 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Tue, 14 Apr 2020 17:02:17 -0400
Subject: Day 4 progress.

---
 lisparuga/game.scm | 184 +++++++++++++++++++++++++++++++++--------------------
 1 file changed, 115 insertions(+), 69 deletions(-)

(limited to 'lisparuga/game.scm')

diff --git a/lisparuga/game.scm b/lisparuga/game.scm
index 9e79898..f5b3082 100644
--- a/lisparuga/game.scm
+++ b/lisparuga/game.scm
@@ -23,6 +23,7 @@
 
 (define-module (lisparuga game)
   #:use-module (chickadee)
+  #:use-module (chickadee math)
   #:use-module (chickadee math rect)
   #:use-module (chickadee math vector)
   #:use-module (chickadee render color)
@@ -62,7 +63,16 @@
 ;; scrolling background
 (define-class <game> (<canvas>)
   (player-control? #:accessor player-control? #:init-value #f)
-  (complete? #:accessor complete? #:init-value #f))
+  (complete? #:accessor complete? #:init-value #f)
+  (skip-tutorial? #:accessor skip-tutorial? #:init-value #f))
+
+(define-method (reset (game <game>))
+  (set! (player-control? game) #f)
+  (set! (complete? game) #f)
+  (reset (& game player))
+  (for-each detach (children (& game enemies)))
+  (let ((battle-report (& game battle-report)))
+    (and battle-report (detach battle-report))))
 
 (define-method (initialize (game <game>) initargs)
   (next-method)
@@ -81,6 +91,7 @@
                            #:rank 2
                            #:capacity 500
                            #:texture-atlas player-bullet-atlas))
+         (player (make-player player-bullets))
          (enemy-bullets (make <bullet-field>
                           #:name 'enemy-bullets
                           #:rank 5
@@ -98,11 +109,13 @@
          (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
@@ -128,26 +141,11 @@
                  #:align 'right)
                (make <label>
                  #:name 'lives
-                 #:position (vec2 2.0 2.0)))
-    (start-stage game)))
+                 #:position (vec2 2.0 2.0)))))
 
 (define-method (start-stage (game <game>))
-  (let ((player (make-player (& game player-bullets))))
-    (set! (rank player) 1)
-    (attach-to game player)
-    (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)))
+  (update-ui game)
+  (play-stage-1 game))
 
 (define-method (update-ui (game <game>))
   (set! (text (& game ui score))
@@ -178,26 +176,25 @@
 (define-method (update (game <game>) dt)
   (let ((refresh-ui? #f)
         (player (& game player)))
-    (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)))
+    ;; 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)
@@ -226,8 +223,7 @@
     (update-ui game)))
 
 (define-method (game-over? (game <game>))
-  (let ((player (& game player)))
-    (and player (dead? player))))
+  (dead? (& game player)))
 
 (define-method (play-stage-1 game)
   (run-script game
@@ -244,8 +240,6 @@
   (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>
@@ -259,7 +253,7 @@
       (sleep post-delay)
       (detach instructions)
       (sleep 60)))
-  (unless *skip-tutorial?*
+  (unless (skip-tutorial? game)
     (sleep 30)
     (instruct "use arrow keys to move"
               (let ((v (velocity (& game player))))
@@ -269,7 +263,7 @@
     (instruct "press Z to shoot"
               (lambda ()
                 (shooting? (& game player))))
-    (instruct "press X to change color"
+    (instruct "press X to change energy"
               (let ((starting-polarity (polarity (& game player))))
                 (lambda ()
                   (not (eq? (polarity (& game player)) starting-polarity)))))
@@ -280,28 +274,72 @@
     (instruct "press C to release energy"
               (lambda ()
                 (zero? (energy (& game player)))))
-    (instruct "get ready!" (const #t) 120)))
+    (instruct "shoot opposite energy" (const #t) 90)
+    (instruct "deal 2x damage" (const #t) 90)
+    (set! (invincible? (& game player)) #t)
+    (spawn-enemy game (make-utatsugumi 'white 48.0 150.0))
+    (spawn-enemy game (make-utatsugumi 'white 80.0 150.0))
+    (spawn-enemy game (make-utatsugumi 'white 112.0 150.0))
+    (instruct "destroy 3 of same energy"
+              (lambda ()
+                (null? (children (& game enemies)))))
+    (spawn-enemy game (make-utatsugumi 'black 48.0 150.0))
+    (spawn-enemy game (make-utatsugumi 'black 80.0 150.0))
+    (spawn-enemy game (make-utatsugumi 'black 112.0 150.0))
+    (instruct "repeat for chain bonus"
+              (lambda ()
+                (null? (children (& game enemies)))))
+    (set! (score (& game player)) 0)
+    (set! (chain (& game player)) 0)
+    (set! (chain-progress (& game player)) '())
+    (set! (max-chain (& game player)) 0)
+    (set! (energy (& game player)) 0)
+    (set! (invincible? (& game player)) #f)
+    (update-ui game)
+    (instruct "get ready!" (const #t) 120)
+    (set! (skip-tutorial? game) #t)))
 
 (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 (utatsugumi-sweep x dir polarity)
+    (let ((speed 3.0))
+      (let loop ((i 0))
+        (when (< i 6)
+          (let ((utatsugumi (make-utatsugumi polarity x 260.0)))
+            (spawn-enemy game utatsugumi)
+            (set-vec2! (velocity utatsugumi)
+                       (* (cos (* pi 1.5)) speed)
+                       (* (sin (* pi 1.5)) speed))
+            (script
+             (sleep 5)
+             (let loop ((i 0))
+               (when (< i 25)
+                 (let ((theta (+ (* pi 1.5)
+                                 (* dir i (/ (* pi .5) 25.0)))))
+                   (set-vec2! (velocity utatsugumi)
+                              (* (cos theta) speed)
+                              (* (sin theta) speed))
+                   (sleep 3)
+                   (loop (+ i 1)))))
+             (sleep 60)
+             (detach utatsugumi))
+            (sleep 15))
+          (loop (+ i 1))))))
+  (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 15)
+  (utatsugumi-sweep 140.0 -1.0 'white)
+  (sleep 15)
+  (utatsugumi-sweep 20.0 1.0 'black)
+ (sleep 60))
 
 (define-method (do-win (game <game>))
   (set! (player-control? game) #f)
@@ -331,21 +369,29 @@
              (lambda (c)
                (set! (color backdrop) c))
              #:interpolate color-lerp))
+    (sleep 30)
+    (attach-to battle-report
+               (make <label>
+                 #:rank 999
+                 #:text "STAGE CLEAR!"
+                 #:align 'center
+                 #:position (vec2 80.0 190.0)))
+    (sleep 30)
     (attach-to battle-report
                (make <label>
                  #:rank 999
                  #:text "BATTLE REPORT"
                  #:align 'center
-                 #:position (vec2 80.0 180.0)))
+                 #:position (vec2 80.0 145.0)))
     (sleep 30)
-    (add-row 140.0 "SCORE" (number->string (score (& game player))))
+    (add-row 120.0 "SCORE" (number->string (score (& game player))))
     (sleep 30)
-    (add-row 110.0 "MAX CHAIN" (number->string (max-chain (& game player))))
+    (add-row 100.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)
+                 #:position (vec2 80.0 40.0)
                  #:align 'center))
     (set! (complete? game) #t)))
-- 
cgit v1.2.3