commit 087d9a0014e728e71c673a63e16ecdf2aa499346
parent 06d7394b09cc8802b3e9c6adce777991580efcfb
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date: Sun, 29 Oct 2023 12:00:56 +0000
Use sky colour for background, make and move clouds, and organise code.
Diffstat:
2 files changed, 151 insertions(+), 81 deletions(-)
diff --git a/main.scm b/main.scm
@@ -1,6 +1,26 @@
+;;; Utility procedures:
(define (alert message)
(%inline "alert" message))
+(define (a) (alert "aaaaa"))
+
+(define (random)
+ (%inline "Math.random"))
+
+(define (lerp t start end)
+ (+ start
+ (* (- end start)
+ t)))
+
+(define (random-uniform start end)
+ (lerp (random) start end))
+
+(define (randint n)
+ "Random integer [0, n)."
+ (inexact->exact
+ (floor
+ (* (random) n))))
+
(define (filter predicate our-list)
(cond
((null? our-list) '())
@@ -32,8 +52,7 @@
(let ((pair (assq key alist)))
(set-cdr! pair
value)))
-
-(define (a) (alert "aaaaa"))
+;;; END Utility procedures.
(define canvas
(%inline "document.getElementById" "canvas"))
@@ -41,22 +60,19 @@
(define ctx
(%inline ".getContext" canvas "2d"))
+;;; Constants:
(define background-fill-style "hsla(0, 0%, 0%, .2)")
(define player-fill-style "rgb(200, 0, 0)")
(define brick-fill-style "rgb(200, 0, 0)")
-
-(define brick-width (/ (.width canvas)
- 3))
+(define cloud-fill-style "#DDE7EE")
+(define cloud-fill-style "#bbb")
+(define brick-width (/ (.width canvas) 3))
(define brick-height 40)
-
(define player-width 40)
(define player-height 20)
-
-(define player
- `((x . ,(/ (.width canvas)
- 2))
- (y . ,(- (.height canvas)
- 50))))
+(define cloud-width 150)
+(define cloud-height 75)
+;;; END Constants.
(define (draw-player player)
(set! (.fillStyle ctx) player-fill-style)
@@ -66,7 +82,6 @@
player-height))
(define (draw-rect x y width height)
- (set! (.fillStyle ctx) brick-fill-style)
(%inline ".fillRect"
ctx
x
@@ -75,48 +90,73 @@
height))
(define (clear-rect)
- (set! (.fillStyle ctx) background-fill-style)
- (%inline ".fillRect"
+ #;(set! (.fillStyle ctx) background-fill-style)
+ (%inline ".clearRect"
ctx
0
0
(.width canvas)
(.height canvas)))
-(define last-time 0)
-
-(define cursor (cons (/ (.width canvas) 2)
- (/ (.height canvas) 2)))
-
(define (cursor-x cursor)
(car cursor))
-(define (collision? player brick)
- (not (or (assq-ref brick 'idspispopd)
- (< (+ (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-height)
- (assq-ref brick 'y))
- (< (+ (assq-ref brick 'y)
- brick-height)
- (assq-ref player 'y)))))
-
+(define (collision? element-a element-b)
+ (let ((element-a-west (assq-ref element-a 'x))
+ (element-a-east (assq-ref element-a 'y))
+ (element-a-north (assq-ref element-a 'width))
+ (element-a-south (assq-ref element-a 'height))
+ (element-b-west (assq-ref element-b 'x))
+ (element-b-east (assq-ref element-b 'y))
+ (element-b-north (assq-ref element-b 'width))
+ (element-b-south (assq-ref element-b 'height)))
+ (not (or (assq-ref element-b 'idspispopd)
+ (< element-a-east
+ element-b-west)
+ (< element-b-east
+ element-a-west)
+ (< element-a-south
+ element-b-north)
+ (< element-b-south
+ element-a-north)))))
+
+;;; Global variables: (~_~)
+(define last-loop-time 0)
(define falling-bricks '())
-(define last-brickfall-time 0)
+(define next-brickfall-time 0)
+(define clouds '())
+(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)))
+;;; 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))))
-(define (random)
- (%inline "Math.random"))
-
-(define (randint n)
- "Random integer [0, n)."
- (inexact->exact
- (floor
- (* (random) n))))
+(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)))
+ clouds))
(define (make-new-falling-brick)
(let* ((zero-one-or-two (randint 3)))
@@ -125,68 +165,88 @@
3)))
(y . ,(/ (.height canvas)
10))
- (velocity . 0.25)
+ (width . ,brick-width)
+ (height . ,brick-height)
+ (x-velocity . 0)
+ (y-velocity . 0.25)
(idspispopd . #f))))
(define (draw-falling-bricks bricks)
(for-each (lambda (brick)
(draw-rect (assq-ref brick 'x)
(assq-ref brick 'y)
- brick-width
- brick-height))
+ (assq-ref brick 'width)
+ (assq-ref brick 'height)))
bricks))
-(define gravity 0.001)
-
-(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
+(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)
- #;
- `((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))
+ new-y)))
+
+(define (move-elements! dt elements)
+ (map (cut move-element! dt <>)
+ elements))
+
+(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)))))
+
+(define (filter-out-of-canvas-elements elements)
+ (filter element-inside-canvas?
+ elements))
(define (get-collided-bricks player bricks)
(filter (cut collision? player <>)
bricks))
(define (draw)
+ (draw-clouds clouds)
(draw-player player)
(draw-falling-bricks falling-bricks))
(define (loop time)
- (let* ((dt (- time last-time)))
- (set! last-time time)
+ (let* ((dt (- time last-loop-time)))
+ (set! last-loop-time time)
(clear-rect)
- (move-bricks! dt falling-bricks)
+ (move-elements! dt falling-bricks)
+ (move-elements! dt clouds)
+
+ (print clouds)
+ (print falling-bricks)
+
+ ;; Periodically create a new cloud:
+ (when (< next-cloud-time
+ time)
+ (set! clouds (cons (make-new-cloud)
+ clouds))
+ (set! next-cloud-time (+ time
+ (random-uniform 5000 8000))))
;; Periodically create a new falling brick:
- (when (> (- time
- last-brickfall-time)
- (+ (randint 2500)
- 500))
+ (when (< next-brickfall-time
+ time)
(set! falling-bricks (cons (make-new-falling-brick)
falling-bricks))
- (set! last-brickfall-time time))
+ (set! next-brickfall-time (+ time
+ (random-uniform 750 1000))))
;; Get input:
(assq-set! player
@@ -195,7 +255,14 @@
(/ player-width
2)))
- (set! falling-bricks (filter-out-of-canvas-falling-bricks falling-bricks))
+ (print clouds)
+ (print falling-bricks)
+
+ (set! falling-bricks (filter-out-of-canvas-elements falling-bricks))
+ (set! clouds (filter-out-of-canvas-elements clouds))
+
+ (print clouds)
+ (print falling-bricks)
(let ((bricks-collided (get-collided-bricks player
falling-bricks)))
diff --git a/pages/index.html b/pages/index.html
@@ -6,6 +6,9 @@
/* https://developer.mozilla.org/en-US/docs/Web/CSS/Layout_cookbook/Center_an_element
* Huzzah!
*/
+ body {
+ background-color: #cff;
+ }
.container {
display: flex;
align-items: center;
