# Test the PLANETARIUM option.
-set -e
+set -ex
: ${MIT_SCHEME_EXE=mit-scheme}
${MIT_SCHEME_EXE} --prepend-library . <<\EOF
(begin
-
(set! *initial-options-file* (merge-pathnames "mit-optiondb.scm"))
(load-option 'PLANETARIUM)
(if (not (gtk-initialized?))
- (warn "Could not test the planetarium without a DISPLAY.")
+ (warn "Could not test the planetarium.")
(begin
(make-tellurion)
- (let ((pkg (name->package '(planetarium terrain))))
- (if (not pkg)
+ (let ((env (->environment '(planetarium))))
+ ((access test-julian-day env))
+ ((access test-greenwich-mean-sidereal-time env))
+ ((access test-solar-latitude/longitude env))
+ ((access test-angular-separation env)))
+
+ (let ((env (->environment '(planetarium terrain))))
+ (if (not env)
(warn "Could not test terrain viewer.")
- (let ((env (package/environment pkg)))
+ (begin
+ ((access test-normals env))
(if (not (file-exists? "sample-terrain.txt"))
((access write-sample-terrain env)
"sample-terrain.txt" 20 20))
- ((access test-normals env))
(let ((view (make-terrain "sample-terrain.txt"
- 20 20 0. 0. .01)))
- (view 'position 0. 0. 20000.)
- (view 'heading 50.)
- (view 'tilt -50.)))))
+ 20 20 0. 0. .001)))
+ (view 'position -.01 0. 2000.)
+ (view 'heading 25.)
+ (view 'tilt -45.)))))
(let ((env (->environment '(gtk gtk-widget))))
(let loop ()
(lambda ()
(parameterize ((param:suppress-loading-message? #t))
(load-package-set "mit")
- (let ((env (->environment '(planetarium))))
- ((access test-julian-day env))
- ((access test-greenwich-mean-sidereal-time env))
- ((access test-solar-latitude/longitude env))
- ((access test-angular-separation env)))
(load "mit-link")
(if (not (warn-errors? (lambda () (load-option 'GL))))
- (begin
- (load-package-set "mit-3d")
- ((access test-normals (->environment '(planetarium terrain)))))))))
\ No newline at end of file
+ (load-package-set "mit-3d")))))
\ No newline at end of file