commit ce1b8e15096c3b2911e67ff18dbdf25a74107609
parent b2a46bcfb8ede1eeb7416b495b924bb0c1612e21
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date: Fri, 10 Nov 2023 13:42:50 +0200
Use makers, getters, setters, and predicates for the alist objects.
Diffstat:
| M | main.scm | | | 344 | +++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------- |
1 file changed, 223 insertions(+), 121 deletions(-)
diff --git a/main.scm b/main.scm
@@ -71,18 +71,26 @@
(define bad-brick-fill-style "rgb(200, 0, 0)")
(define cloud-fill-style "#DDE7EE")
(define cloud-fill-style "#bbb")
-(define brick-width (/ (.width canvas) 3))
+(define number-of-lanes 3)
+(define brick-width (/ (.width canvas) number-of-lanes))
+(define brick-half-width (/ brick-width 2))
(define brick-height 40)
-(define player-width 40)
-(define player-height 20)
-(define cloud-width 150)
-(define cloud-height 75)
+(define brick-half-height (/ brick-height 2))
+(define player-half-width 20)
+(define player-width (* 2 player-half-width))
+(define player-half-height 10)
+(define player-height (* 2 player-half-height))
+(define player-speed-x 0.7)
+(define cloud-half-width 75)
+(define cloud-width (* 2 cloud-half-width))
+(define cloud-half-height 37)
+(define cloud-height (* 2 cloud-half-height))
;;; END Constants.
(define (draw-player player)
(set! (.fillStyle ctx) player-fill-style)
- (draw-rect (assq-ref player 'x)
- (assq-ref player 'y)
+ (draw-rect (- (element-center-x player) player-half-width)
+ (- (element-center-y player) player-half-height)
player-width
player-height))
@@ -106,23 +114,127 @@
(define (cursor-x cursor)
(car cursor))
-(define (north element) (assq-ref element 'y))
-(define (south element) (+ (assq-ref element 'y)
- (assq-ref element 'height)))
-(define (west element) (assq-ref element 'x))
-(define (east element) (+ (assq-ref element 'x)
- (assq-ref element 'width)))
+;;; Makers:
+
+(define (make-player)
+ `((center-x . ,(/ (.width canvas)
+ 2))
+ (center-y . ,(- (.height canvas)
+ 50))
+ (half-width . ,player-half-width)
+ (half-height . ,player-half-height)
+ (velocity-x . 0)
+ (velocity-y . 0)))
+
+(define (make-new-cloud)
+ (let* ((cloud-y (random-uniform 10
+ (/ (.height canvas)
+ 5))))
+ `((center-x . ,(* -0.999 cloud-width))
+ (center-y . ,cloud-y)
+ (half-width . ,cloud-half-width)
+ (half-height . ,cloud-half-height)
+ (velocity-x . 0.05)
+ (velocity-y . 0)
+ (idspispopd . #f))))
+
+(define (make-new-falling-brick)
+ (let* ((zero-one-or-two (randint number-of-lanes)))
+ `((center-x . ,(* zero-one-or-two
+ (/ (.width canvas)
+ 3)))
+ (center-y . ,(/ (.height canvas)
+ 10))
+ (half-width . ,brick-half-width)
+ (half-height . ,brick-half-height)
+ (velocity-x . 0)
+ (velocity-y . 0.25)
+ (idspispopd . #f)
+ (is-good . ,(if (= (randint 2) 0)
+ #t
+ #f)))))
+
+;;; END Makers.
+
+;;; Getters:
+
+(define (element-center-x element) (assq-ref element 'center-x))
+(define (element-left element)
+ (- (element-center-x element)
+ (element-half-width element)))
+(define (element-right element)
+ (+ (element-center-x element)
+ (element-half-width element)))
+(define (element-center-y element) (assq-ref element 'center-y))
+(define (element-top element)
+ (- (element-center-y element)
+ (element-half-height element)))
+(define (element-bottom element)
+ (+ (element-center-y element)
+ (element-half-height element)))
+(define (element-velocity-x element) (assq-ref element 'velocity-x))
+(define (element-velocity-y element) (assq-ref element 'velocity-y))
+(define (element-width element) (* 2 (element-half-width element)))
+(define (element-half-width element) (assq-ref element 'half-width))
+(define (element-height element) (* 2 (element-half-height element)))
+(define (element-half-height element) (assq-ref element 'half-height))
+(define (extents-x-low extents) (caar extents))
+(define (extents-x-high extents) (cdar extents))
+(define (extents-y-low extents) (cadr extents))
+(define (extents-y-high extents) (cddr extents))
+
+;;; END Getters.
+
+
+;;; Setters:
+
+(define (set-element-center-x! element value)
+ (assq-set! element 'center-x value))
+(define (set-element-center-y! element value)
+ (assq-set! element 'center-y value))
+(define (set-element-left! element value)
+ (assq-set! element
+ 'center-x
+ (+ (element-center-x element)
+ (element-half-width element))))
+(define (set-element-top! element value)
+ (assq-set! element
+ 'center-y
+ (+ (element-center-y element)
+ (element-half-height element))))
+(define (set-element-velocity-x! element value)
+ (assq-set! element 'velocity-x value))
+(define (set-element-velocity-y! element value)
+ (assq-set! element 'velocity-y value))
+(define (set-element-idspispopd! element value)
+ (assq-set! element 'idspispopd value))
+
+;;; END Setters.
+
+;;; Predicates:
+
+(define (element-is-good? element) (assq-ref element 'is-good))
+
+(define (element-idspispopd? element) (assq-ref element 'idspispopd))
+
+(define (element-inside-canvas? element)
+ (and (<= 0 (element-right element))
+ (<= (element-left) (.width canvas))
+ (<= 0 (element-bottom element))
+ (<= (element-top element) (.height canvas))))
(define (collision? element-a element-b)
- (not (or (assq-ref element-b 'idspispopd)
- (< (east element-a)
- (west element-b))
- (< (east element-b)
- (west element-a))
- (< (south element-a)
- (north element-b))
- (< (south element-b)
- (north element-a)))))
+ (not (or (element-idspispopd? element-b)
+ (< (element-right element-a)
+ (element-left element-b))
+ (< (element-right element-b)
+ (element-left element-a))
+ (< (element-bottom element-a)
+ (element-top element-b))
+ (< (element-bottom element-b)
+ (element-top element-a)))))
+
+;;; END Predicates.
;;; Global variables: (~_~)
(define last-loop-time 0)
@@ -132,91 +244,82 @@
(define next-cloud-time 0)
(define cursor (cons (/ (.width canvas) 2)
(/ (.height canvas) 2)))
-(define player
- `((x . ,(/ (.width canvas)
- 2))
- (y . ,(- (.height canvas)
- 50))
- (width . ,player-width)
- (height . ,player-height)))
+(define player (make-player))
(define score 0)
;;; END Global variables.
-(define (make-new-cloud)
- (let* ((cloud-y (random-uniform 10
- (/ (.height canvas)
- 5))))
- `((x . ,(* -0.999 cloud-width))
- (y . ,cloud-y)
- (width . ,cloud-width)
- (height . ,cloud-height)
- (x-velocity . 0.05)
- (y-velocity . 0)
- (idspispopd . #f))))
+;;; Drawers:
(define (draw-clouds clouds)
(set! (.fillStyle ctx) cloud-fill-style)
(for-each (lambda (cloud)
- (draw-rect (assq-ref cloud 'x)
- (assq-ref cloud 'y)
- (assq-ref cloud 'width)
- (assq-ref cloud 'height)))
+ (draw-rect (element-center-x cloud)
+ (element-center-y cloud)
+ (element-width cloud)
+ (element-height cloud)))
clouds))
-(define (make-new-falling-brick)
- (let* ((zero-one-or-two (randint 3)))
- `((x . ,(* zero-one-or-two
- (/ (.width canvas)
- 3)))
- (y . ,(/ (.height canvas)
- 10))
- (width . ,brick-width)
- (height . ,brick-height)
- (x-velocity . 0)
- (y-velocity . 0.25)
- (idspispopd . #f)
- (is-good . ,(if (= (randint 2) 0)
- #t
- #f)))))
-
(define (draw-falling-bricks bricks)
(for-each (lambda (brick)
- (if (assq-ref brick 'is-good)
+ (if (element-is-good? brick)
(set! (.fillStyle ctx) good-brick-fill-style)
(set! (.fillStyle ctx) bad-brick-fill-style))
- (draw-rect (assq-ref brick 'x)
- (assq-ref brick 'y)
- (assq-ref brick 'width)
- (assq-ref brick 'height)))
+ (draw-rect (element-center-x brick)
+ (element-center-y brick)
+ (element-width brick)
+ (element-height brick)))
bricks))
-(define (move-element! dt element)
- (let* ((x (assq-ref element 'x))
- (x-velocity (assq-ref element 'x-velocity))
- (new-x (+ x (* x-velocity dt)))
- (y (assq-ref element 'y))
- (y-velocity (assq-ref element 'y-velocity))
- (new-y (+ y (* y-velocity dt))))
- (assq-set! element
- 'x
- new-x)
- (assq-set! element
- 'y
- new-y)))
-
-(define (move-elements! dt elements)
- (map (cut move-element! dt <>)
- elements))
+(define (draw-text)
+ (set! (.font ctx) "30px monospace")
+ (if (< score 0)
+ (set! (.fillStyle ctx) bad-brick-fill-style)
+ (set! (.fillStyle ctx) good-brick-fill-style))
+ (%inline ".fillText"
+ ctx
+ score
+ 10
+ 50))
+
+(define (draw)
+ (clear-rect)
+ (draw-clouds clouds)
+ (draw-player player)
+ (draw-falling-bricks falling-bricks)
+ (draw-text))
-(define (element-inside-canvas? element)
- (let* ((y (assq-ref element 'y))
- (x (assq-ref element 'x))
- (width (assq-ref element 'width))
- (height (assq-ref element 'height)))
- (and (<= 0 (+ x width))
- (<= x (.width canvas))
- (<= 0 y)
- (<= (+ y height) (.height canvas)))))
+;;; END Drawers.
+
+(define (clip value low high)
+ ((o (min <> high)
+ (max <> min))
+ value))
+
+(define (move-element! dt element &optional clip-extents)
+ (let* ((previous-center-x (element-center-x element))
+ (velocity-x (element-velocity-x element))
+ (new-center-x (+ previous-center-x (* velocity-x dt)))
+ (clipped-new-center-x (if (void? clip-extents)
+ new-center-x
+ (clip new-center-x
+ (extents-x-low clip-extents)
+ (extents-x-high clip-extents))))
+ (previous-center-y (element-center-y element))
+ (velocity-y (element-velocity-y element))
+ (new-center-y (+ previous-center-y (* velocity-y dt)))
+ (clipped-new-center-y (if (void? clip-extents)
+ new-center-y
+ (clip new-center-y
+ (extents-y-low clip-extents)
+ (extents-y-high clip-extents)))))
+ (set-element-center-x! element
+ clipped-new-center-x)
+ (set-element-center-y! element
+ clipped-new-center-y)))
+
+(define (move-elements! dt elements &optional extents)
+ (for-each (cut move-element! dt <> extents)
+ elements))
(define (filter-out-of-canvas-elements elements)
(filter element-inside-canvas?
@@ -237,29 +340,10 @@
(+ our-sum
(car our-list)))))))
-(define (draw-text)
- (set! (.font ctx) "30px monospace")
- (if (< score 0)
- (set! (.fillStyle ctx) bad-brick-fill-style)
- (set! (.fillStyle ctx) good-brick-fill-style))
- (%inline ".fillText"
- ctx
- score
- 10
- 50))
-
-(define (draw)
- (draw-clouds clouds)
- (draw-player player)
- (draw-falling-bricks falling-bricks)
- (draw-text))
-
(define (loop time)
(let* ((dt (- time last-loop-time)))
(set! last-loop-time time)
- (clear-rect)
-
(move-elements! dt falling-bricks)
(move-elements! dt clouds)
@@ -280,13 +364,33 @@
(random-uniform 750 1000))))
;; Get input:
- (assq-set! player
- 'x
- ((o (cut - <> (/ player-width 2))
- (cut max <> (/ player-width 2))
- (cut min <> (- (.width canvas)
- (/ player-width 2))))
- (cursor-x cursor)))
+ (let* ((wanted-player-center-x (cursor-x cursor))
+ (previous-player-center-x (element-center-x player))
+ (ratsui-minus-matsui (- wanted-player-center-x
+ previous-player-center-x))
+ (player-direction-x (cond
+ ((< (abs ratsui-minus-matsui)
+ 5)
+ 0)
+ ((> ratsui-minus-matsui
+ 0)
+ 1)
+ (else -1)))
+ (new-player-velocity-x (* player-direction-x
+ player-speed-x)))
+ (set-element-velocity-x! player new-player-velocity-x))
+ (move-element! dt player (list (cons (+ 0
+ (/ player-width
+ 2))
+ (- (.width canvas)
+ (/ player-width
+ 2)))
+ (cons (+ 0
+ (/ player-height
+ 2))
+ (- (.height canvas)
+ (/ player-height
+ 2)))))
(set! falling-bricks (filter-out-of-canvas-elements falling-bricks))
(set! clouds (filter-out-of-canvas-elements clouds))
@@ -294,10 +398,8 @@
(let ((bricks-collided (get-collided-bricks player
falling-bricks)))
(for-each (lambda (brick)
- (assq-set! brick
- 'idspispopd
- #t)
- (if (assq-ref brick 'is-good)
+ (set-element-idspispopd! brick #t)
+ (if (element-is-good? brick)
(begin
(set! score (+ score 1)))
(begin
