examples: shmup: Stop polling input devices and only use events.

1 files changed, 23 insertions, 27 deletions

diff --git a/examples/shmup/shmup.scm b/examples/shmup/shmup.scm
index b775234..135027b 100644
--- a/examples/shmup/shmup.scm
+++ b/examples/shmup/shmup.scm
@@ -1,5 +1,4 @@
-(use-modules (chickadee)
-             (chickadee math)
+(use-modules (chickadee math)
              (chickadee math matrix)
              (chickadee math rect)
              (chickadee math vector)
@@ -602,7 +601,8 @@
   (state #:accessor state #:init-form 'play)
   (enemies #:accessor enemies #:init-form '())
   (cont #:accessor cont #:init-form #f)
-  (cont-x #:accessor cont-x #:init-form +inf.0))
+  (cont-x #:accessor cont-x #:init-form +inf.0)
+  (move-state #:getter move-state #:init-thunk make-hash-table))
 
 (define-method (update-hud (shmup <shmup>))
   (let ((player (& shmup player)))
@@ -785,22 +785,14 @@
         (dy (* (sin theta) speed)))
     (add-bullet (& shmup enemy-bullets) type x y dx dy)))
 
-(define-method (update-player-movement (shmup <shmup>))
-  (change-direction (& shmup player)
-                    (key-pressed? 'left)
-                    (key-pressed? 'right)
-                    (key-pressed? 'down)
-                    (key-pressed? 'up)))
-
-(define-method (update-player-shooting (shmup <shmup>))
-  (if (key-pressed? 'z)
-      (begin-shooting (& shmup player))
-      (end-shooting (& shmup player))))
-
-(define-method (update-player-guarding (shmup <shmup>))
-  (if (key-pressed? 'x)
-      (begin-guarding (& shmup player))
-      (end-guarding (& shmup player))))
+(define-method (update-player-movement (shmup <shmup>) key down?)
+  (let ((state (move-state shmup)))
+    (hashq-set! state key down?)
+    (change-direction (& shmup player)
+                      (hashq-ref state 'left)
+                      (hashq-ref state 'right)
+                      (hashq-ref state 'down)
+                      (hashq-ref state 'up))))
 
 (define-method (pause-game (shmup <shmup>))
   (set! (state shmup) 'pause)
@@ -808,6 +800,10 @@
   (pause (& shmup player-bullets))
   (pause (& shmup enemy-bullets))
   (pause (& shmup player))
+  (end-shooting (& shmup player))
+  (end-guarding (& shmup player))
+  (hash-clear! (move-state shmup))
+  (change-direction (& shmup player) #f #f #f #f)
   (for-each pause (enemies shmup)))
 
 (define-method (resume-game (shmup <shmup>))
@@ -816,17 +812,16 @@
   (resume (& shmup player-bullets))
   (resume (& shmup enemy-bullets))
   (resume (& shmup player))
-  (update-player-movement shmup)
-  (update-player-shooting shmup)
   (for-each resume (enemies shmup)))
 
 (define-method (on-key-press (shmup <shmup>) key scancode modifiers repeat?)
   (match (state shmup)
     ('play
      (match key
-       ((or 'up 'down 'left 'right) (update-player-movement shmup))
-       ('z (update-player-shooting shmup))
-       ('x (update-player-guarding shmup))
+       ((or 'up 'down 'left 'right)
+        (update-player-movement shmup key #t))
+       ('z (begin-shooting (& shmup player)))
+       ('x (begin-guarding (& shmup player)))
        ('return (pause-game shmup))
        ('r (reset-game shmup))
        (_ #f)))
@@ -844,9 +839,10 @@
   (match (state shmup)
     ('play
      (match key
-       ((or 'up 'down 'left 'right) (update-player-movement shmup))
-       ('z (update-player-shooting shmup))
-       ('x (update-player-guarding shmup))
+       ((or 'up 'down 'left 'right)
+        (update-player-movement shmup key #f))
+       ('z (end-shooting (& shmup player)))
+       ('x (end-guarding (& shmup player)))
        (_ #f)))
     (_ #f)))