diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | chickadee/cli.scm | 1 | ||||
| -rw-r--r-- | chickadee/cli/bundle.scm | 397 | ||||
| -rw-r--r-- | doc/chickadee.texi | 124 |
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 |