From 9ea7b0de42a77bfdb1fba991cf12fc88d92a101d Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 16 Apr 2016 17:57:11 -0700
Subject: [PATCH] planetarium/terrain.scm: Accept real arguments to commands.

---
 src/planetarium/mit-3d.pkg  |  6 +++---
 src/planetarium/terrain.scm | 13 +++++++------
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/planetarium/mit-3d.pkg b/src/planetarium/mit-3d.pkg
index f4f79e51e..5e51d9b1f 100644
--- a/src/planetarium/mit-3d.pkg
+++ b/src/planetarium/mit-3d.pkg
@@ -37,13 +37,13 @@ USA.
   (files "terrain")
   (import ()
 	  burst-string read-line write-string ->namestring
-	  error:wrong-type-argument flo:= flo:>= flo:flonum? symbol-name
-	  guarantee-list-of-type->length guarantee-symbol guarantee-string
+	  error:wrong-type-argument real? ->flonum symbol-name
+	  guarantee-list-of-type->length
 	  universal-time->local-time-string
-	  sleep-current-thread
 	  define-class define-method initialize-instance
 	  system-global-environment
 	  define-syntax syntax-rules outf-error ill-formed-syntax
+	  flo:abs flo:round->exact
 	  fix:+ fix:* fix:- fix:-1+ fix:1+ fix:=)
   (import (gtk)
 	  gtk-widget-set-hexpand
diff --git a/src/planetarium/terrain.scm b/src/planetarium/terrain.scm
index e624e4f67..5c6205b10 100644
--- a/src/planetarium/terrain.scm
+++ b/src/planetarium/terrain.scm
@@ -33,7 +33,7 @@ USA.
 
       (define (check-flonum-args num description)
 	(if (not (= num (guarantee-list-of-type->length
-			 args flo:flonum? "a flonum" 'TERRAIN)))
+			 args real? "a real number" 'TERRAIN)))
 	    (error (string-append
 		    "The "(symbol-name command)" command requires"
 		    (number->string num '(int))" arguments: "description"."))))
@@ -41,9 +41,9 @@ USA.
       (cond
        ((eq? 'POSITION command)
 	(check-flonum-args 3 "LATITUDE, LONGITUDE and ALTITUDE")
-	(let ((lat (car args))
-	      (lng (cadr args))
-	      (alt (caddr args)))
+	(let ((lat (->flonum (car args)))
+	      (lng (->flonum (cadr args)))
+	      (alt (->flonum (caddr args))))
 	  (if (not (flo:<= (flo:abs lat) 80.))
 	      (error "Requested latitude is greater than 80°:" lat))
 	  (let ((pos (glx-viewport-position widget))
@@ -57,12 +57,13 @@ USA.
 
        ((eq? 'HEADING command)
 	(check-flonum-args 1 "AZIMUTH")
-	(set-glx-viewport-heading! widget (degrees->radians (car args)))
+	(set-glx-viewport-heading! widget
+				   (degrees->radians (->flonum (car args))))
 	(gtk-widget-queue-draw widget))
 
        ((eq? 'TILT command)
 	(check-flonum-args 1 "INCLINATION in degrees")
-	(if (not (flo:<= (flo:abs (car args)) 80.))
+	(if (not (flo:<= (flo:abs (->flonum (car args))) 80.))
 	    (error "Requested inclination greater than 80°.")
 	    (set-glx-viewport-tilt! widget (degrees->radians (car args))))
 	(gtk-widget-queue-draw widget))
-- 
2.25.1