pti/flappy-ball
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

added support for packaging with deploy

Browse source
This commit is contained in:
Peter Tillemans 2024-05-03 15:40:55 +02:00
parent cd1420c4a4
commit 4fcd44dd92
3 changed files with 93 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
TODO.org
View file

@ -4,7 +4,7 @@
A flappy bird clone to get experience with Common Lisp and game development.
* Game Plan [13/15]
* Game Plan [14/15]
- [X] Create bird, well, ball
- [X] Add physics for ball movement
- [X] Add inputs on key and mouse clicks
@ -18,7 +18,6 @@ A flappy bird clone to get experience with Common Lisp and game development.
- [X] Create state machine to manage start/play/finish
- [X] Add scores
- [X] Add high scores
- [ ] Package for Mac/Linux/(Windows?)
- [X] Package for Mac/Linux/(Windows?)
- [ ] Create different levels

9
flappy-ball.asd
View file

@ -4,9 +4,14 @@
:serial t
:license "MIT"
:pathname "."
:depends-on ("sketch" "alexandria" "local-time")
:depends-on ("sketch" "alexandria" "local-time" "serapeum")
:components ((:file "flappy-ball"))
:in-order-to ((asdf:test-op (test-op "flappy-ball-test"))))
:in-order-to ((asdf:test-op (test-op "flappy-ball-test")))
:defsystem-depends-on (:deploy)
:build-operation "deploy-op"
:build-pathname "flappy-ball"
:entry-point "flappy-ball:main")
(asdf:defsystem "flappy-ball/test"
:depends-on ("flappy-ball" "fiveam")

119
flappy-ball.lisp
View file

@ -3,7 +3,7 @@
(:export :flappy-ball :on-click :on-key :setup
:make-ball :ball-x :ball-y :ball-velocity :ball-size :ball-move :ball-flap :ball-draw
:make-pipe :pipe-x :pipe-height :pipe-gap :pipe-width :pipe-draw :pipe-collides
:make-high-score :high-score-value :high-score-time))
:make-high-score :high-score-value :high-score-time :main))
(in-package :flappy-ball)
@ -91,35 +91,6 @@
(and (<= (- x bs) bx (+ x w bs))
(not (<= (+ h bs) by (- (+ h gap) bs))))))
;; -------------------------------------------------------------
(defun draw-image-layer(resource scroll-x)
(let ((pic (load-resource resource))
(offset (mod scroll-x 960))
)
(draw (crop pic offset 0 960 540)
:x 0 :y 0 :width 960 :height 540)))
(defun draw-background (scroll-x)
(draw-image-layer "assets/level1/sky.png" 0)
(draw-image-layer "assets/level1/clouds.png" (* -0.15 scroll-x))
(draw-image-layer "assets/level1/far.png" (* 0.25 scroll-x))
(draw-image-layer "assets/level1/middle.png" (* 0.6 scroll-x)))
(defun draw-foreground (pipes scroll-x pipe-pen height)
(dolist (pipe pipes)
(pipe-draw pipe pipe-pen scroll-x height))
(draw-image-layer "assets/level1/ground.png" scroll-x))
(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)
@ -147,8 +118,6 @@
(defun save-high-scores (fname high-scores)
(let ((path (high-scores-path fname)))
(print "Saving high scores")
(print high-scores)
(with-open-file (stream path :direction :output :if-exists :supersede)
(print high-scores stream))))
@ -166,6 +135,59 @@
;; -------------------------------------------------------------
(defparameter *resources* (serapeum:dict)
"Resources for our game
Hash-table with level name => file name => resource.")
(defparameter *asset-folder* (merge-pathnames "assets/"
(asdf:system-source-directory :flappy-ball)))
(defun read-level-assets (level)
(print level)
(let ((level-dict (serapeum:dict))
(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")
for content = (load-resource (namestring (merge-pathnames file folder)))
do (setf (gethash file level-dict) content)
finally (setf (gethash level *resources*) level-dict))))
(defun %read-static-files-in-memory ()
"load all resources for all levels in memory"
(setf *resources* (serapeum:dict))
(loop for level in (list "level1")
do (read-level-assets level)
finally (return *resources*)))
(defun draw-image-layer(level resource scroll-x)
(let ((pic (serapeum:href *resources* level resource))
(offset (mod scroll-x 960)))
(print pic)
(draw (crop pic offset 0 960 540)
:x 0 :y 0 :width 960 :height 540)))
(defun draw-background (level scroll-x)
(draw-image-layer level "sky.png" 0)
(draw-image-layer level "clouds.png" (* -0.15 scroll-x))
(draw-image-layer level "far.png" (* 0.25 scroll-x))
(draw-image-layer level "middle.png" (* 0.6 scroll-x)))
(defun draw-foreground (level pipes scroll-x pipe-pen height)
(dolist (pipe pipes)
(pipe-draw pipe pipe-pen scroll-x height))
(draw-image-layer level "ground.png" scroll-x))
(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)))
)
;; -------------------------------------------------------------
(defsketch flappy-ball
((title "Flappy Ball")
@ -189,10 +211,12 @@
(state 'new)
(score 0)
(high-scores (load-high-scores "highscores"))
(on-exit (lambda () ()))
(level "level1")
)
(draw-background scroll-x)
(draw-foreground pipes scroll-x pipe-pen height)
(draw-background level scroll-x)
(draw-foreground level pipes scroll-x pipe-pen height)
(ball-draw ball
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes)
@ -205,7 +229,7 @@
ball-pen))
(if (>= scroll-x target-x)
(let ((pic (load-resource "assets/level1/prize.png")))
(let ((pic (serapeum:href *resources* level "prize.png")))
(draw pic :x (- (+ 960 target-x) scroll-x) :y 0 )))
(when (eq state 'new)
@ -255,5 +279,30 @@
))
(defmethod setup ((instance flappy-ball) &key &allow-other-keys)
(%read-static-files-in-memory)
(background (gray 1)))
;; override underlying sdl2kit method to intercept closing the window
(defmethod kit.sdl2:close-window :after ((instance flappy-ball))
(with-slots (on-exit) instance
(print "close window called")
(apply on-exit ())))
;; ---------------------------------------------------
(defun main ()
(let ((is_running t))
(print "Starting...")
(make-instance 'flappy-ball :on-exit (lambda () (progn
(print "exiting...")
(setf is_running nil))))
(loop
while is_running
do (sleep 1))))
;; --------------- deploy instructions ---------------------
;; add static resources to the deploy folder
(deploy:define-resource-directory assets (make-pathname :directory '(:relative "assets")))