diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | starling/asset.scm | 200 | ||||
| -rw-r--r-- | starling/inotify.scm | 217 | ||||
| -rw-r--r-- | starling/kernel.scm | 6 | ||||
| -rw-r--r-- | starling/node-2d.scm | 9 |
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)))) ;;; |