From 2c5b19226815a406c60cc1a49c59864922364c55 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 10 Apr 2020 08:55:50 -0400 Subject: Add project skeleton and import engine code. --- lisparuga/asset.scm | 200 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 200 insertions(+) create mode 100644 lisparuga/asset.scm (limited to 'lisparuga/asset.scm') diff --git a/lisparuga/asset.scm b/lisparuga/asset.scm new file mode 100644 index 0000000..b4969b0 --- /dev/null +++ b/lisparuga/asset.scm @@ -0,0 +1,200 @@ +;;; Lisparuga +;;; Copyright © 2020 David Thompson +;;; +;;; Lisparuga 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. +;;; +;;; Lisparuga 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 Lisparuga. If not, see . + +;;; Commentary: +;; +;; Abstraction for loading game data from the file system, including +;; automatically reloading the data when it changes. +;; +;;; Code: + +(define-module (lisparuga asset) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (lisparuga inotify) + #:export ( + artifact + file-name + loader + args + watch-assets + watching-assets? + watch-asset-directory + reload-modified-assets + clear-asset-cache + asset-ref + define-asset)) + +(define-class () + (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 ) 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-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 'inotify)) + +(define (asset-file-map) + (class-slot-ref 'asset-file-map)) + +(define (artifact-cache) + (class-slot-ref 'artifact-cache)) + +(define (asset-artifact-map) + (class-slot-ref 'asset-artifact-map)) + +(define (asset-watches) + (class-slot-ref 'watches)) + +(define (watch-assets watch?) + (let ((old-watch? (watching-assets?))) + (class-slot-set! '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 '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! 'inotify (make-inotify))) + ;; Add watch if it doesn't already exist. + (unless (directory-watched? dir) + (class-slot-set! '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 )) + ;; 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 + #:file-name file-name + #:loader loader + #:loader-args (list loader-args ...)))) -- cgit v1.2.3