summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--starling/asset.scm200
-rw-r--r--starling/inotify.scm217
-rw-r--r--starling/kernel.scm6
-rw-r--r--starling/node-2d.scm9
5 files changed, 428 insertions, 6 deletions
diff --git a/Makefile.am b/Makefile.am
index 49313d9..108173a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -38,6 +38,8 @@ moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
SOURCES = \
+ starling/inotify.scm \
+ starling/asset.scm \
starling/node.scm \
starling/node-2d.scm \
starling/repl.scm \
diff --git a/starling/asset.scm b/starling/asset.scm
new file mode 100644
index 0000000..a14a050
--- /dev/null
+++ b/starling/asset.scm
@@ -0,0 +1,200 @@
+;;; Starling Game Engine
+;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Starling. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Abstraction for loading game data from the file system, including
+;; automatically reloading the data when it changes.
+;;
+;;; Code:
+
+(define-module (starling asset)
+ #:use-module (ice-9 ftw)
+ #:use-module (ice-9 match)
+ #:use-module (oop goops)
+ #:use-module (srfi srfi-1)
+ #:use-module (starling inotify)
+ #:export (<asset>
+ artifact
+ file-name
+ loader
+ args
+ watch-assets
+ watching-assets?
+ watch-asset-directory
+ reload-modified-assets
+ clear-asset-cache
+ asset-ref
+ define-asset))
+
+(define-class <asset> ()
+ (watch? #:allocation #:class #:init-form #f)
+ ;; class slots for asset cache and live reloading
+ (inotify #:allocation #:class #:init-form #f)
+ ;; file-name -> assets mapping
+ (asset-file-map #:allocation #:class #:init-form (make-hash-table))
+ ;; args -> artifact mapping
+ (artifact-cache #:allocation #:class #:init-form (make-weak-value-hash-table))
+ ;; asset -> artifact mapping
+ (asset-artifact-map #:allocation #:class #:init-form (make-weak-key-hash-table))
+ (watches #:allocation #:class #:init-form '())
+ ;; instance slots
+ (file-name #:getter file-name #:init-keyword #:file-name)
+ (loader #:getter loader #:init-keyword #:loader)
+ (loader-args #:getter loader-args #:init-form '()
+ #:init-keyword #:loader-args))
+
+(define (absolute-file-name file-name)
+ (if (absolute-file-name? file-name)
+ file-name
+ (string-append (getcwd) "/" file-name)))
+
+(define-method (initialize (asset <asset>) initargs)
+ (next-method)
+ ;; Convert file name to an absolute file name.
+ (slot-set! asset 'file-name (absolute-file-name (file-name asset)))
+ ;; Add asset to the file-name -> asset map
+ (let* ((asset-file-map (class-slot-ref <asset> 'asset-file-map))
+ ;; Using a weak key hash table instead of a list to keep
+ ;; track of all the assets that are associated with a file.
+ ;; This way, their presence in the cache won't save them from
+ ;; the GC.
+ (sub-table (or (hash-ref asset-file-map (file-name asset))
+ (let ((wt (make-weak-key-hash-table)))
+ (hash-set! asset-file-map (file-name asset) wt)
+ wt))))
+ (hash-set! sub-table asset asset)))
+
+(define (asset-inotify)
+ (class-slot-ref <asset> 'inotify))
+
+(define (asset-file-map)
+ (class-slot-ref <asset> 'asset-file-map))
+
+(define (artifact-cache)
+ (class-slot-ref <asset> 'artifact-cache))
+
+(define (asset-artifact-map)
+ (class-slot-ref <asset> 'asset-artifact-map))
+
+(define (asset-watches)
+ (class-slot-ref <asset> 'watches))
+
+(define (watch-assets watch?)
+ (let ((old-watch? (watching-assets?)))
+ (class-slot-set! <asset> 'watch? watch?)
+ (cond
+ ;; Watching is being turned on.
+ ((and watch? (not old-watch?))
+ ;; Retroactively add watches for all existing assets.
+ (hash-for-each (lambda (file-name assets)
+ (watch-asset-directory (dirname file-name)))
+ (asset-file-map)))
+ ;; Watching is being turned off.
+ ((and (not watch?) old-watch?)
+ ;; Deactive inotify watches.
+ (for-each inotify-watch-remove! (inotify-watches (asset-inotify)))))))
+
+(define (watching-assets?)
+ (class-slot-ref <asset> 'watch?))
+
+(define (directory-watched? dir)
+ (find (lambda (watch)
+ (string=? (inotify-watch-file-name watch) dir))
+ (asset-watches)))
+
+(define (watch-asset-directory dir)
+ ;; Lazily activate inotify.
+ (unless (asset-inotify)
+ (class-slot-set! <asset> 'inotify (make-inotify)))
+ ;; Add watch if it doesn't already exist.
+ (unless (directory-watched? dir)
+ (class-slot-set! <asset> 'watches
+ (cons (inotify-add-watch! (asset-inotify)
+ dir
+ '(create close-write moved-to))
+ (asset-watches)))))
+
+(define (reload-modified-assets)
+ (let ((inotify (asset-inotify)))
+ (when inotify
+ (while (inotify-pending-events? inotify)
+ (let* ((event (inotify-read-event inotify))
+ (type (inotify-event-type event))
+ (file-name (string-append (inotify-watch-file-name
+ (inotify-event-watch event))
+ "/"
+ (inotify-event-file-name event)))
+ (assets (hash-ref (asset-file-map) file-name)))
+ (cond
+ ((and assets (or (eq? type 'close-write) (eq? type 'moved-to)))
+ ;; Expire everything from cache, then reload.
+ (hash-for-each (lambda (key asset)
+ (expire-cached-artifact (cache-key asset)))
+ assets)
+ (hash-for-each (lambda (key asset)
+ (load! asset))
+ assets))))))))
+
+(define (cache-key asset)
+ (list (loader asset) (file-name asset) (loader-args asset)))
+
+(define (cache-artifact key artifact)
+ (hash-set! (artifact-cache) key artifact))
+
+(define (expire-cached-artifact key)
+ (hash-remove! (artifact-cache) key))
+
+(define (clear-asset-cache)
+ (hash-clear! (artifact-cache))
+ (hash-clear! (asset-artifact-map)))
+
+(define (fetch-cached-artifact key)
+ (hash-ref (artifact-cache) key))
+
+(define (load-artifact cache-key loader file-name loader-args add-watch?)
+ (or (fetch-cached-artifact cache-key)
+ (let ((artifact (apply loader file-name loader-args)))
+ (cache-artifact cache-key artifact)
+ (when (and add-watch? (watching-assets?))
+ (watch-asset-directory (dirname file-name)))
+ artifact)))
+
+(define* (load! asset #:optional add-watch?)
+ (let ((thing (load-artifact (cache-key asset)
+ (loader asset)
+ (file-name asset)
+ (loader-args asset)
+ add-watch?)))
+ (hashq-set! (asset-artifact-map) asset thing)
+ thing))
+
+(define-method (asset-ref (asset <asset>))
+ ;; Assets are lazy-loaded upon first access.
+ (or (hashq-ref (asset-artifact-map) asset)
+ (load! asset #t)))
+
+;; Make assets that are outside of the cache "just work".
+(define-method (asset-ref x) x)
+
+;; Handy syntax for defining new assets.
+(define-syntax-rule (define-asset name
+ (loader file-name loader-args ...))
+ (define name
+ (make <asset>
+ #:file-name file-name
+ #:loader loader
+ #:loader-args (list loader-args ...))))
diff --git a/starling/inotify.scm b/starling/inotify.scm
new file mode 100644
index 0000000..0483ec6
--- /dev/null
+++ b/starling/inotify.scm
@@ -0,0 +1,217 @@
+;;; Starling Game Engine
+;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Starling. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Inotify bindings.
+;;
+;;; Code:
+
+(define-module (starling inotify)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (system foreign)
+ #:export (make-inotify
+ inotify?
+ inotify-watches
+ inotify-add-watch!
+ inotify-pending-events?
+ inotify-read-event
+ inotify-watch?
+ inotify-watch-id
+ inotify-watch-file-name
+ inotify-watch-remove!
+ inotify-event?
+ inotify-event-watch
+ inotify-event-type
+ inotify-event-cookie
+ inotify-event-file-name))
+
+(define libc (dynamic-link))
+
+(define inotify-init
+ (pointer->procedure int (dynamic-func "inotify_init" libc) '()))
+
+(define inotify-add-watch
+ (pointer->procedure int (dynamic-func "inotify_add_watch" libc)
+ (list int '* uint32)))
+
+(define inotify-rm-watch
+ (pointer->procedure int (dynamic-func "inotify_rm_watch" libc)
+ (list int int)))
+
+(define IN_ACCESS #x00000001) ; file was accessed.
+(define IN_MODIFY #x00000002) ; file was modified.
+(define IN_ATTRIB #x00000004) ; metadata changed
+(define IN_CLOSE_WRITE #x00000008) ; file opened for writing closed
+(define IN_CLOSE_NOWRITE #x00000010) ; file not opened for writing closed
+(define IN_OPEN #x00000020) ; file was opened
+(define IN_MOVED_FROM #x00000040) ; file was moved from X
+(define IN_MOVED_TO #x00000080) ; file was moved to Y
+(define IN_CREATE #x00000100) ; subfile was created
+(define IN_DELETE #x00000200) ; subfile was deleted
+(define IN_DELETE_SELF #x00000400) ; self was deleted
+(define IN_MOVE_SELF #x00000800) ; self was moved
+;; Kernel flags
+(define IN_UNMOUNT #x00002000) ; backing fs was unmounted
+(define IN_Q_OVERFLOW #x00004000) ; event queue overflowed
+(define IN_IGNORED #x00008000) ; file was ignored
+;; Special flags
+(define IN_ONLYDIR #x01000000) ; only watch if directory
+(define IN_DONT_FOLLOW #x02000000) ; do not follow symlink
+(define IN_EXCL_UNLINK #x04000000) ; exclude events on unlinked objects
+(define IN_MASK_ADD #x20000000) ; add to the mask of an existing watch
+(define IN_ISDIR #x40000000) ; event occurred against directory
+(define IN_ONESHOT #x80000000) ; only send event once
+
+(define mask/symbol (make-hash-table))
+(define symbol/mask (make-hash-table))
+
+(for-each (match-lambda
+ ((sym mask)
+ (hashq-set! symbol/mask sym mask)
+ (hashv-set! mask/symbol mask sym)))
+ `((access ,IN_ACCESS)
+ (modify ,IN_MODIFY)
+ (attrib ,IN_ATTRIB)
+ (close-write ,IN_CLOSE_WRITE)
+ (close-no-write ,IN_CLOSE_NOWRITE)
+ (open ,IN_OPEN)
+ (moved-from ,IN_MOVED_FROM)
+ (moved-to ,IN_MOVED_TO)
+ (create ,IN_CREATE)
+ (delete ,IN_DELETE)
+ (delete-self ,IN_DELETE_SELF)
+ (move-self ,IN_MOVE_SELF)
+ (only-dir ,IN_ONLYDIR)
+ (dont-follow ,IN_DONT_FOLLOW)
+ (exclude-unlink ,IN_EXCL_UNLINK)
+ (is-directory ,IN_ISDIR)
+ (once ,IN_ONESHOT)))
+
+(define (symbol->mask sym)
+ (hashq-ref symbol/mask sym))
+
+(define (mask->symbol sym)
+ (hashq-ref mask/symbol sym))
+
+(define-record-type <inotify>
+ (%make-inotify port buffer buffer-pointer watches)
+ inotify?
+ (port inotify-port)
+ (buffer inotify-buffer)
+ (buffer-pointer inotify-buffer-pointer)
+ (watches inotify-watches))
+
+(define-record-type <inotify-watch>
+ (make-inotify-watch id file-name owner)
+ inotify-watch?
+ (id inotify-watch-id)
+ (file-name inotify-watch-file-name)
+ (owner inotify-watch-owner))
+
+(define-record-type <inotify-event>
+ (make-inotify-event watch type cookie file-name)
+ inotify-event?
+ (watch inotify-event-watch)
+ (type inotify-event-type)
+ (cookie inotify-event-cookie)
+ (file-name inotify-event-file-name))
+
+(define (display-inotify inotify port)
+ (format port "#<inotify port: ~a>" (inotify-port inotify)))
+
+(define (display-inotify-watch watch port)
+ (format port "#<inotify-watch id: ~d file-name: ~a>"
+ (inotify-watch-id watch)
+ (inotify-watch-file-name watch)))
+
+(define (display-inotify-event event port)
+ (format port "#<inotify-event type: ~s cookie: ~d file-name: ~a watch: ~a>"
+ (inotify-event-type event)
+ (inotify-event-cookie event)
+ (inotify-event-file-name event)
+ (inotify-event-watch event)))
+
+(set-record-type-printer! <inotify> display-inotify)
+(set-record-type-printer! <inotify-watch> display-inotify-watch)
+(set-record-type-printer! <inotify-event> display-inotify-event)
+
+(define (make-inotify)
+ (let ((fd (inotify-init))
+ (buffer (make-bytevector 4096)))
+ (%make-inotify (fdopen fd "r")
+ buffer
+ (bytevector->pointer buffer)
+ (make-hash-table))))
+
+(define (inotify-fd inotify)
+ (port->fdes (inotify-port inotify)))
+
+(define (absolute-file-name file-name)
+ (if (absolute-file-name? file-name)
+ file-name
+ (string-append (getcwd) "/" file-name)))
+
+(define (inotify-add-watch! inotify file-name modes)
+ (let* ((abs-file-name (absolute-file-name file-name))
+ (wd (inotify-add-watch (inotify-fd inotify)
+ (string->pointer abs-file-name)
+ (apply logior (map symbol->mask modes))))
+ (watch (make-inotify-watch wd abs-file-name inotify)))
+ (hashv-set! (inotify-watches inotify) wd watch)
+ watch))
+
+(define (inotify-watch-remove! watch)
+ (inotify-rm-watch (inotify-fd (inotify-watch-owner watch))
+ (inotify-watch-id watch))
+ (hashv-remove! (inotify-watches (inotify-watch-owner watch))
+ (inotify-watch-id watch)))
+
+(define (inotify-pending-events? inotify)
+ ;; Sometimes an interrupt happens during the char-ready? call and an
+ ;; exception is thrown. Just return #f in that case and move on
+ ;; with life.
+ (false-if-exception (char-ready? (inotify-port inotify))))
+
+(define (read-int port buffer)
+ (get-bytevector-n! port buffer 0 (sizeof int))
+ (bytevector-sint-ref buffer 0 (native-endianness) (sizeof int)))
+
+(define (read-uint32 port buffer)
+ (get-bytevector-n! port buffer 0 (sizeof uint32))
+ (bytevector-uint-ref buffer 0 (native-endianness) (sizeof uint32)))
+
+(define (read-string port buffer buffer-pointer length)
+ (and (> length 0)
+ (begin
+ (get-bytevector-n! port buffer 0 length)
+ (pointer->string buffer-pointer))))
+
+(define (inotify-read-event inotify)
+ (let* ((port (inotify-port inotify))
+ (buffer (inotify-buffer inotify))
+ (wd (read-int port buffer))
+ (event-mask (read-uint32 port buffer))
+ (cookie (read-uint32 port buffer))
+ (len (read-uint32 port buffer))
+ (name (read-string port buffer (inotify-buffer-pointer inotify) len)))
+ (make-inotify-event (hashv-ref (inotify-watches inotify) wd)
+ (mask->symbol event-mask) cookie name)))
diff --git a/starling/kernel.scm b/starling/kernel.scm
index 2e51712..9c23448 100644
--- a/starling/kernel.scm
+++ b/starling/kernel.scm
@@ -36,6 +36,7 @@
#:use-module (sdl2 input text)
#:use-module (sdl2 mixer)
#:use-module (sdl2 video)
+ #:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling repl)
#:use-module (system repl command)
@@ -144,6 +145,9 @@
(define-method (on-boot (kernel <kernel>))
(when (developer-mode? kernel)
+ ;; Enable live asset reloading.
+ (watch-assets #t)
+ ;; Start REPL server.
(attach-to kernel (make <repl> #:name 'repl #:rank 9999))))
(define-method (update* (kernel <kernel>) dt)
@@ -237,6 +241,8 @@
(next-method))
(define-method (update (kernel <kernel>) dt)
+ (when (developer-mode? kernel)
+ (reload-modified-assets))
;; Free any GPU resources that have been GC'd.
(gpu-reap!))
diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 293b227..39a5aa7 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -34,6 +34,7 @@
#:use-module (chickadee render viewport)
#:use-module (chickadee scripting)
#:use-module (oop goops)
+ #:use-module (starling asset)
#:use-module (starling node)
#:export (<camera-2d>
target
@@ -335,9 +336,6 @@
(define-method (activate (node <node-2d>))
(set! (dirty-matrix? node) #t))
-;; TODO: Add live asset reload
-(define-method (asset-ref x) x)
-
;;;
;;; Static Sprite
@@ -347,9 +345,8 @@
(texture #:accessor texture #:init-keyword #:texture))
(define-method (render (sprite <sprite>) alpha)
- (draw-sprite* (asset-ref (texture sprite))
- (texture-gl-rect (texture sprite))
- (world-matrix sprite)))
+ (let ((tex (asset-ref (texture sprite))))
+ (draw-sprite* tex (texture-gl-rect tex) (world-matrix sprite))))
;;;