added highscores

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
 

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)
 

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"))))
 

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)))