spook

commit ff1d5c353cb6f145e038da06c823807b0cae876f
parent c9797de297a51e5542c7466b00b2052a3a0ee8f8
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date:   Sun, 29 Oct 2023 09:27:22 +0000

Collide only once with a particular brick.

Diffstat:
M
main.scm
 | 
80
+++++++++++++++++++++++++++++++++++++++++++++++--------------------------------

1 file changed, 48 insertions(+), 32 deletions(-)
diff --git a/main.scm b/main.scm
@@ -22,7 +22,16 @@
   (let ((result (assq key alist)))
     (if result
         (cdr result)
-        #f)))
+        #f))
+  #;(alist-ref key alist eq?)
+  ;; No alist-ref :(
+  ;; https://api.call-cc.org/5/doc/chicken/base/alist-ref
+  )
+
+(define (assq-set! alist key value)
+  (let ((pair (assq key alist)))
+    (set-cdr! pair
+              value)))
 
 (define (a) (alert "aaaaa"))
 
@@ -77,14 +86,9 @@
 (define (cursor-x cursor)
   (car cursor))
 
-(define (make-rect x y half-width half-height)
-  `((x . ,x)
-    (y . ,y)
-    (half-width . ,half-width)
-    (half-height . ,half-height)))
-
 (define (collision? player brick)
-  (not (or (< (+ (assq-ref player 'x)
+  (not (or (assq-ref brick 'idspispopd)
+           (< (+ (assq-ref player 'x)
                  player-width)
               (assq-ref brick 'x))
            (< (+ (assq-ref brick 'x)
@@ -116,7 +120,8 @@
                   3)))
       (y . ,(/ (.height canvas)
                10))
-      (velocity . 0.25))))
+      (velocity . 0.25)
+      (idspispopd . #f))))
 
 (define (draw-falling-bricks bricks)
   (for-each (lambda (brick)
@@ -128,18 +133,21 @@
 
 (define gravity 0.001)
 
-(define (move-brick dt brick)
-  (let* ((x (assq-ref brick 'x))
-         (y (assq-ref brick 'y))
+(define (move-brick! dt brick)
+  (let* ((y (assq-ref brick 'y))
          (velocity (assq-ref brick 'velocity))
          ;; (new-velocity (+ velocity (* gravity dt)))
          (new-y (+ y (* velocity dt))))
+    (assq-set! brick
+               'y
+               new-y)
+    #;
     `((x . ,x)
-      (y . ,new-y)
-      (velocity . ,velocity))))
+    (y . ,new-y)
+    (velocity . ,velocity))))
 
-(define (move-bricks dt bricks)
-  (map (cut move-brick dt <>)
+(define (move-bricks! dt bricks)
+  (map (cut move-brick! dt <>)
        bricks))
 
 (define (brick-inside-canvas? brick)
@@ -154,14 +162,19 @@
   (filter (cut collision? player <>)
           bricks))
 
+(define (draw)
+  (draw-player player)
+  (draw-falling-bricks falling-bricks))
+
 (define (loop time)
   (let* ((dt (- time last-time)))
     (set! last-time time)
+
     (clear-rect)
 
-    (set! falling-bricks (move-bricks dt falling-bricks))
+    (move-bricks! dt falling-bricks)
 
-    ;; Periodically create a new falling brick.
+    ;; Periodically create a new falling brick:
     (when (> (- time
                 last-brickfall-time)
              (+ (randint 2500)
@@ -170,23 +183,26 @@
                                  falling-bricks))
       (set! last-brickfall-time time))
 
-    (draw-player player)
-
-    (draw-falling-bricks falling-bricks)
-
-    (set! player (assq-replace player
-                               'x
-                               (- (cursor-x cursor)
-                                  (/ player-width
-                                     2))))
+    ;; Get input:
+    (assq-set! player
+               'x
+               (- (cursor-x cursor)
+                  (/ player-width
+                     2)))
 
     (set! falling-bricks (filter-out-of-canvas-falling-bricks falling-bricks))
 
-    (let ((collisions (get-collided-bricks player
-                                           falling-bricks)))
-      (cond
-       ((null? collisions) (print "Nothing"))
-       (else (alert (car collisions)))))
+    (let ((bricks-collided (get-collided-bricks player
+                                                falling-bricks)))
+      (for-each (lambda (brick)
+                  (assq-set! brick
+                             'idspispopd
+                             #t))
+                bricks-collided)
+      (unless (null? bricks-collided)
+        (print bricks-collided)))
+
+    (draw)
 
     (%inline "window.requestAnimationFrame" (callback loop))))