From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 9 Oct 2013 23:51:29 +0000 (-0700)
Subject: planetarium: Log tellurion draw times.
X-Git-Tag: mit-scheme-pucked-9.2.12~451
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=24c02067fd6dc2ad8eac41b4155985865a8c61c4;p=mit-scheme.git

planetarium: Log tellurion draw times.
---

diff --git a/src/planetarium/mit-snapshot.scm b/src/planetarium/mit-snapshot.scm
index f23caf014..d066dff30 100644
--- a/src/planetarium/mit-snapshot.scm
+++ b/src/planetarium/mit-snapshot.scm
@@ -60,10 +60,25 @@ USA.
 (let ((time (get-universal-time))
       (latitude 33.3)
       (longitude -111.9)
-
       (device (gtk-graphics/make 400 400)))
   (graphics-set-coordinate-limits device -1.1 -1.1 1.1 1.1)
+
+  (call-with-append-file "tellurion.log"
+    (lambda (out)
+      (with-notification-output-port out
+        (lambda ()
+	  (with-gc-notification! #t
+	   (lambda ()
+	     (show-time
+	      (lambda ()
+		(draw-tellurion device time (make-latitude/longitude
+					     latitude longitude))))))
+	  (write-char #\tab out)
+	  (write-string (universal-time->local-time-string time) out)
+	  (newline out)))))
+
   (draw-tellurion device time (make-latitude/longitude latitude longitude))
+
   (let ((surface (surface-ink-surface (graphics-device/descriptor device))))
     (cairo-surface-write-to-png surface "tellurion.png")
     (cairo-surface-destroy surface)))
\ No newline at end of file