Merge pull request #1 from commonlispbr/make-portable

Make StarWar game more portable at sbcl-wise / Linux system

Author: ryukinix

.gitignore

@@ -0,0 +1,4 @@
+system-index.txt
+release/
+*.tar*
+*.fasl

Makefile

@@ -0,0 +1,10 @@
+build:
+	rm -rf release/
+	mkdir -p release
+	sbcl --load build.lisp
+	mv starwar-linux release/
+	cp starwar.conf release/
+	cp background.mp3 release/
+	mv lib/ release/
+	cp StarWar.desktop release/
+	sed -i 's/starwar.lisp/starwar-linux/g' release/StarWar.desktop

StarWar.desktop

@@ -0,0 +1,9 @@
+[Desktop Entry]
+Version=1.0
+Type=Application
+Name=StarWar
+Comment=A survival and dominance starwar game
+Exec=./starwar.lisp
+Icon=gcstar
+Terminal=false
+StartupNotify=false

build.lisp

@@ -0,0 +1,4 @@
+(ql:quickload :starwar)
+(in-package :starwar)
+(setq *compression* 1)
+(make-binary)

src/globals.lisp

@@ -86,12 +86,15 @@ generateing the map. ")
 (defparameter planet-core-radius 3)
 (defparameter star-max-amount 1000)
 
