From 24c02067fd6dc2ad8eac41b4155985865a8c61c4 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 9 Oct 2013 16:51:29 -0700 Subject: [PATCH] planetarium: Log tellurion draw times. --- src/planetarium/mit-snapshot.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) 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 -- 2.25.1