From 0b37163e6250bbba9223bedc43d1849ecccc33ba Mon Sep 17 00:00:00 2001 From: Peter Tillemans Date: Fri, 3 May 2024 01:31:27 +0200 Subject: [PATCH] added highscores --- TODO.org | 4 +-- flappy-ball-test.lisp | 6 ++++ flappy-ball.asd | 2 +- flappy-ball.lisp | 73 +++++++++++++++++++++++++++++++++++++------ 4 files changed, 73 insertions(+), 12 deletions(-) diff --git a/TODO.org b/TODO.org index 73d2d57..b1c905a 100644 --- a/TODO.org +++ b/TODO.org @@ -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 diff --git a/flappy-ball-test.lisp b/flappy-ball-test.lisp index e729b90..523782d 100644 --- a/flappy-ball-test.lisp +++ b/flappy-ball-test.lisp @@ -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) diff --git a/flappy-ball.asd b/flappy-ball.asd index 05eaf93..60a5584 100644 --- a/flappy-ball.asd +++ b/flappy-ball.asd @@ -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")))) diff --git a/flappy-ball.lisp b/flappy-ball.lisp index bc6ba3f..5be6b2d 100644 --- a/flappy-ball.lisp +++ b/flappy-ball.lisp @@ -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,15 +246,14 @@ (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)) - (setf state 'running)) + (when (and (eq state 'new) (not (eq key :RETURN))) + (setf state 'running)) (when (and (eq state 'died) (eq key :RETURN)) (setf state 'new)) (when (and (eq state 'won) (eq key :RETURN)) (setf state 'new)) )) - (defmethod setup ((instance flappy-ball) &key &allow-other-keys) - (background (gray 1))) +(defmethod setup ((instance flappy-ball) &key &allow-other-keys) + (background (gray 1)))