From 9e502b0595d47467aa9b755f3779686b58401395 Mon Sep 17 00:00:00 2001
From: TakeV <takev@disroot.org>
Date: Sat, 18 May 2024 02:07:16 -0400
Subject: [PATCH] Update game to just have a player

It is not working right now, but at least we are able to draw!
---
 .dir-locals.el | 159 +++++++++++++++++++++++++++
 game.scm       | 290 ++++++++++---------------------------------------
 2 files changed, 217 insertions(+), 232 deletions(-)
 create mode 100644 .dir-locals.el

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..ff2dc18
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,159 @@
+;; Per-directory local variables for GNU Emacs 23 and later.
+
+((nil
+  . ((fill-column . 78)
+     (tab-width   .  8)
+     (sentence-end-double-space . t)
+
+     (eval . (add-to-list 'completion-ignored-extensions ".go"))
+
+     ;; Geiser
+     ;; This allows automatically setting the `geiser-guile-load-path'
+     ;; variable when using various Guix checkouts (e.g., via git worktrees).
+     (geiser-repl-per-project-p . t)))
+
+ (c-mode          . ((c-file-style . "gnu")))
+ (scheme-mode
+  .
+  ((indent-tabs-mode . nil)
+   (eval . (put 'eval-when 'scheme-indent-function 1))
+   (eval . (put 'call-with-prompt 'scheme-indent-function 1))
+   (eval . (put 'test-assert 'scheme-indent-function 1))
+   (eval . (put 'test-assertm 'scheme-indent-function 1))
+   (eval . (put 'test-equalm 'scheme-indent-function 1))
+   (eval . (put 'test-equal 'scheme-indent-function 1))
+   (eval . (put 'test-eq 'scheme-indent-function 1))
+   (eval . (put 'call-with-input-string 'scheme-indent-function 1))
+   (eval . (put 'call-with-port 'scheme-indent-function 1))
+   (eval . (put 'guard 'scheme-indent-function 1))
+   (eval . (put 'lambda* 'scheme-indent-function 1))
+   (eval . (put 'substitute* 'scheme-indent-function 1))
+   (eval . (put 'match-record 'scheme-indent-function 3))
+   (eval . (put 'match-record-lambda 'scheme-indent-function 2))
+
+   ;; TODO: Contribute these to Emacs' scheme-mode.
+   (eval . (put 'let-keywords 'scheme-indent-function 3))
+
+   ;; 'modify-inputs' and its keywords.
+   (eval . (put 'modify-inputs 'scheme-indent-function 1))
+   (eval . (put 'replace 'scheme-indent-function 1))
+
+   ;; 'modify-phases' and its keywords.
+   (eval . (put 'modify-phases 'scheme-indent-function 1))
+   (eval . (put 'replace 'scheme-indent-function 1))
+   (eval . (put 'add-before 'scheme-indent-function 2))
+   (eval . (put 'add-after 'scheme-indent-function 2))
+
+   (eval . (put 'modify-services 'scheme-indent-function 1))
+   (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
+   (eval . (put 'with-file-lock 'scheme-indent-function 1))
+   (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1))
+   (eval . (put 'with-profile-lock 'scheme-indent-function 1))
+   (eval . (put 'with-writable-file 'scheme-indent-function 2))
+
+   (eval . (put 'package 'scheme-indent-function 0))
+   (eval . (put 'package/inherit 'scheme-indent-function 1))
+   (eval . (put 'origin 'scheme-indent-function 0))
+   (eval . (put 'build-system 'scheme-indent-function 0))
+   (eval . (put 'bag 'scheme-indent-function 0))
+   (eval . (put 'graft 'scheme-indent-function 0))
+   (eval . (put 'operating-system 'scheme-indent-function 0))
+   (eval . (put 'file-system 'scheme-indent-function 0))
+   (eval . (put 'manifest-entry 'scheme-indent-function 0))
+   (eval . (put 'manifest-pattern 'scheme-indent-function 0))
+   (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
+   (eval . (put 'with-store 'scheme-indent-function 1))
+   (eval . (put 'with-external-store 'scheme-indent-function 1))
+   (eval . (put 'with-error-handling 'scheme-indent-function 0))
+   (eval . (put 'with-mutex 'scheme-indent-function 1))
+   (eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
+   (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
+   (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
+   (eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
+   (eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
+   (eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
+   (eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
+   (eval . (put 'signature-case 'scheme-indent-function 1))
+   (eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
+   (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
+   (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
+   (eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
+   (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
+   (eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
+   (eval . (put 'with-status-report 'scheme-indent-function 1))
+   (eval . (put 'with-status-verbosity 'scheme-indent-function 1))
+   (eval . (put 'with-build-handler 'scheme-indent-function 1))
+
+   (eval . (put 'mlambda 'scheme-indent-function 1))
+   (eval . (put 'mlambdaq 'scheme-indent-function 1))
+   (eval . (put 'syntax-parameterize 'scheme-indent-function 1))
+   (eval . (put 'with-monad 'scheme-indent-function 1))
+   (eval . (put 'mbegin 'scheme-indent-function 1))
+   (eval . (put 'mwhen 'scheme-indent-function 1))
+   (eval . (put 'munless 'scheme-indent-function 1))
+   (eval . (put 'mlet* 'scheme-indent-function 2))
+   (eval . (put 'mlet 'scheme-indent-function 2))
+   (eval . (put 'mparameterize 'scheme-indent-function 2))
+   (eval . (put 'run-with-store 'scheme-indent-function 1))
+   (eval . (put 'run-with-state 'scheme-indent-function 1))
+   (eval . (put 'wrap-program 'scheme-indent-function 1))
+   (eval . (put 'wrap-script 'scheme-indent-function 1))
+   (eval . (put 'with-imported-modules 'scheme-indent-function 1))
+   (eval . (put 'with-extensions 'scheme-indent-function 1))
+   (eval . (put 'with-parameters 'scheme-indent-function 1))
+   (eval . (put 'let-system 'scheme-indent-function 1))
+   (eval . (put 'with-build-variables 'scheme-indent-function 2))
+
+   (eval . (put 'with-database 'scheme-indent-function 2))
+   (eval . (put 'call-with-database 'scheme-indent-function 1))
+   (eval . (put 'call-with-transaction 'scheme-indent-function 1))
+   (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))
+
+   (eval . (put 'call-with-container 'scheme-indent-function 1))
+   (eval . (put 'container-excursion 'scheme-indent-function 1))
+   (eval . (put 'eventually 'scheme-indent-function 1))
+
+   (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
+   (eval . (put 'with-repository 'scheme-indent-function 2))
+   (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
+   (eval . (put 'with-environment-variables 'scheme-indent-function 1))
+   (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
+
+   (eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
+
+   (eval . (put 'with-shepherd-action 'scheme-indent-function 3))
+
+   (eval . (put 'with-http-server 'scheme-indent-function 1))
+
+   ;; This notably allows '(' in Paredit to not insert a space when the
+   ;; preceding symbol is one of these.
+   (eval . (modify-syntax-entry ?~ "'"))
+   (eval . (modify-syntax-entry ?$ "'"))
+   (eval . (modify-syntax-entry ?+ "'"))
+
+   ;; Emacs 28 changed the behavior of 'lisp-fill-paragraph', which causes the
+   ;; first line of package descriptions to extrude past 'fill-column', and
+   ;; somehow that is deemed more correct upstream (see:
+   ;; https://issues.guix.gnu.org/56197).
+   (eval . (progn
+             (require 'lisp-mode)
+             (defun emacs27-lisp-fill-paragraph (&optional justify)
+               (interactive "P")
+               (or (fill-comment-paragraph justify)
+                   (let ((paragraph-start
+                          (concat paragraph-start
+                                  "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)"))
+                         (paragraph-separate
+                          (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
+                         (fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
+                                               (derived-mode-p 'emacs-lisp-mode))
+                                          emacs-lisp-docstring-fill-column
+                                        fill-column)))
+                     (fill-paragraph justify))
+                   ;; Never return nil.
+                   t))
+             (setq-local fill-paragraph-function #'emacs27-lisp-fill-paragraph)))))
+
+ (emacs-lisp-mode . ((indent-tabs-mode . nil)))
+ (texinfo-mode    . ((indent-tabs-mode . nil)
+                     (fill-column . 72))))
diff --git a/game.scm b/game.scm
index c822dfb..b14e780 100644
--- a/game.scm
+++ b/game.scm
@@ -36,118 +36,51 @@
         (math vector))
 
 ;; Data types
-(define-record-type <brick-type>
-  (make-brick-type image points)
-  brick-type?
-  (image brick-type-image)
-  (points brick-type-points))
-
-(define-record-type <brick>
-  (make-brick type hitbox)
-  brick?
-  (type brick-type)
-  (hitbox brick-hitbox)
-  (broken? brick-broken? set-brick-broken!))
-
-(define-record-type <ball>
-  (make-ball velocity hitbox)
-  ball?
-  (velocity ball-velocity)
-  (hitbox ball-hitbox))
-
-(define-record-type <paddle>
-  (make-paddle velocity hitbox)
-  paddle?
-  (velocity paddle-velocity)
-  (hitbox paddle-hitbox))
 
 (define-record-type <level>
-  (make-level state bricks ball paddle score move-left? move-right? move-up? move-down?)
+    (make-level state player move-left? move-right? move-up? move-down?)
   level?
   (state level-state set-level-state!) ; play, win, lose
-  (bricks level-bricks)
-  (ball level-ball)
-  (paddle level-paddle)
-  (score level-score set-level-score!)
+  (player level-player)
   (move-left? level-move-left? set-level-move-left!)
   (move-right? level-move-right? set-level-move-right!)
   (move-up? level-move-up? set-level-move-up!)
-  (move-down? level-move-down? set-level-move-up!))
+  (move-down? level-move-down? set-level-move-down!))
+
+(define-record-type <player>
+    (make-player velocity position hitbox weapon-primary)
+  entity?
+  (velocity player-velocity player-velocity-set!)
+  (position player-position player-position-set!)
+  (hitbox player-hitbox player-hitbox-set!)
+  (weapon-primary player-weapon-primary player-weapon-primary-set!))
 
 ;; Assets
-(define image:paddle       (make-image "assets/images/paddle.png"))
-(define image:ball         (make-image "assets/images/ball.png"))
-(define image:brick-red    (make-image "assets/images/brick-red.png"))
-(define image:brick-green  (make-image "assets/images/brick-green.png"))
-(define image:brick-blue   (make-image "assets/images/brick-blue.png"))
-(define audio:brick        (make-audio "assets/sounds/brick.wav"))
-(define audio:paddle       (make-audio "assets/sounds/paddle.wav"))
+(define image:player       (make-image "assets/images/ball.png"))
 
 ;; Game data
 (define game-width    640.0)
 (define game-height   480.0)
-(define brick-width   64.0)
-(define brick-height  32.0)
-(define ball-width    22.0)
-(define ball-height   22.0)
-(define paddle-width  104.0)
-(define paddle-height 24.0)
-(define paddle-speed  6.0)
-(define brick:red     (make-brick-type image:brick-red 10))
-(define brick:green   (make-brick-type image:brick-green 20))
-(define brick:blue    (make-brick-type image:brick-blue 30))
+(define player-width    22.0)
+(define player-height   22.0)
+(define player-speed  6.0)
 
-(define (make-brick* type x y)
-  (make-brick type (make-rect x y brick-width brick-height)))
-
-(define (make-brick-grid types)
-  (let* ((h (vector-length types))
-         (w (vector-length (vector-ref types 0)))
-         (offset-x (/ (- game-width (* w brick-width)) 2.0))
-         (offset-y 48.0)
-         (bricks (make-vector (* w h))))
-    (do ((y 0 (+ y 1)))
-        ((= y h))
-      (let ((row (vector-ref types y)))
-        (do ((x 0 (+ x 1)))
-            ((= x w))
-          (vector-set! bricks (+ (* y w) x)
-                       (make-brick* (vector-ref row x)
-                                    (+ offset-x (* x brick-width))
-                                    (+ offset-y (* y brick-height)))))))
-    bricks))
+(define (make-player* x y)
+  (make-player (vec2 0.0 0.0)
+               (vec2 x y)
+               (vec2 player-width player-height)
+               'test-shot))
 
 (define (make-level-1)
   (make-level 'play
-              (make-brick-grid
-               (vector
-                (vector brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green)
-                (vector brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue)
-                (vector brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red)
-                (vector brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green)
-                (vector brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue)
-                (vector brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red)))
-              (make-ball (vec2 1.0 3.0)
-                         (make-rect (/ game-width 2.0) (/ game-height 2.0)
-                                    ball-width ball-height))
-              (make-paddle (vec2 0.0 0.0)
-                           (make-rect (- (/ game-width 2.0)
-                                         (/ paddle-width 2.0))
-                                      (- game-height paddle-height 8.0)
-                                      paddle-width paddle-height))
-              0 #f #f #f #f))
+              (make-player* 0 0)
+              #f #f #f #f))
 
 ;; Game state
 (define *level* (make-level-1))
 
 (define (level-clear? level)
-  (let ((bricks (level-bricks level)))
-    (let loop ((i 0))
-      (if (< i (vector-length bricks))
-          (if (brick-broken? (vector-ref bricks i))
-              (loop (+ i 1))
-              #f)
-          #t))))
+  (#f))
 
 (define (win! level)
   (set-level-state! level 'win))
@@ -155,101 +88,37 @@
 (define (lose! level)
   (set-level-state! level 'lose))
 
-(define (update-paddle-velocity! level)
-  (let ((speed (* paddle-speed
+(define (update-play-velocity! level)
+  (let ((speed (* player-speed
                   (+ (if (level-move-left? level) -1.0  0.0)
                      (if (level-move-right? level) 1.0  0.0)
                      (if (level-move-up? level)    0.0  1.0)
                      (if (level-move-down? level)  0.0 -1.0)))))
-    (set-vec2-x! (paddle-velocity (level-paddle level)) speed)))
-
-(define (speed-up-ball! ball)
-  (let* ((v (ball-velocity ball))
-         (speed (+ (vec2-magnitude v) (* (random) 0.1)))
-         ;; Also change its angle slightly.  Not the proper Breakout
-         ;; behavior but I don't want to write the code for that. :)
-         (dir (+ (atan (vec2-y v) (vec2-x v))
-                 (- (* (random) 0.5) 0.25))))
-    (set-vec2-x! v (* (cos dir) speed))
-    (set-vec2-y! v (* (sin dir) speed))))
-
-(define (reflect-ball! ball x? y?)
-  (let ((v (ball-velocity ball)))
-    (when x? (set-vec2-x! v (- (vec2-x v))))
-    (when y? (set-vec2-y! v (- (vec2-y v))))))
-
-(define (collide-ball! ball hitbox)
-  (let ((b-hitbox (ball-hitbox ball)))
-    (and (rect-intersects? b-hitbox hitbox)
-         (let ((overlap (rect-clip b-hitbox hitbox)))
-           ;; Resolve collision by adjusting the ball's position the
-           ;; minimum amount along the X or Y axis.
-           (if (< (rect-width overlap) (rect-height overlap))
-               (begin
-                 (reflect-ball! ball #t #f)
-                 (if (= (rect-x b-hitbox) (rect-x overlap))
-                     (set-rect-x! b-hitbox (+ (rect-x b-hitbox) (rect-width overlap)))
-                     (set-rect-x! b-hitbox (- (rect-x b-hitbox) (rect-width overlap)))))
-               (begin
-                 (reflect-ball! ball #f #t)
-                 (if (= (rect-y b-hitbox) (rect-y overlap))
-                     (set-rect-y! b-hitbox (+ (rect-y b-hitbox) (rect-height overlap)))
-                     (set-rect-y! b-hitbox (- (rect-y b-hitbox) (rect-height overlap))))))))))
+    (set-vec2-x! (player-velocity (level-player level)) speed)
+    (set-vec2-y! (player-velocity (level-player level)) speed)))
 
 (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
 (define (update)
   (match (level-state *level*)
     ('play
-     (let* ((bricks (level-bricks *level*))
-            (ball (level-ball *level*))
-            (b-velocity (ball-velocity ball))
-            (b-hitbox (ball-hitbox ball))
-            (paddle (level-paddle *level*))
-            (p-velocity (paddle-velocity paddle))
-            (p-hitbox (paddle-hitbox paddle))
-            (score (level-score *level*)))
-       ;; Move ball and paddle
-       (set-rect-x! b-hitbox (+ (rect-x b-hitbox) (vec2-x b-velocity)))
-       (set-rect-y! b-hitbox (+ (rect-y b-hitbox) (vec2-y b-velocity)))
-       ;; We only move the paddle along the x-axis.
-       (set-rect-x! p-hitbox
-                    (clamp (+ (rect-x p-hitbox) (vec2-x p-velocity))
-                           0.0
-                           (- game-width paddle-width)))
-       ;; Collide ball against walls, bricks, and paddle.
+     (let* ((player (level-player *level*))
+            (p-velocity (player-velocity player))
+            (p-position (player-position player))
+            (p-hitbox (player-hitbox player)))
+       ;; Move player
+       (set-vec2-x! p-position (+ (vec2-x p-position) (vec2-x p-velocity)))
+       (set-vec2-y! p-position (+ (vec2-y p-position) (vec2-y p-velocity)))
+
+       ;; Keep player within the bounds of the game
        (cond
-        ((< (rect-x b-hitbox) 0.0)      ; left wall
-         (set-rect-x! b-hitbox 0.0)
-         (reflect-ball! ball #t #f))
-        ((> (+ (rect-x b-hitbox) (rect-width b-hitbox)) game-width) ; right wall
-         (set-rect-x! b-hitbox (- game-width (rect-width b-hitbox)))
-         (reflect-ball! ball #t #f))
-        ((< (rect-y b-hitbox) 0.0)      ; top wall
-         (set-rect-y! b-hitbox 0.0)
-         (reflect-ball! ball #f #t))
-        ((> (+ (rect-y b-hitbox) (rect-height b-hitbox)) game-height) ; bottom wall
-         (lose! *level*))
-        ((collide-ball! ball (paddle-hitbox paddle))
-         (media-play audio:paddle)
-         (speed-up-ball! ball))
-        (else
-         (let loop ((i 0) (hit? #f))
-           (if (< i (vector-length bricks))
-               (let ((brick (vector-ref bricks i)))
-                 (if (and (not (brick-broken? brick))
-                          (collide-ball! ball (brick-hitbox brick)))
-                     (begin
-                       (media-play audio:brick)
-                       (speed-up-ball! ball)
-                       (set-brick-broken! brick #t)
-                       (set-level-score! *level*
-                                         (+ (level-score *level*)
-                                            (brick-type-points (brick-type brick))))
-                       (loop (+ i 1) #t))
-                     (loop (+ i 1) hit?)))
-               ;; Maybe change to win state if all bricks are broken.
-               (when (and hit? (level-clear? *level*))
-                 (win! *level*))))))))
+        ((< (vec2-x p-position) 0.0)      ; left wall
+         (set-vec2-x! p-position 0.0))
+        ((> (vec2-x p-position) game-width) ; right wall
+         (set-vec2-x! p-position game-width)))
+       ((< (vec2-y p-position) 0.0)      ; top wall
+        (set-vec2-y! p-position 0.0))
+       ((> (vec2-y p-position) game-height) ; bottom wall
+        (set-vec2-y! p-position game-height))))
     (_ #t))
   (timeout update-callback dt))
 (define update-callback (procedure->external update))
@@ -264,53 +133,18 @@
             str)))))
 
 (define (draw prev-time)
-  (let ((bricks (level-bricks *level*))
-        (ball (level-ball *level*))
-        (paddle (level-paddle *level*))
-        (score (level-score *level*)))
+  (let ((player (level-player *level*)))
     ;; Draw background
     (set-fill-color! context "#140c1c")
     (fill-rect context 0.0 0.0 game-width game-height)
-    ;; Draw bricks
-    (do ((i 0 (+ i 1)))
-        ((= i (vector-length bricks)))
-      (let* ((brick (vector-ref bricks i))
-             (type (brick-type brick))
-             (hitbox (brick-hitbox brick)))
-        (unless (brick-broken? brick)
-          (draw-image context (brick-type-image type)
-                      0.0 0.0
-                      brick-width brick-height
-                      (rect-x hitbox) (rect-y hitbox)
-                      brick-width brick-height))))
-    ;; Draw paddle
-    (let ((w 104.0)
-          (h 24.0)
-          (hitbox (paddle-hitbox paddle)))
-      (draw-image context image:paddle
-                  0.0 0.0 w h
-                  (rect-x hitbox) (rect-y hitbox) w h))
-    ;; Draw ball
+    
+    ;; Draw player
     (let ((w 22.0)
           (h 22.0)
-          (hitbox (ball-hitbox ball)))
-      (draw-image context image:ball
+          (position (player-position player)))
+      (draw-image context image:player
                   0.0 0.0 w h
-                  (rect-x hitbox) (rect-y hitbox) w h))
-    ;; Print score
-    (set-fill-color! context "#ffffff")
-    (set-font! context "bold 24px monospace")
-    (set-text-align! context "left")
-    (fill-text context "SCORE:" 16.0 36.0)
-    (fill-text context (number->string* score) 108.0 36.0)
-    (match (level-state *level*)
-      ('win
-       (set-text-align! context "center")
-       (fill-text context "YAY YOU DID IT!!!" (/ game-width 2.0) (/ game-height 2.0)))
-      ('lose
-       (set-text-align! context "center")
-       (fill-text context "OH NO, GAME OVER :(" (/ game-width 2.0) (/ game-height 2.0)))
-      (_ #t)))
+                  (vec2-x position) (vec2-y position) w h)))
   (request-animation-frame draw-callback))
 (define draw-callback (procedure->external draw))
 
@@ -327,17 +161,13 @@
       ('play
        (cond
         ((string=? key key:left)
-         (set-level-move-left! *level* #t)
-         (update-paddle-velocity! *level*))
+         (set-level-move-left! *level* #t))
         ((string=? key key:right)
-         (set-level-move-right! *level* #t)
-         (update-paddle-velocity! *level*))
+         (set-level-move-right! *level* #t))
         ((string=? key key:up)
-         (set-level-move-up! *level* #t)
-         (update-paddle-velocity! *level*))
+         (set-level-move-up! *level* #t))
         ((string=? key key:down)
-         (set-level-move-down! *level* #t)
-         (update-paddle-velocity! *level*))))
+         (set-level-move-down! *level* #t))))
       ((or 'win 'lose)
        (when (string=? key key:confirm)
          (set! *level* (make-level-1)))))))
@@ -348,17 +178,13 @@
       ('play
        (cond
         ((string=? key key:left)
-         (set-level-move-left! *level* #f)
-         (update-paddle-velocity! *level*))
+         (set-level-move-left! *level* #f))
         ((string=? key key:right)
-         (set-level-move-right! *level* #f)
-         (update-paddle-velocity! *level*))
+         (set-level-move-right! *level* #f))
         ((string=? key key:up)
-         (set-level-move-up! *level* #f)
-         (update-paddle-velocity! *level*))
+         (set-level-move-up! *level* #f))
         ((string=? key key:down)
-         (set-level-move-down! *level* #f)
-         (update-paddle-velocity! *level*))))
+         (set-level-move-down! *level* #f))))
       (_ #t))))
 
 ;; Canvas and event loop setup