From c45c9fa03575881f8c8dae0c8f729ea993abad0c Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 4 May 2014 17:46:01 -0400 Subject: Add live-reload module. * Makefile.am (SOURCES): Add it. * 2d/live-reload.scm: New module. --- 2d/live-reload.scm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 2d/live-reload.scm (limited to '2d') diff --git a/2d/live-reload.scm b/2d/live-reload.scm new file mode 100644 index 0000000..265fa1f --- /dev/null +++ b/2d/live-reload.scm @@ -0,0 +1,54 @@ +;;; guile-2d +;;; Copyright (C) 2014 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; Live asset reloading. +;; +;;; Code: + +(define-module (2d live-reload) + #:use-module (srfi srfi-1) + #:use-module (2d agenda) + #:use-module (2d coroutine) + #:use-module (2d signal) + #:export (live-reload-interval + live-reload)) + +(define live-reload-interval 120) + +(define (live-reload proc) + "Return a new procedure that re-applies PROC whenever the associated +file is modified. The new procedure returns a signal that contains +the return value of PROC. The first argument to PROC must be a +filename string." + (lambda (filename . args) + (define (load-asset) + (apply proc filename args)) + + (define (current-mtime) + (stat:mtime (stat filename))) + + (let ((asset (make-signal (load-asset)))) + (coroutine + (let loop ((last-mtime (current-mtime))) + (wait live-reload-interval) + (let ((mtime (current-mtime))) + (when (> mtime last-mtime) + (signal-set! asset (load-asset))) + (loop mtime)))) + asset))) -- cgit v1.2.3