summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am3
-rw-r--r--chickadee/cli.scm1
-rw-r--r--chickadee/cli/bundle.scm397
-rw-r--r--doc/chickadee.texi124
4 files changed, 524 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am
index aed1535..3f7b7d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -95,7 +95,8 @@ SOURCES = \
chickadee/scripting.scm \
chickadee.scm \
chickadee/cli.scm \
- chickadee/cli/play.scm
+ chickadee/cli/play.scm \
+ chickadee/cli/bundle.scm
TESTS = \
tests/math/vector.scm
diff --git a/chickadee/cli.scm b/chickadee/cli.scm
index 66f2093..2e104fb 100644
--- a/chickadee/cli.scm
+++ b/chickadee/cli.scm
@@ -42,6 +42,7 @@ There is NO WARRANTY, to the extent permitted by law.~%"
Run SUBCOMMAND with ARGS
Valid subcommands:
+* bundle
* play~%")
(exit 1))
diff --git a/chickadee/cli/bundle.scm b/chickadee/cli/bundle.scm
new file mode 100644
index 0000000..a495236
--- /dev/null
+++ b/chickadee/cli/bundle.scm
@@ -0,0 +1,397 @@
+(define-module (chickadee cli bundle)
+ #:declarative? #f
+ #:use-module (chickadee cli)
+ #:use-module (chickadee cli play)
+ #:use-module (chickadee config)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-37)
+ #:use-module (system base compile)
+ #:export (chickadee-bundle
+ %default-config))
+
+(define (regular-file? file-name)
+ (eq? (stat:type (lstat file-name)) 'regular))
+
+(define (scan-for-libraries directories)
+ (map (lambda (dir)
+ (cons dir
+ (scandir dir
+ (lambda (file-name)
+ (and (not (string=? file-name "."))
+ (not (string=? file-name ".."))
+ (regular-file? (string-append dir "/" file-name))
+ (string-contains file-name ".so"))))))
+ directories))
+
+(define (soname lib)
+ (string-append "lib" lib ".so"))
+
+(define (find-lib lib-name libraries)
+ (let ((prefix (soname lib-name)))
+ (let loop ((libraries libraries))
+ (match libraries
+ (() (error "no shared library found for" lib-name))
+ (((dir . files) . rest)
+ (or (let ((file (find (lambda (file-name)
+ (string-prefix? prefix file-name))
+ files)))
+ (and file (string-append dir "/" file)))
+ (loop rest)))))))
+
+(define (find-bin name directories)
+ (let loop ((dirs directories))
+ (match dirs
+ (() (error "cannot find binary" name))
+ ((dir . rest)
+ (or (let ((bin-name (string-append dir "/" name)))
+ (and (file-exists? bin-name) bin-name))
+ (loop rest))))))
+
+(define (library-version-number lib file-name)
+ (string-drop (basename file-name)
+ (string-length (string-append (soname lib) "."))))
+
+(define (copy-lib lib file-name destdir)
+ (define (scope-lib file-name)
+ (string-append destdir "/lib/" file-name))
+ (let* ((so (soname lib))
+ (version (string-split (library-version-number lib file-name) #\.))
+ (base-file-name (basename file-name))
+ (dest-file-name (scope-lib base-file-name)))
+ (format #t "copy ~a → ~a~%"
+ file-name dest-file-name)
+ (copy-file file-name dest-file-name)
+ (format #t "symlink ~a → ~a~%" (scope-lib so) base-file-name)
+ (symlink base-file-name (scope-lib so))
+ ;; Create symlinks for all the possible version number fragments.
+ (for-each (lambda (n)
+ (let ((link-name (scope-lib
+ (string-append so "."
+ (string-join (take version
+ (+ n 1))
+ ".")))))
+ (format #t "symlink ~a → ~a~%" link-name base-file-name)
+ (symlink base-file-name link-name)))
+ (iota (- (length version) 1)))))
+
+(define (root-module)
+ (resolve-module '() #f #f #:ensure #f))
+
+(define (loaded-modules)
+ (define (scan-submodules module)
+ (hash-fold (lambda (k m memo)
+ (if (module-filename m)
+ (cons (module-filename m)
+ (append (scan-submodules m)
+ memo))
+ (append (scan-submodules m) memo)))
+ '()
+ (module-submodules module)))
+ (delete-duplicates (cons* "ice-9/eval.scm"
+ "ice-9/i18n.scm"
+ "ice-9/posix.scm"
+ "ice-9/psyntax-pp.scm"
+ "ice-9/quasisyntax.scm"
+ "ice-9/match.upstream.scm"
+ "ice-9/networking.scm"
+ "ice-9/r6rs-libraries.scm"
+ "ice-9/r7rs-libraries.scm"
+ (scan-submodules (root-module)))
+ string=?))
+
+(define (scm->go file-name)
+ (string-append (substring file-name 0 (- (string-length file-name) 4)) ".go"))
+
+;; Gather up the compiled/source files of all the modules that are
+;; being used right now.
+(define (shake-tree)
+ (map (lambda (f)
+ (list f
+ (search-path %load-path f)
+ (search-path %load-compiled-path (scm->go f))))
+ (sort (loaded-modules) string<)))
+
+;; Snarfed from Guix
+(define (mkdir-p dir)
+ "Create directory DIR and all its ancestors."
+ (define absolute?
+ (string-prefix? "/" dir))
+
+ (define not-slash
+ (char-set-complement (char-set #\/)))
+
+ (let loop ((components (string-tokenize dir not-slash))
+ (root (if absolute?
+ ""
+ ".")))
+ (match components
+ ((head tail ...)
+ (let ((path (string-append root "/" head)))
+ (catch 'system-error
+ (lambda ()
+ (mkdir path)
+ (loop tail path))
+ (lambda args
+ (if (= EEXIST (system-error-errno args))
+ (loop tail path)
+ (apply throw args))))))
+ (() #t))))
+
+;; Also snarfed from Guix, with some simplifications.
+(define* (copy-recursively source destination)
+ (define strip-source
+ (let ((len (string-length source)))
+ (lambda (file)
+ (substring file len))))
+
+ (file-system-fold (const #t) ; enter?
+ (lambda (file stat result) ; leaf
+ (let ((dest (string-append destination
+ (strip-source file))))
+ (format #t "copy ~a → ~a~%" file dest)
+ (case (stat:type stat)
+ ((symlink)
+ (let ((target (readlink file)))
+ (symlink target dest)))
+ (else
+ (copy-file file dest)))))
+ (lambda (dir stat result) ; down
+ (let ((target (string-append destination
+ (strip-source dir))))
+ (mkdir-p target)))
+ (lambda (dir stat result) ; up
+ result)
+ (const #t) ; skip
+ (lambda (file stat errno result)
+ (format (current-error-port) "i/o error: ~a: ~a~%"
+ file (strerror errno))
+ #f)
+ #t
+ source
+ lstat))
+
+;; Once again, snarfed from Guix.
+(define* (delete-file-recursively dir
+ #:key follow-mounts?)
+ (let ((dev (stat:dev (lstat dir))))
+ (file-system-fold (lambda (dir stat result) ; enter?
+ (or follow-mounts?
+ (= dev (stat:dev stat))))
+ (lambda (file stat result) ; leaf
+ (delete-file file))
+ (const #t) ; down
+ (lambda (dir stat result) ; up
+ (rmdir dir))
+ (const #t) ; skip
+ (lambda (file stat errno result)
+ (format (current-error-port)
+ "warning: failed to delete ~a: ~a~%"
+ file (strerror errno)))
+ #t
+ dir
+
+ ;; Don't follow symlinks.
+ lstat)))
+
+(define (shell-escape str)
+ (let ((n (string-length str)))
+ (list->string
+ (cons #\'
+ (let loop ((i 0))
+ (cond
+ ((= i n)
+ '(#\'))
+ ((eqv? (string-ref str i) #\')
+ (cons* #\' #\\ #\' #\'
+ (loop (+ i 1))))
+ (else
+ (cons (string-ref str i)
+ (loop (+ i 1))))))))))
+
+(define (install-modules destdir)
+ (let ((v (string-append (major-version) ".0")))
+ (for-each (match-lambda
+ ((suffix source compiled)
+ (let (;; (scm-dest (string-append destdir "/share/guile/" v "/"
+ ;; suffix))
+ (go-dest (string-append destdir "/lib/guile/" v "/ccache/"
+ (scm->go suffix))))
+ ;; (mkdir-p (dirname scm-dest))
+ (mkdir-p (dirname go-dest))
+ ;;(format #t "copy ~a → ~a~%" source scm-dest)
+ ;;(copy-file source scm-dest)
+ (when compiled
+ (format #t "copy ~a → ~a~%" compiled go-dest)
+ (copy-file compiled go-dest)))))
+ (shake-tree))))
+
+(define (install-libraries destdir names system-libraries)
+ (for-each (lambda (lib)
+ (let ((file-name (find-lib lib system-libraries)))
+ (copy-lib lib file-name destdir)))
+ names))
+
+(define (install-guile destdir directories)
+ (let ((src (find-bin "guile" directories))
+ (dest (string-append destdir "/bin/guile")))
+ (format #t "copy ~a → ~a~%" src dest)
+ (copy-file src dest)))
+
+(define (install-assets dirs destdir)
+ (for-each (lambda (dir)
+ (let ((target (string-append destdir "/" dir)))
+ (copy-recursively dir target)))
+ dirs))
+
+(define (install-chickadee-data destdir)
+ (let ((sharedir (string-append destdir "/share/chickadee")))
+ (mkdir sharedir)
+ (copy-recursively %datadir sharedir)))
+
+(define (install-init.scm code method destdir)
+ (let ((init (string-append destdir "/init.scm")))
+ (format #t "copy ~a → ~a~%" code init)
+ (copy-file code init)
+ (case method
+ ((play)
+ (let ((module (resolve-module '(chickadee-bundler) #f)))
+ (beautify-user-module! module)
+ ;; Need to load all of the default modules for `chickadee play` so
+ ;; that the tree shaker won't miss anything.
+ (for-each (lambda (name)
+ (module-use! module (resolve-interface name)))
+ %default-modules)
+ ;; Compile the main file to load all of the modules that it uses
+ ;; without executing the code.
+ (compile-file init #:env module)))
+ ((manual)
+ (compile-file init)))))
+
+(define (install-launcher name method args destdir)
+ (let ((exe (string-append destdir "/" name))
+ (args (case method
+ ((play)
+ (let ((exp (with-output-to-string
+ (lambda ()
+ (write '(use-modules (chickadee cli play)))
+ (write `(chickadee-play "init.scm" ,@args))))))
+ (string-append "-c " (shell-escape exp))))
+ ((manual)
+ "--no-auto-compile init.scm")
+ (else
+ (error "unsupported launch method" method)))))
+ (format #t "install ~a~%" exe)
+ (call-with-output-file exe
+ (lambda (port)
+ (format port "#!/bin/sh
+
+rootdir=`dirname $(realpath $0)`
+export PATH=\"$rootdir/bin:$PATH\"
+export LD_LIBRARY_PATH=\"$rootdir/lib\"
+export GUILE_LOAD_PATH=\"$rootdir/share/guile/3.0\"
+export GUILE_LOAD_COMPILED_PATH=\"$rootdir/lib/guile/3.0/ccache\"
+export CHICKADEE_DATADIR=\"$rootdir/share/chickadee\"
+cd $rootdir
+exec bin/guile ~a
+" args)))
+ (chmod exe #o755)))
+
+(define %default-config
+ '((asset-directories . ())
+ (binary-directories . ("/usr/bin"))
+ (bundle-name . "chickadee-bundle")
+ (launcher-name . "launch-game")
+ (libraries . ("ffi"
+ "FLAC"
+ "freetype"
+ "gc"
+ "gmp"
+ "guile-3.0"
+ "jbig"
+ "jpeg"
+ "mpg123"
+ "ogg"
+ "openal"
+ "png16"
+ "readline"
+ "SDL2-2.0"
+ "SDL2_image-2.0"
+ "sndfile"
+ "sndio"
+ "tiff"
+ "tinfo"
+ "unistring"
+ "vorbis"
+ "vorbisenc"
+ "vorbisfile"
+ "webp"
+ "z"))
+ (library-directories . ("/lib"
+ "/lib64"
+ "/lib/x86_64-linux-gnu"
+ "/usr/lib"
+ "/usr/lib/x86_64-linux-gnu"))
+ (method . play)
+ (play-args . ())))
+
+(define %tmpdir (or (getenv "TMPDIR") "/tmp"))
+
+(define (make-bundle user-config)
+ (let* ((config (append user-config %default-config))
+ (name (assq-ref config 'bundle-name))
+ (archive (string-append name ".tar.gz"))
+ (args (assq-ref config 'play-args))
+ (assets (assq-ref config 'asset-directories))
+ (bindirs (assq-ref config 'binary-directories))
+ (code (assq-ref config 'code))
+ (tmpdir (mkdtemp (string-append %tmpdir "/chickadee-bundle-XXXXXX")))
+ (destdir (string-append tmpdir "/" name))
+ (launcher (assq-ref config 'launcher-name))
+ (libraries (assq-ref config 'libraries))
+ (libdirs (assq-ref config 'library-directories))
+ (method (assq-ref config 'method)))
+ (mkdir destdir)
+ (mkdir (string-append destdir "/bin"))
+ (mkdir (string-append destdir "/lib"))
+ (mkdir (string-append destdir "/share"))
+ (install-init.scm code method destdir)
+ (install-launcher launcher method args destdir)
+ (install-assets assets destdir)
+ (install-guile destdir bindirs)
+ (install-chickadee-data destdir)
+ (install-libraries destdir libraries (scan-for-libraries libdirs))
+ (install-modules destdir)
+ (format #t "create ~a~%" archive)
+ (unless (zero? (system* "tar" "czf" archive "-C" tmpdir "chickadee-bundle"))
+ (format (current-error-port) "failed to create ~a archive~%" archive)
+ (exit 1))
+ (delete-file-recursively tmpdir)))
+
+(define (display-help-and-exit)
+ (format #t "Usage: chickadee bundle [OPTIONS] [FILE]~%
+Create a redistributable binary tarball using the settings in FILE, or
+'bundle.scm' by default.~%")
+ (display "
+ --help display this help and exit")
+ (newline)
+ (exit 1))
+
+(define %options
+ (list (option '("help") #f #f
+ (lambda (opt name arg result)
+ (display-help-and-exit)))))
+
+(define %default-options '())
+
+(define (chickadee-bundle . args)
+ (let ((opts (simple-args-fold args %options %default-options)))
+ (match (operands opts)
+ (()
+ (make-bundle (primitive-load "bundle.scm")))
+ ((file-name)
+ (make-bundle (primitive-load file-name)))
+ (_
+ (leave "too many arguments specified. just pass a Scheme file name.")))))
diff --git a/doc/chickadee.texi b/doc/chickadee.texi
index 0585688..f561bae 100644
--- a/doc/chickadee.texi
+++ b/doc/chickadee.texi
@@ -182,6 +182,7 @@ line utility to make it easier to get started.
@menu
* Invoking chickadee play:: Run Chickadee programs
+* Invoking chickadee bundle:: Create redistributable binary bundles
@end menu
@node Invoking chickadee play
@@ -279,6 +280,129 @@ REPL server.
@end table
+@node Invoking chickadee bundle
+@section Invoking @command{chickadee bundle}
+
+Distributing games is difficult. While Chickadee games are free
+software, it would be far too burdensome on the player to ask them to
+compile a game from source in order to try it out. Many potential
+players will simply not even try. Players expect to be able to
+download a compressed archive, extract it, and play. If there are any
+more steps than that then the chances of the game being played drop
+dramatically. If you can't beat 'em, join 'em. The
+@command{chickadee bundle} tool creates redistributable binary bundles
+by combining the game code and assets with shared libraries and
+executables from the host operating system.
+
+Bundling is currently only supported on Linux. In the future, it may
+be possible to bundle on MacOS. Patches very much welcome for that.
+
+It should be noted that bundling is a problematic way to distribute
+software. All of the libraries that the bundled application includes
+are separated from the distribution that was so carefully making sure
+that they stay up-to-date with regard to security patches. The
+bundled libraries are frozen in time, vulnerabilities and all.
+Unfortunately, the release model used by the most popular
+distributions, while wonderful for stable, mature software, does not
+fit the needs of game distribution at all. So, we compromise, knowing
+that most games are only played for only a short amount of time before
+being disposed. Perhaps, in time, the Linux world will shift to using
+more robust package management solutions such as
+@url{https://guix.gnu.org, GNU Guix} which support long-term
+maintenance of stable software as well as the ``fire and forget''
+nature of game releases. And maybe a game made with Chickadee will
+become so popular that major distributions decide to package it, but
+let's get back to reality.
+
+To get started with bundling, simply add a @file{bundle.scm} file to
+the root of the project directory. It could look something like this:
+
+@example
+'((asset-directories . ("images" "models"))
+ (bundle-name . "the-legend-of-emacs-1.0")
+ (code . "the-legend-of-emacs.scm")
+ (launcher-name . "the-legend-of-emacs"))
+@end example
+
+To create the bundle, simply run @command{chickadee bundle}. Upon
+success, the file @file{the-legend-of-emacs-1.0.tar.gz} would be
+created in the current directory.
+
+To maximize the chances that the bundle will work on someone else's
+computer, it's best to build on the oldest supported Linux
+distribution available. As of this writing, Ubuntu 18.04 LTS is a
+good choice.
+
+In addition to including system libraries and executables,
+@command{chickadee bundle} also includes the compiled Guile bytecode
+(the @file{.go} files) for all modules used by the game. The module
+source files are @emph{not} included, so it's critical that all of the
+modules used by the game have been compiled.
+
+Available options:
+
+@itemize
+
+@item @code{asset-directories}
+
+A list of directories that hold static game assets such as images or
+audio. Files in these directories will be copied into the bundle
+archive.
+
+@item @code{binary-directories}
+
+A list of directories to search for system binaries, such as
+@command{guile}. By default, @file{/usr/bin} is searched.
+
+@item @code{bundle-name}
+
+The name of the bundle archive. By default, the name is
+@code{"chickadee-bundle"}.
+
+@item @code{launcher-name}
+
+The name of the launcher script. By default, the name is
+@code{"launch-game"}.
+
+@item @code{libraries}
+
+A list of shared libraries to include in the bundle. By default, all
+of the libraries necessary for running Guile, Guile-SDL2, and
+Chickadee are included. This list is compatible with the names given
+to the libraries on Ubuntu, which may be different than on other
+distributions. In such cases, this list will need to be customized.
+See below for more information on the @code{%default-config} variable
+that can be of help.
+
+@item @code{library-directories}
+
+A list of directories to search for system shared libraries. By
+default, the list contains common directories used by most
+distributions.
+
+@item @code{method}
+
+The method by which the game is launched. Can be either @code{play}
+or @code{manual}. The default is @code{play}, which means that
+@command{chickadee play} will be used to launch the game. For games
+that do not use @command{chickadee play}, opting to start the game
+loop on their own, the @code{manual} method should be used.
+
+@item @code{play-args}
+
+A list of command line arguments to pass to @command{chickadee play}.
+Only used when the @code{method} option is set to @code{play}.
+
+@end itemize
+
+Default configuration options, such as the list of C shared libaries,
+can be found in the @code{%default-config} variable. This way they
+can be programatically modified, if necessary.
+
+@defvar %default-config
+An association list of default configuration options.
+@end defvar
+
@node Live Coding
@chapter Live Coding