From c45c9fa03575881f8c8dae0c8f729ea993abad0c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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 <dthompson2@worcester.edu>
+;;;
+;;; 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/>.
+
+;;; 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