added support for packaging with deploy

TODO.org

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

flappy-ball.asd

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

flappy-ball.lisp

@@ -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-background level scroll-x)
-  (draw-foreground pipes scroll-x pipe-pen height)
+  (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")))