From 2bdb665cffff93721bbd38b3809a7c420dff2f1c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sun, 12 Apr 2020 21:59:35 -0400
Subject: Day 3 progress.

---
 lisparuga.scm | 88 +++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 49 insertions(+), 39 deletions(-)

(limited to 'lisparuga.scm')

diff --git a/lisparuga.scm b/lisparuga.scm
index b552a7a..dc611cd 100644
--- a/lisparuga.scm
+++ b/lisparuga.scm
@@ -44,10 +44,13 @@
 (define-asset background (load-image (scope-asset "images/background.png")))
 
 (define-class <lisparuga> (<scene-2d>)
-  (state #:accessor state #:init-value 'play))
+  (state #:accessor state #:init-value 'init))
 
-(define (game-over? lisparuga)
-  (zero? (lives (& lisparuga actor-canvas game player))))
+(define-method (game-over? (lisparuga <lisparuga>))
+  (game-over? (& lisparuga game)))
+
+(define-method (complete? (lisparuga <lisparuga>))
+  (complete? (& lisparuga game)))
 
 (define-method (on-boot (lisparuga <lisparuga>))
   ;; Scale a small framebuffer up to the window size.
@@ -58,34 +61,27 @@
                        #:height %framebuffer-height)
             #:area (let ((wc (window-config (current-kernel))))
                      (make-rect 0 0 (window-width wc) (window-height wc))))))
-  ;; This 160x240 canvas is where the actual game actors will get
-  ;; rendered.
-  (let ((actor-canvas (make <canvas>
-                        #:name 'actor-canvas
-                        #:rank 1
-                        #:views (list (make <view-2d>
-                                        #:camera (make <camera-2d>
-                                                   #:width 160
-                                                   #:height 240)
-                                        #:area (make-rect 80 0 160 240)
-                                        #:clear-color (make-color 0.0 0.0 0.0 1.0))))))
-    (attach-to lisparuga
-               (make <sprite>
-                 #:name 'background
-                 #:rank 0
-                 #:texture background)
-               actor-canvas)
-    (new-game-transition lisparuga)))
+  (attach-to lisparuga
+             (make <sprite>
+               #:name 'background
+               #:rank 0
+               #:texture background))
+  (new-game-transition lisparuga))
 
 (define (new-game-transition lisparuga)
   (set! (state lisparuga) 'play)
   (let ((game-over (& lisparuga game-over)))
     (and game-over (detach game-over)))
-  (let ((old-game (& lisparuga actor-canvas game)))
+  (let ((old-game (& lisparuga game)))
     (and old-game (detach old-game)))
-  (attach-to (& lisparuga actor-canvas) (make <game> #:name 'game)))
+  (attach-to lisparuga
+             (make <game>
+               #:name 'game
+               #:rank 1
+               #:position (vec2 80.0 0.0)))
+  (set! (state lisparuga) 'play))
 
-(define (game-over-transition lisparuga)
+(define-method (game-over-transition (lisparuga <lisparuga>))
   (set! (state lisparuga) 'game-over)
   (let ((game-over (make <node-2d>
                      #:name 'game-over
@@ -94,21 +90,33 @@
                (make <label>
                  #:name 'game-over
                  #:text "GAME OVER"
-                 #:position (vec2 (- 160.0 (/ (* 9.0 8.0) 2.0))
-                                  116.0)
-                 #:rank 999))
+                 #:position (vec2 160.0 120.0)
+                 #:align 'center
+                 #:vertical-align 'center)
+               (make <label>
+                 #:name 'instructions
+                 #:text "press ENTER to play again"
+                 #:position (vec2 160.0 90.0)
+                 #:align 'center))
     (attach-to lisparuga game-over)))
 
+(define-method (win-transition (lisparuga <lisparuga>))
+  (set! (state lisparuga) 'win))
+
 (define-method (update (lisparuga <lisparuga>) dt)
   (match (state lisparuga)
     ('play
-     (if (game-over? lisparuga)
-         (game-over-transition lisparuga)
-         (steer-player (& lisparuga actor-canvas game)
-                       (key-pressed? 'up)
-                       (key-pressed? 'down)
-                       (key-pressed? 'left)
-                       (key-pressed? 'right))))
+     (cond
+      ((game-over? lisparuga)
+       (game-over-transition lisparuga))
+      ((complete? lisparuga)
+       (win-transition lisparuga))
+      (else
+       (steer-player (& lisparuga game)
+                     (key-pressed? 'up)
+                     (key-pressed? 'down)
+                     (key-pressed? 'left)
+                     (key-pressed? 'right)))))
     (_ #f)))
 
 (define-method (on-key-press (lisparuga <lisparuga>) key scancode modifiers repeat?)
@@ -116,11 +124,13 @@
     ('play
      (unless repeat?
        (match key
-         ('z (start-player-shooting (& lisparuga actor-canvas game)))
-         ('x (toggle-player-polarity (& lisparuga actor-canvas game)))
-         ('c (fire-player-homing-missiles (& lisparuga actor-canvas game)))
+         ('z (start-player-shooting (& lisparuga game)))
+         ('x (toggle-player-polarity (& lisparuga game)))
+         ('c (fire-player-homing-missiles (& lisparuga game)))
+         ('r (spawn-enemies (& lisparuga game)))
+         ('e (set! (energy (& lisparuga game player)) 120))
          (_ #t))))
-    ('game-over
+    ((or 'win 'game-over)
      (match key
        ('return (new-game-transition lisparuga))
        (_ #f)))
@@ -130,7 +140,7 @@
   (match (state lisparuga)
     ('play
      (match key
-       ('z (stop-player-shooting (& lisparuga actor-canvas game)))
+       ('z (stop-player-shooting (& lisparuga game)))
        (_ #t)))
     (_ #f)))
 
-- 
cgit v1.2.3