added assets for new levels and refactored as preparation

This commit is contained in:
Peter Tillemans 2024-05-04 11:26:54 +02:00
parent 8c46f0f721
commit bed4eee1e9
20 changed files with 67 additions and 43 deletions

Binary file not shown.

BIN
assets/level2/clouds.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

BIN
assets/level2/far.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 56 KiB

BIN
assets/level2/ground.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 12 KiB

BIN
assets/level2/middle.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 20 KiB

BIN
assets/level2/prize.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 30 KiB

BIN
assets/level2/sky.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 84 KiB

BIN
assets/level3/clouds.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 5 KiB

BIN
assets/level3/far.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 28 KiB

BIN
assets/level3/ground.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 40 KiB

BIN
assets/level3/middle.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

BIN
assets/level3/prize.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 63 KiB

BIN
assets/level3/sky.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

BIN
assets/level4/clouds.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.9 KiB

BIN
assets/level4/far.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

BIN
assets/level4/ground.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 46 KiB

BIN
assets/level4/middle.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

BIN
assets/level4/prize.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 81 KiB

BIN
assets/level4/sky.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.5 KiB

View file

@ -91,6 +91,14 @@
(and (<= (- x bs) bx (+ x w bs)) (and (<= (- x bs) bx (+ x w bs))
(not (<= (+ h bs) by (- (+ h gap) bs)))))) (not (<= (+ h bs) by (- (+ h gap) bs))))))
(defun random-pipes (n spacing max-height gap width)
(let ((padding 25))
(loop repeat n
for x from spacing by (+ spacing )
collect (make-pipe x (+ padding (random (- max-height gap padding padding))) gap width)))
)
;; ------------------------------------------------------------- ;; -------------------------------------------------------------
(defun make-high-score (score time) (defun make-high-score (score time)
@ -143,10 +151,8 @@ Hash-table with level name => file name => resource.")
(asdf:system-source-directory :flappy-ball))) (asdf:system-source-directory :flappy-ball)))
(defun read-level-assets (level) (defun read-level-assets (level)
(print level)
(let ((level-dict (serapeum:dict)) (let ((level-dict (serapeum:dict))
(folder (merge-pathnames (format nil "~a~a" level "/") *asset-folder*))) (folder (merge-pathnames (format nil "~a~a" level "/") *asset-folder*)))
(print folder)
(loop for file in (list "sky.png" "clouds.png" "far.png" "middle.png" "ground.png" "prize.png") (loop for file in (list "sky.png" "clouds.png" "far.png" "middle.png" "ground.png" "prize.png")
for content = (load-resource (namestring (merge-pathnames file folder))) for content = (load-resource (namestring (merge-pathnames file folder)))
do (setf (gethash file level-dict) content) do (setf (gethash file level-dict) content)
@ -178,13 +184,31 @@ Hash-table with level name => file name => resource.")
(pipe-draw pipe pipe-pen scroll-x height)) (pipe-draw pipe pipe-pen scroll-x height))
(draw-image-layer level "ground.png" scroll-x)) (draw-image-layer level "ground.png" scroll-x))
(defun random-pipes (n spacing max-height gap width) (defun draw-prize (level scroll-x target-x width)
(let ((padding 25)) (if (>= scroll-x target-x)
(loop repeat n (let ((pic (serapeum:href *resources* level "prize.png")))
for x from spacing by (+ spacing ) (draw pic :x (- (+ 60 width target-x) scroll-x) :y 0 ))))
collect (make-pipe x (+ padding (random (- max-height gap padding padding))) gap width)))
)
(defun draw-hud (state score high-scores)
(when (eq state 'new)
(text "Click to Start" 50 250 200 40)
(text "High Scores" 300 30 280 40)
(loop for (score . time) in high-scores
for i from 0
do (text (format nil "~3,'0d" (floor score)) 300 (+ 70 (* i 40)) 80 30)
do (text (local-time:format-timestring nil (local-time:universal-to-timestamp time) :format '(:year "-" :month "-" :day)) 400 (+ 70 (* i 40)) 200 30)
))
(when (eq state 'won)
(text "You Won" 380 100 160 60)
(text "Return to Restart" 300 150 320 40)
)
(when (eq state 'died)
(text "You Died" 380 100 160 60)
(text "Return to Restart" 300 150 320 40))
(text (format nil "~3,'0d" (floor score)) 820 20 100 40)
)
;; ------------------------------------------------------------- ;; -------------------------------------------------------------
@ -214,57 +238,57 @@ Hash-table with level name => file name => resource.")
(level "level1") (level "level1")
) )
(draw-background level scroll-x) (let ((ball-collides (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes))
(draw-foreground level pipes scroll-x pipe-pen height) )
(ball-draw ball (draw-background level scroll-x)
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes) (draw-foreground level pipes scroll-x pipe-pen height)
(progn
(when (eq state 'running)
(setf high-scores (high-scores-add high-scores score))
(save-high-scores "highscores" high-scores)
(setf state 'died))
collision-pen)
ball-pen))
(if (>= scroll-x target-x) (if ball-collides
(let ((pic (serapeum:href *resources* level "prize.png"))) (ball-draw ball collision-pen)
(draw pic :x (- (+ 960 target-x) scroll-x) :y 0 ))) (ball-draw ball ball-pen))
(when (eq state 'new) (draw-prize level scroll-x target-x width)
(setf scroll-x 0.0)
(text "Click to Start" 50 250 200 40) (draw-hud state score high-scores)
(loop for (score . time) in high-scores
for i from 0 (when (eq state 'new)
do (text (format nil "~3,'0d" (floor score)) 300 (+ 30 (* i 40)) 80 30) (setf scroll-x 0.0))
do (text (local-time:format-timestring nil (local-time:universal-to-timestamp time) :format '(:year "-" :month "-" :day)) 400 (+ 30 (* i 40)) 200 30) (when (eq state 'running)
)) (while-running sketch::*sketch*))
(when (eq state 'won) ;; has to come after checking for the new state or stuck in death
(text "You Won" 380 100 160 60) (when ball-collides
(text "Return to Restart" 300 150 320 40) (on-death sketch::*sketch*))
) )
(when (eq state 'died) )
(text "You Died" 380 100 160 60)
(text "Return to Restart" 300 150 320 40))
(text (format nil "~3,'0d" (floor score)) 820 20 100 40)
(when (eq state 'running) (defmethod while-running ((instance flappy-ball))
(with-slots (score state
width ground-level
scroll-x scroll-speed
pipes-width pipes-spacing pipes-amount
ball gravity
high-scores) instance
(setf score (1+ (/ (- scroll-x pipes-width (/ width 10)) pipes-spacing))) (setf score (1+ (/ (- scroll-x pipes-width (/ width 10)) pipes-spacing)))
(setf scroll-x (+ scroll-x scroll-speed)) (setf scroll-x (+ scroll-x scroll-speed))
(setf ball (ball-move ball gravity ground-level)) (setf ball (ball-move ball gravity ground-level))
(when (> (round score) pipes-amount) (when (> (round score) pipes-amount)
(setf state 'won) (setf state 'won)
(setf high-scores (high-scores-add high-scores score)) (setf high-scores (high-scores-add high-scores score))
(save-high-scores "highscores" high-scores))) (save-high-scores "highscores" high-scores))))
)
(defmethod on-death ((instance flappy-ball))
(with-slots (state high-scores score) instance
(setf high-scores (high-scores-add high-scores score))
(save-high-scores "highscores" high-scores)
(setf state 'died)))
(defmethod on-click ((instance flappy-ball) x y) (defmethod on-click ((instance flappy-ball) x y)
(with-slots (ball flap-speed state) instance (with-slots (ball flap-speed state) instance
(setf ball (ball-flap ball flap-speed)) (setf ball (ball-flap ball flap-speed))
(when (eq state 'new) (when (eq state 'new)
(setf state 'running)) (setf state 'running))))
))
(defmethod on-key ((instance flappy-ball) key state) (defmethod on-key ((instance flappy-ball) key state)
(with-slots (ball flap-speed state) instance (with-slots (ball flap-speed state) instance