commit c0c2af5cc4e340651d28652936a56f237e834a66
parent 087d9a0014e728e71c673a63e16ecdf2aa499346
Author: Yuval Langer <yuvallangerontheroad@gmail.com>
Date: Sun, 29 Oct 2023 12:49:13 +0000
Add good bricks which raise the score by 1 and bad bricks when lower by 1.
Diffstat:
| M | main.scm | | | 80 | ++++++++++++++++++++++++++++++++++++++++++++++++------------------------------- |
1 file changed, 49 insertions(+), 31 deletions(-)
diff --git a/main.scm b/main.scm
@@ -63,7 +63,8 @@
;;; 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 good-brick-fill-style "rgb(50, 100, 0)")
+(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))
@@ -101,24 +102,23 @@
(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)))
+
(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)))))
+ (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)))))
;;; Global variables: (~_~)
(define last-loop-time 0)
@@ -135,6 +135,7 @@
50))
(width . ,player-width)
(height . ,player-height)))
+(define score 0)
;;; END Global variables.
(define (make-new-cloud)
@@ -169,10 +170,16 @@
(height . ,brick-height)
(x-velocity . 0)
(y-velocity . 0.25)
- (idspispopd . #f))))
+ (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)
+ (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)
@@ -215,6 +222,17 @@
(filter (cut collision? player <>)
bricks))
+(define (sum our-list)
+ (let loop ((our-list our-list)
+ (our-sum 0))
+ (cond
+ ((null? our-list)
+ our-sum)
+ (else
+ (loop (cdr our-list)
+ (+ our-sum
+ (car our-list)))))))
+
(define (draw)
(draw-clouds clouds)
(draw-player player)
@@ -229,8 +247,7 @@
(move-elements! dt falling-bricks)
(move-elements! dt clouds)
- (print clouds)
- (print falling-bricks)
+ (print (unless (null? falling-bricks) (car falling-bricks)))
;; Periodically create a new cloud:
(when (< next-cloud-time
@@ -255,24 +272,25 @@
(/ player-width
2)))
- (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)))
(for-each (lambda (brick)
(assq-set! brick
'idspispopd
- #t))
- bricks-collided)
- (unless (null? bricks-collided)
- (print bricks-collided)))
+ #t)
+ (if (assq-ref brick 'is-good)
+ (begin
+ (print "is-good")
+ (set! score (+ score 1)))
+ (begin
+ (print "is-bad")
+ (set! score (- score 1)))))
+ bricks-collided))
+
+ (print score)
(draw)
