diff options
Diffstat (limited to 'engine/assets.scm')
| -rw-r--r-- | engine/assets.scm | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/engine/assets.scm b/engine/assets.scm new file mode 100644 index 0000000..39e5e5b --- /dev/null +++ b/engine/assets.scm @@ -0,0 +1,172 @@ +;;; The Inevitable Game +;;; Copyright © 2018 David Thompson <davet@gnu.org> +;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; 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 this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (engine assets) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (engine inotify) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (config) + #:export (<asset> + artifact + file-name + loader + args + watch-asset-directory + reload-modified-assets + asset-ref + define-asset)) + +(define-class <asset> () + ;; class slots for asset cache and live reloading + (inotify #:allocation #:class #:init-form #f) + ;; file-name -> assets mapping + (asset-map #:allocation #:class #:init-form (make-hash-table)) + ;; args -> artifact mapping + (artifact-cache #:allocation #:class #:init-form (make-weak-value-hash-table)) + (watches #:allocation #:class #:init-form '()) + ;; instance slots + (artifact #:accessor artifact #:init-form #f) + (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) + (watch #:accessor watch #:init-form #f)) + +(define (absolute-file-name file-name) + (if (absolute-file-name? file-name) + file-name + (string-append %assets-root "/" file-name))) + +(define-method (initialize (asset <asset>) args) + (next-method) + (slot-set! asset 'file-name (absolute-file-name (file-name asset))) + (let* ((asset-map (class-slot-ref <asset> 'asset-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-map (file-name asset)) + (let ((wt (make-weak-key-hash-table))) + (hash-set! asset-map (file-name asset) wt) + wt)))) + (hash-set! sub-table asset asset))) + +(define (asset-inotify) + (class-slot-ref <asset> 'inotify)) + +(define (asset-map) + (class-slot-ref <asset> 'asset-map)) + +(define (artifact-cache) + (class-slot-ref <asset> 'artifact-cache)) + +(define (asset-watches) + (class-slot-ref <asset> 'watches)) + +(define (directory-watched? dir) + (find (lambda (watch) + (string=? (inotify-watch-file-name watch) dir)) + (asset-watches))) + +(define (watch-recursively dir) + (let ((inotify (asset-inotify))) + (file-system-fold (const #t) ; enter? + (lambda (name stat result) result) ; leaf + (lambda (name stat result) ; down + (cons (inotify-add-watch! inotify name '(create close-write moved-to)) + result)) + (lambda (name stat result) result) ; up + (lambda (name stat result) result) ; skip + (lambda (name stat errno result) result) ; error + '() + dir))) + +(define (watch-asset-directory dir) + ;; Lazily activate inotify. + (unless (asset-inotify) + (class-slot-set! <asset> 'inotify (make-inotify))) + (unless (directory-watched? dir) + (class-slot-set! <asset> 'watches + (append (watch-recursively dir) + (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-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)) + ;; ooh, a new directory to watch! + ((eq? type 'create) + (watch-recursively file-name)))))))) + +(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 (fetch-cached-artifact key) + (hash-ref (artifact-cache) key)) + +(define (load-artifact cache-key loader file-name loader-args) + (or (fetch-cached-artifact cache-key) + (let ((artifact (apply loader file-name loader-args))) + (cache-artifact cache-key artifact) + artifact))) + +(define (load! asset) + (let ((thing (load-artifact (cache-key asset) + (loader asset) + (file-name asset) + (loader-args asset)))) + (set! (artifact asset) thing) + thing)) + +(define-method (asset-ref (asset <asset>)) + (or (artifact asset) (load! asset))) + +(define-method (asset-ref anything) + anything) + +(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 ...)))) |