commit 7e672e9a31fd8b248373175d4b26c1b2465cc206
parent 20bb22bd64951a022d130faf50134e5bc4f2e2cf
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date: Fri, 27 Oct 2023 17:31:19 +0000
Add falling bricks and collision.
Diffstat:
| M | main.scm | | | 214 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------- |
1 file changed, 153 insertions(+), 61 deletions(-)
diff --git a/main.scm b/main.scm
@@ -1,6 +1,29 @@
(define (alert message)
(%inline "alert" message))
+(define (filter predicate our-list)
+ (cond
+ ((null? our-list) '())
+ ((predicate (car our-list))
+ (cons (car our-list)
+ (filter predicate
+ (cdr our-list))))
+ (else (filter predicate
+ (cdr our-list)))))
+
+(define (assq-replace alist key value)
+ (cons (cons key value)
+ (filter (o not
+ (cut eq? key <>)
+ car)
+ alist)))
+
+(define (assq-ref alist key)
+ (let ((result (assq key alist)))
+ (if result
+ (cdr result)
+ #f)))
+
(define (a) (alert "aaaaa"))
(define canvas
@@ -11,61 +34,32 @@
(set! (.fillStyle ctx) "rgb(200, 0, 0)")
-(define brick-half-width 10)
-(define brick-half-height 5)
-
-(define (make-brick x y)
- (cons x y))
-
-(define (brick-x brick)
- (car brick))
-
-(define (brick-y brick)
- (car (cdr brick)))
-
-(define paddle-half-width 20)
-(define paddle-half-height 3)
-
-(define (make-paddle x y)
- (cons x y))
-
-(define (paddle-x paddle)
- (car paddle))
+(define brick-width (/ (.width canvas)
+ 3))
+(define brick-height 40)
-(define (paddle-y paddle)
- (cdr paddle))
+(define player-width 40)
+(define player-height 20)
-(define (set-paddle-x! paddle value)
- (set! (car paddle) value))
+(define player
+ `((x . ,(/ (.width canvas)
+ 2))
+ (y . ,(- (.height canvas)
+ 50))))
-(define paddle
- (make-paddle (/ (.width canvas)
- 2)
- (- (.height canvas)
- 50)))
+(define (draw-player player)
+ (draw-rect (assq-ref player 'x)
+ (assq-ref player 'y)
+ player-width
+ player-height))
-(define (draw-rect x y half-width half-height)
+(define (draw-rect x y width height)
(%inline ".fillRect"
ctx
- (- x half-width)
- (- y half-height)
- (* 2 half-width)
- (* 2 half-height)))
-
-(define (draw-bricks bricks)
- (for-each
- (lambda (brick)
- (draw-rect (brick-x brick)
- (brick-y brick)
- brick-half-width
- brick-half-height))
- bricks))
-
-(define bricks
- '()
- #;
- (make-world (/ (.width (get-canvas)) 2) ;
- (/ (.height (get-canvas)) 2)))
+ x
+ y
+ width
+ height))
(define (clear-rect)
(%inline ".clearRect"
@@ -83,20 +77,118 @@
(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)
+ player-width)
+ (assq-ref brick 'x))
+ (< (+ (assq-ref brick 'x)
+ brick-width)
+ (assq-ref player 'x))
+ (< (+ (assq-ref player 'y)
+ player-width)
+ (assq-ref brick 'y))
+ (< (+ (assq-ref brick 'y)
+ brick-width)
+ (assq-ref player 'y)))))
+
+(define falling-bricks '())
+(define last-brickfall-time 0)
+
+(define (random)
+ (%inline "Math.random"))
+
+(define (randint n)
+ "Random integer [0, n)."
+ (inexact->exact
+ (floor
+ (* (random) n))))
+
+(define (make-new-falling-brick)
+ (let* ((zero-one-or-two (randint 3)))
+ `((x . ,(* zero-one-or-two
+ (/ (.width canvas)
+ 3)))
+ (y . ,(/ (.height canvas)
+ 10))
+ (velocity . 0.25))))
+
+(define (draw-falling-bricks bricks)
+ (for-each (lambda (brick)
+ (draw-rect (assq-ref brick 'x)
+ (assq-ref brick 'y)
+ brick-width
+ brick-height))
+ bricks))
+
+(define gravity 0.001)
+
+(define (move-brick dt brick)
+ (let* ((x (assq-ref brick 'x))
+ (y (assq-ref brick 'y))
+ (velocity (assq-ref brick 'velocity))
+ ;; (new-velocity (+ velocity (* gravity dt)))
+ (new-y (+ y (* velocity dt))))
+ `((x . ,x)
+ (y . ,new-y)
+ (velocity . ,velocity))))
+
+(define (move-bricks dt bricks)
+ (map (cut move-brick dt <>)
+ bricks))
+
+(define (brick-inside-canvas? brick)
+ (let* ((y (assq-ref brick 'y)))
+ (< y (.height canvas))))
+
+(define (filter-out-of-canvas-falling-bricks bricks)
+ (filter brick-inside-canvas?
+ bricks))
+
+(define (get-collided-bricks player bricks)
+ (filter (cut collision? player <>)
+ bricks))
+
(define (loop time)
- (define dt (- time last-time))
- (set! last-time time)
- (clear-rect)
+ (let* ((dt (- time last-time)))
+ (set! last-time time)
+ (clear-rect)
+
+ (set! falling-bricks (move-bricks dt falling-bricks))
+
+ ;; Periodically create a new falling brick.
+ (when (> (- time
+ last-brickfall-time)
+ (+ (randint 2500)
+ 500))
+ (set! falling-bricks (cons (make-new-falling-brick)
+ 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))))
- #;(alert world)
- (draw-rect (paddle-x paddle)
- (paddle-y paddle)
- paddle-half-width
- paddle-half-height)
+ (set! falling-bricks (filter-out-of-canvas-falling-bricks falling-bricks))
- (set-paddle-x! paddle (cursor-x cursor))
+ (let ((collisions (get-collided-bricks player
+ falling-bricks)))
+ (cond
+ ((null? collisions) (print "Nothing"))
+ (else (print (car collisions)))))
- (%inline "window.requestAnimationFrame" (callback loop)))
+ (%inline "window.requestAnimationFrame" (callback loop))))
(%inline "window.requestAnimationFrame" (callback loop))
@@ -106,7 +198,7 @@
event-name
(callback (lambda (e)
(set! cursor
- (cons (.offsetX e)
- (.offsetY e)))))))
+ (cons (.offsetX e)
+ (.offsetY e)))))))
'("pointerdown"
"pointermove"))
