added highscores

This commit is contained in:
Peter Tillemans 2024-05-03 01:31:27 +02:00
parent 52b6640c99
commit 0b37163e62
4 changed files with 73 additions and 12 deletions

View file

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

View file

@ -29,5 +29,11 @@
(is (= (pipe-gap pipe) 100))
(is (= (pipe-width pipe) 20))))
(test test-high-score
(let ((high-score (make-high-score 10 (get-universal-time))))
(is (= (high-score-value high-score) 10))
(is (< (- (get-universal-time) (high-score-time high-score)) 1))))
(run-all-tests)

View file

@ -4,7 +4,7 @@
:serial t
:license "MIT"
:pathname "."
:depends-on ("sketch" "alexandria")
:depends-on ("sketch" "alexandria" "local-time")
:components ((:file "flappy-ball"))
:in-order-to ((asdf:test-op (test-op "flappy-ball-test"))))

View file

@ -2,7 +2,8 @@
(:use :cl :sketch)
(: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-pipe :pipe-x :pipe-height :pipe-gap :pipe-width :pipe-draw :pipe-collides
:make-high-score :high-score-value :high-score-time))
(in-package :flappy-ball)
@ -121,6 +122,50 @@
;; -------------------------------------------------------------
(defun make-high-score (score time)
(cons score time))
(defun high-score-value (high-score)
(car high-score))
(defun high-score-time (high-score)
(cdr high-score))
(defun high-scores-path (fname)
(let* ((folder (or (uiop:getenv "XDG_DATA_HOME")
(merge-pathnames (make-pathname :directory '(:relative ".local" "share" "flappy-ball")) (user-homedir-pathname))))
(path (merge-pathnames (make-pathname :name fname :type "txt") folder)))
(ensure-directories-exist path)
path))
(defun load-high-scores (fname)
(let ((path (high-scores-path fname)))
(if (probe-file path)
(with-open-file (stream path :direction :input)
(read stream))
nil)))
(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))))
(defun high-score-betterp (a b)
(or (> (high-score-value a) (high-score-value b))
(and (= (high-score-value a) (high-score-value b))
(< (high-score-time a) (high-score-time b)))))
(defun high-scores-add (high-scores score)
(let* ((hs (make-high-score (floor score) (get-universal-time)))
(new-scores (sort (append high-scores (list hs)) #'high-score-betterp)))
(if (< (length new-scores) 10)
new-scores
(subseq new-scores 0 10))))
;; -------------------------------------------------------------
(defsketch flappy-ball
((title "Flappy Ball")
@ -142,7 +187,9 @@
(scroll-speed 0.2)
(target-x (- (* pipes-amount pipes-spacing) 720))
(state 'new)
(score 0))
(score 0)
(high-scores (load-high-scores "highscores"))
)
(draw-background scroll-x)
(draw-foreground pipes scroll-x pipe-pen height)
@ -151,6 +198,8 @@
(if (some (lambda (pipe) (pipe-collides pipe ball scroll-x)) pipes)
(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))
@ -161,7 +210,12 @@
(when (eq state 'new)
(setf scroll-x 0.0)
(text "Click to Start" 350 250 200 40))
(text "Click to Start" 50 250 200 40)
(loop for (score . time) in high-scores
for i from 0
do (text (format nil "~3,'0d" (floor score)) 300 (+ 30 (* i 40)) 80 30)
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 'won)
(text "You Won" 380 100 160 60)
(text "Return to Restart" 300 150 320 40)
@ -177,7 +231,9 @@
(setf scroll-x (+ scroll-x scroll-speed))
(setf ball (ball-move ball gravity ground-level))
(when (> (round score) pipes-amount)
(setf state 'won)))
(setf state 'won)
(setf high-scores (high-scores-add high-scores score))
(save-high-scores "highscores" high-scores)))
)
(defmethod on-click ((instance flappy-ball) x y)
@ -190,8 +246,7 @@
(defmethod on-key ((instance flappy-ball) key state)
(with-slots (ball flap-speed state) instance
(setf ball (ball-flap ball flap-speed))
(print key)
(when (and (eq state 'new) (not (eq key :RETURN))
(when (and (eq state 'new) (not (eq key :RETURN)))
(setf state 'running))
(when (and (eq state 'died) (eq key :RETURN))
(setf state 'new))