From ea2cf06f9e6dde1055151ce389661d3b1b54876e Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 29 Apr 2016 16:28:11 -0700
Subject: [PATCH] planetarium: Turn write-sample-terrain into
 write-function-terrain.

---
 src/planetarium/mit-check.sh | 18 +++++++++++-------
 src/planetarium/terrain.scm  | 14 ++++++--------
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/src/planetarium/mit-check.sh b/src/planetarium/mit-check.sh
index 1c7b4b061..e03f40e84 100755
--- a/src/planetarium/mit-check.sh
+++ b/src/planetarium/mit-check.sh
@@ -47,16 +47,20 @@ ${MIT_SCHEME_EXE} --prepend-library . <<\EOF
 	      (warn "Could not test terrain viewer.")
 	      (begin
 		((access test-normals env))
-		(if (not (file-exists? "sample-terrain.txt"))
-		    ((access write-sample-terrain env)
-		     "sample-terrain.txt" 20 20))
+		((access write-function-terrain env)
+		 "sample-terrain.txt"
+		 -3 3 50
+		 -3 3 50
+		 (lambda (x y)
+		   (let ((d^2+1 (+ (* x x) (* y y) 1)))
+		     (* 1000 (/ (sin d^2+1) d^2+1)))))
 		(let ((view (make-terrain 'filename "sample-terrain.txt"
-					  'rows 20 'columns 20
+					  'rows 50 'columns 50
 					  'latitude 0. 'longitude 0.
 					  'step .001)))
-		  (view 'position -.01 0. 2000.)
-		  (view 'heading 25.)
-		  (view 'tilt -45.)))))
+		  (view 'position -.02 -.02 4000.)
+		  (view 'heading 45.)
+		  (view 'tilt -40.)))))
 
 	(let ((env (->environment '(gtk gtk-widget))))
 	  (let loop ()
diff --git a/src/planetarium/terrain.scm b/src/planetarium/terrain.scm
index 4d974d677..171ede38e 100644
--- a/src/planetarium/terrain.scm
+++ b/src/planetarium/terrain.scm
@@ -462,13 +462,14 @@ USA.
 		  (matrix-set! matrix columns x y height))))))))
     matrix))
 
-(define (write-sample-terrain filename x-samples y-samples)
+(define (write-function-terrain filename
+				x-min x-max x-samples
+				y-min y-max y-samples
+				function)
   (with-output-to-file filename
     (lambda ()
       (let ((time-string
-	     (universal-time->local-time-string (get-universal-time)))
-	    (x-min -3) (x-max 3)
-	    (y-min -2) (y-max 2))
+	     (universal-time->local-time-string (get-universal-time))))
 	(let ((x-step (/ (- x-max x-min) x-samples)) 
 	      (y-step (/ (- y-max y-min) y-samples)))
 	  (do ((x x-min (+ x x-step))
@@ -483,10 +484,7 @@ USA.
 	      (write-char #\,)
 	      (write-string (number->string y '(fix 3)))
 	      (write-char #\tab)
-	      (write-string (number->string
-			     (* 1000 ;One kilometer tall mountain.
-				(/ 1 (+ (* x x) (* y y) 1)))
-			     '(fix 3)))
+	      (write-string (number->string (function x y) '(fix 3)))
 	      (write-char #\newline))))))))
 
 (define-integrable (matrix-set! m c x y v)
-- 
2.25.1