planetarium (make-tellurion): Name thread; return the object(!).
authorMatt Birkholz <matt@birchwood-abbey.net>
Mon, 28 Aug 2017 18:27:54 +0000 (11:27 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Mon, 28 Aug 2017 18:27:54 +0000 (11:27 -0700)
src/planetarium/tellurion.scm

index a8beb442ea080024331af28f1edd8a4e1e057098..2441b9a18bbda3f00e960e54105d8a9b0c976f02 100644 (file)
@@ -22,33 +22,40 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 |#
 
 (define (make-tellurion)
-  (let ((queue (make-thread-queue)))
-    (define (queue! command . args)
-      (thread-queue/queue! queue (cons command args))
-      unspecific)
-    (detach-thread (create-thread #f (lambda () (run-tellurion queue))))
-    (lambda (keyword . args)
-      (cond ((eq? keyword 'TURN-TO)
-            (let ((lat (->flonum (car args)))
-                  (long (->flonum (cadr args))))
-              (if (or (< lat -90) (< 90 lat))
-                  (error "Invalid latitude:" lat))
-              (if (or (< long -180) (< 180 long))
-                  (error "Invalid longitude:" long))
-              (queue! 'turn-to lat long)))
-           ((eq? keyword 'TIME-TO)
-            (queue! 'time-to (->time (car args))))
-           ((eq? keyword 'HOUR-TO)
-            (let ((hour (car args)))
-              (guarantee integer? hour 'hour-to)
-              (if (or (< hour 0) (< 23 hour))
-                  (error "Invalid hour:" hour))
-              (queue! 'hour-to hour)))
-           ((eq? keyword 'STOP)
-            (queue! queue 'stop))
-           ((eq? keyword 'GO)
-            (queue! queue 'go))
-           (else (error "unknown command:" keyword args))))))
+
+  (define queue (make-thread-queue))
+
+  (define (queue! command . args)
+    (thread-queue/queue! queue (cons command args))
+    unspecific)
+
+  (define (tellurion command . args)
+    (cond ((eq? command 'TURN-TO)
+          (let ((lat (->flonum (car args)))
+                (long (->flonum (cadr args))))
+            (if (or (< lat -90) (< 90 lat))
+                (error "Invalid latitude:" lat))
+            (if (or (< long -180) (< 180 long))
+                (error "Invalid longitude:" long))
+            (queue! 'turn-to lat long)))
+         ((eq? command 'TIME-TO)
+          (queue! 'time-to (->time (car args))))
+         ((eq? command 'HOUR-TO)
+          (let ((hour (car args)))
+            (guarantee integer? hour 'hour-to)
+            (if (or (< hour 0) (< 23 hour))
+                (error "Invalid hour:" hour))
+            (queue! 'hour-to hour)))
+         ((eq? command 'STOP)
+          (queue! queue 'stop))
+         ((eq? command 'GO)
+          (queue! queue 'go))
+         (else (error "unknown command:" command args))))
+
+  (detach-thread (create-thread #f
+                  (lambda () (run-tellurion queue))
+                  tellurion))
+  tellurion)
 
 (define (->time object)
   (cond ((eq? object 'current)