planetarium: Log tellurion draw times.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 9 Oct 2013 23:51:29 +0000 (16:51 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 9 Oct 2013 23:51:29 +0000 (16:51 -0700)
src/planetarium/mit-snapshot.scm

index f23caf0143037756bec3a4399f42267cd7a2895c..d066dff3043fa7c5f2ea3567341d16d0541d0547 100644 (file)
@@ -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