-(defparameter screen-rightmost (- world-rightmost screen-width))
-(defparameter screen-bottommost (- world-bottommost screen-height))
-(defparameter world-width (- world-rightmost world-leftmost))
-(defparameter world-height (- world-bottommost world-topmost))
-(defparameter margin-bottom (- screen-height 10))
-(defparameter margin-right (- screen-width 10))
+(defun load-world-limits ()
+  (defparameter screen-rightmost (- world-rightmost screen-width))
+  (defparameter screen-bottommost (- world-bottommost screen-height))
+  (defparameter world-width (- world-rightmost world-leftmost))
+  (defparameter world-height (- world-bottommost world-topmost))
+  (defparameter margin-bottom (- screen-height 10))
+  (defparameter margin-right (- screen-width 10)))
+
+(load-world-limits)
 
 (defun generate-bg-stars (n)
   "generate N bg stars and return list"
@@ -104,7 +107,7 @@ generateing the map. ")
   "read one file and load all the parameters"
   ;; here, we MUST make sure that we are in the RIGHT package (that is the
   ;; starwar package. or the parameters will not be set!
-  (with-open-file (s filename)
+  (with-open-file (s (portable-pathname filename))
     (do ((form (read s) (read s nil 'eof)))
 	((eq form 'eof) nil)
       (if (not (= (length form) 2))
@@ -196,10 +199,4 @@ INIT-AMOUNT is how many planets one player own at the beginning of game"
 
   ;; load all the configure file
   (load-file-set-parameters "starwar.conf")
-
-  (setq screen-rightmost (- world-rightmost screen-width))
-  (setq screen-bottommost (- world-bottommost screen-height))
-  (setq world-width (- world-rightmost world-leftmost))
-  (setq world-height (- world-bottommost world-topmost))
-  (setq margin-bottom (- screen-height 10))
-  (setq margin-right (- screen-width 10)))
+  (load-world-limits))

src/make-binary.lisp

@@ -3,8 +3,61 @@
 
 (in-package :starwar)
 
+(defparameter *compression* 9)
+(defparameter *libprefix* "lib/")
+(defvar *libraries* nil)
+
+(defun libpath (prefix)
+  (merge-pathnames prefix (uiop/os:getcwd)))
+
+(defun get-libraries-names (&key (loaded-only t))
+  (remove-duplicates
+   (mapcar #'cffi:foreign-library-pathname
+           (cffi:list-foreign-libraries :loaded-only loaded-only))))
+
+(defun get-libraries (&optional (from "/lib/"))
+  (loop for l in (get-libraries-names)
+        for lfrom = (merge-pathnames l from)
+        for lpath = (probe-file lfrom)
+        when lpath
+          collect lfrom))
+
+(defun dump-libraries (&optional (to *libprefix*))
+  (format t "~%LIBPATH: ~a~%" (libpath to))
+  (ensure-directories-exist (libpath to))
+  (let ((libs (get-libraries)))
+    (setq *libraries* (get-libraries-names))
+    (loop for lib in (get-libraries)
+          do (sb-ext:run-program "/bin/cp"
+                                 (list "-v"
+                                       (namestring lib)
+                                       (namestring (libpath to)))
+                                 :output *standard-output*))))
+
+(defun load-library (library-name)
+  (cffi:load-foreign-library library-name))
+
+(defun import-libraries (&optional (libpath *libprefix*))
+  (pushnew libpath
+           cffi:*foreign-library-directories*
+           :test #'equal)
+  (loop for l in *libraries*
+        do (load-library l)))
+
+(defun close-libraries ()
+  (loop for library in (cffi:list-foreign-libraries :loaded-only t)
+        do (cffi:close-foreign-library library)))
+
+(defun main-wrapper ()
+  (import-libraries)
+  (starwar:main))
+
+
 (defun make-binary ()
+  (dump-libraries)  ;; put all libraries into /lib
+  (close-libraries) ;; close currently open libraries
   (sb-ext:save-lisp-and-die #+unix "starwar-linux"
                             #+win32 "starwar-win32.exe"
-                            :toplevel #'starwar:main
-                            :executable t))
+                            :toplevel #'main-wrapper
+                            :executable t
+                            :compression *compression*))

src/packages.lisp

@@ -2,4 +2,4 @@
 (defpackage :starwar
   (:use :cl :starwar-lib)
   (:documentation "this is the star war game!")
-  (:export :main :run :make-binary))
+  (:export :main :run :make-binary :fullscreen))

src/path.lisp

@@ -0,0 +1,7 @@
+(in-package :starwar)
+
+(defun portable-pathname (pathname &optional (system 'starwar))
+  "PORTABLE-PATHNAME consider two possible dirnames: local and system-wide."
+  (if (probe-file pathname)
+      pathname
+      (asdf:system-relative-pathname system pathname)))

src/starwar.lisp

@@ -77,13 +77,20 @@
         (setq speed star-speed-max))
     (setq star-speed speed))
   (setq *news* (format nil "Increase speed to ~ax" star-speed)))
+
 (defun decrease-star-speed ()
   (let ((speed (- star-speed 0.5)))
     (if (< speed star-speed-min)
         (setq speed star-speed-min))
     (setq star-speed speed))
   (setq *news* (format nil "Decrease speed to ~ax" star-speed)))
 
+(defun toggle-fullscreen ()
+  (if fullscreen
+      (sdl:resize-window screen-width screen-height :sw t :resizable t)
+      (sdl:resize-window screen-width screen-height :sw t :fullscreen t))
+  (setf fullscreen (not fullscreen)))
+
 (defun handle-key (key)
   (case key
     (:sdl-key-escape
@@ -94,6 +101,8 @@
      (set-game-running *paused*))
     (:sdl-key-r
      (clear-global-vars))
+    (:sdl-key-f11
+     (toggle-fullscreen))
     (:sdl-key-minus
      (decrease-star-speed))
     (:sdl-key-equals
@@ -103,6 +112,8 @@
        (clear-global-vars)
        (set-game-running t)))))
 
+
+
 ;; draw the information line by line
 (defun draw-information (&rest infos)
   (let ((x 10)
@@ -119,6 +130,7 @@
     (:up (decf *screen-pos-y* scroll-speed))
     (:down (incf *screen-pos-y* scroll-speed))
     (otherwise (error "unknown direction!"))))
+
 (defun fix-screen-pos-overflow ()
   (when (> *screen-pos-x* screen-rightmost)
     (setq *screen-pos-x* screen-rightmost))
@@ -128,6 +140,7 @@
     (setq *screen-pos-y* screen-bottommost))
   (when (< *screen-pos-y* screen-topmost)
     (setq *screen-pos-y* screen-topmost)))
+
 (defun move-screen-on-worldmap ()
   (let ((x (sdl:mouse-x)) (y (sdl:mouse-y)))
     (when (or (<= x margin-left)
@@ -264,12 +277,13 @@ the outter rect. the rect is filled by VALUE/FULL-VALUE"
     (format t "fullscreen: ~a~%" fullscreen)
     (sdl:window screen-width screen-height
                 :fullscreen fullscreen
+                :resizable t
                 :title-caption "Star War"
                 :icon-caption "Star War")
     (set-game-running t)
     ;; music background
     (sdl-mixer:open-audio)
-    (let ((music (sdl-mixer:load-music "background.mp3")))
+    (let ((music (sdl-mixer:load-music (portable-pathname "background.mp3"))))
       (sdl-mixer:play-music music :loop t)
       (sdl:with-events ()
         (:quit-event () (sdl-mixer:Halt-Music)
@@ -284,6 +298,12 @@ the outter rect. the rect is filled by VALUE/FULL-VALUE"
                                   (handle-mouse-button button x y t))
         (:mouse-button-up-event (:button button :x x :y y)
                                 (handle-mouse-button button x y nil))
+
+        (:video-resize-event (:w w :h h)
+                             (setq screen-width w)
+                             (setq screen-height h)
+                             (sdl:resize-window w h)
+                             (load-world-limits))
         (:idle ()
                (unless *game-over*
                  (sdl:clear-display bg-color)

starwar-lib.asd

@@ -6,7 +6,7 @@
 (defsystem starwar-lib
   :name "starwar-lib"
   :author "Peter Xu"
-  :version "0.0.1"
+  :version "0.1.0"
   :licence "MIT"
   :description "Some basic functions related to game"
   :pathname "src/lib/"

starwar.asd

@@ -6,18 +6,20 @@
 (defsystem starwar
   :name "starwar"
   :author "xzpeter"
-  :version "0.0.1"
+  :version "0.2.0"
   :license "MIT"
   :description "A very simple starwar game."
   :depends-on (:lispbuilder-sdl
 	       	   :lispbuilder-sdl-ttf
 	           :lispbuilder-sdl-gfx
 	           :lispbuilder-sdl-mixer
+               :cffi
 	           :starwar-lib)
   :pathname "src"
   :components ((:file "packages")
+               (:file "path")
                (:file "make-binary")
-               (:file "globals" :depends-on ("packages"))
+               (:file "globals" :depends-on ("packages" "path"))
                (:file "hittable-circle" :depends-on ("packages"))
                (:file "classes" :depends-on ("packages"
                                              "hittable-circle"))
@@ -34,6 +36,7 @@
                                             "classes"
                                             "globals"))
                (:file "starwar" :depends-on ("packages"
+                                             "path"
                                              "globals"
                                              "hittable-circle"
                                              "star"

starwar.conf

@@ -1,8 +1,8 @@
 ;; configuration file for starwar game
 
 (fullscreen		    nil)
-(screen-width		1200)
-(screen-height		800)
+(screen-width		800)
+(screen-height		600)
 
 (star-speed-max		3.0)
 (star-speed-min		0.5)

starwar.lisp

@@ -0,0 +1,20 @@
+#!/bin/sbcl --script
+
+
+;; load quicklisp setup
+(let ((sbclrc "~/.sbclrc"))
+  (when (probe-file sbclrc)
+    (load sbclrc)))
+
+(eval-when (:execute)
+  (pushnew (truename (sb-unix:posix-getcwd/))
+           ql:*local-project-directories*)
+  (ql:register-local-projects)
+  (ql:quickload :starwar))
+
+(defun main ()
+  (defparameter starwar:fullscreen t)
+  (starwar:main))
+
+(eval-when (:execute)
+  (main))