planetarium: Combine mit-compile.scm and mit-compile-3d.scm.

Avoided the bug that required the fluid-let in mit-compile-3d.scm (by
relying on load-package-set?).  Separate compilation is back again.

diff --git a/src/planetarium/mit-compile-3d.scm b/src/planetarium/mit-compile-3d.scm
deleted file mode 100644 (file)
index b3af748..0000000
--- a/src/planetarium/mit-compile-3d.scm
+++ /dev/null
@@ -1,50 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 2013  Matthew Birkholz
-
-This file is part of an extension to MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Compile a 3D Planetarium.
-
-(load-option 'CREF)
-(load-option 'SOS)
-(load-option 'GTK)
-(load-option 'GL)
-
-(with-working-directory-pathname (directory-pathname (current-load-pathname))
-  (lambda ()
-    (define (load-compiled file deps pkg-name)
-      (let ((env (->environment pkg-name)))
-       (compile-file file deps env)
-       (load         file      env)))
-
-    (load "mit-compile")
-
-    (let ((package-set (package-set-pathname "mit-3d")))
-      (if (not (file-modification-time<? "mit-3d.pkg" package-set))
-         (cref/generate-trivial-constructor "mit-3d"))
-      (construct-packages-from-file (fasload package-set)))
-
-    (fluid-let ((compile-file:sf-only? #f))
-      (load-compiled "terrain" '("geometry") '(planetarium terrain))
-      ((access test-normals (->environment '(planetarium terrain))))
-      (load-compiled "google-earth" '() '(planetarium google-earth)))
-
-    (cref/generate-constructors "mit-3d")))
\ No newline at end of file

diff --git a/src/planetarium/mit-compile.scm b/src/planetarium/mit-compile.scm
index 5ec5ae039dbd08da086c2df656ebfd823eb56b86..b4566ebc4d5340c26db4b1760611b59957ce5de2 100644 (file)
--- a/src/planetarium/mit-compile.scm
+++ b/src/planetarium/mit-compile.scm
@@ -22,14 +22,18 @@ USA.
 |#
 
 (load-option 'CREF)
+(load-option 'SOS)
 (load-option 'GTK)
 
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
-    (define (load-compiled file deps pkg-name)
-      (let ((env (->environment pkg-name)))
-       (compile-file file deps env)
-       (load         file      env)))
+    (define (cf files deps pkg-name)
+      (if (pair? files)
+         (for-each (lambda (f) (compile-file f deps (->environment pkg-name)))
+                   files)
+         (compile-file files deps (->environment pkg-name))))
+    (define (lf file pkg-name)
+      (load file (->environment pkg-name)))
 
     (if (name->package '(PLANETARIUM))
        (error "The PLANETARIUM package already exists.")
@@ -38,17 +42,30 @@ USA.
              (cref/generate-trivial-constructor "mit"))
          (construct-packages-from-file (fasload package-set))))
 
-    (load-compiled "mit-r3rs" '() '(r3rs extras))
-    (load-compiled "mit-syntax" '() '(planetarium syntax))
-    (for-each (lambda (file) (load-compiled file '() '(planetarium)))
-             '("geometry" "matrices" "time" "graphics" "solar" "geometry"))
-    ((access test-angular-separation (->environment '(planetarium))))
-    (load-compiled "earth" '("geometry" "matrices") '(planetarium))
-    (load-compiled "tellurion" '("geometry" "matrices") '(planetarium))
-    (load-compiled "mit-gtk" '() '(planetarium gtk-graphics))
-    (load-compiled "mit-x" '() '(planetarium x-graphics))
-    (load-compiled "mit-graphics" '() '(planetarium simple-graphics))
-    (load-compiled "mit-cil"
-                  `("mit-syntax" ,@(directory-read "cil-*.txt"))
-                  '(planetarium earth-cil))
-    (cref/generate-constructors "mit")))
\ No newline at end of file
+    (cf "mit-r3rs"     '() '(r3rs extras))
+    (lf "mit-r3rs"         '(r3rs extras))
+    (cf "mit-syntax"   '() '(planetarium syntax))
+    (lf "mit-syntax"       '(planetarium syntax))
+    (cf '("geometry" "matrices" "time" "graphics"
+         "solar")     '() '(planetarium))
+    (cf '("earth" "tellurion")
+                      '("geometry" "matrices") '(planetarium))
+    (cf "mit-gtk"      '() '(planetarium gtk-graphics))
+    (cf "mit-x"        '() '(planetarium x-graphics))
+    (cf "mit-graphics" '() '(planetarium simple-graphics))
+    (cf "mit-cil"      `("mit-syntax" ,@(directory-read "cil-*.txt"))
+                          '(planetarium earth-cil))
+
+    (cref/generate-constructors "mit")
+
+    (if (not (warn-errors? (lambda () (load-option 'GL))))
+       (begin
+         (let ((package-set (package-set-pathname "mit-3d")))
+           (if (not (file-modification-time<? "mit-3d.pkg" package-set))
+               (cref/generate-trivial-constructor "mit-3d"))
+           (construct-packages-from-file (fasload package-set)))
+
+         (cf "terrain"      '("geometry") '(planetarium terrain))
+         (cf "google-earth" '() '(planetarium google-earth))
+
+         (cref/generate-constructors "mit-3d")))))
\ No newline at end of file

diff --git a/src/planetarium/mit-make.scm b/src/planetarium/mit-make.scm
index ede67a0c21b51049f9efd912cbe32bbd2911e16a..8355be96c3124fb4eda62e19b915a3263beb8461 100644 (file)
--- a/src/planetarium/mit-make.scm
+++ b/src/planetarium/mit-make.scm
@@ -31,7 +31,9 @@ USA.
     (directory-pathname (current-load-pathname))
   (lambda ()
     (load-package-set "mit")
+    ((access test-angular-separation (->environment '(planetarium))))
     (load "mit-link")
     (if (not (warn-errors? (lambda () (load-option 'GL))))
        (begin
-         (load-package-set "mit-3d")))))
\ No newline at end of file
+         (load-package-set "mit-3d")
+         ((access test-normals (->environment '(planetarium terrain))))))))
\ No newline at end of file

diff --git a/src/planetarium/mit-scheme.scm b/src/planetarium/mit-scheme.scm
index c5ff2dbdcbd662d3ed916410d42f251d7b777b79..35c0450d03dc1bd1a896636cbcee39044882d821 100644 (file)
--- a/src/planetarium/mit-scheme.scm
+++ b/src/planetarium/mit-scheme.scm
@@ -21,11 +21,9 @@ USA.
 
 |#
 
-;;;; Load the planetarium (just a tellurion at the mo').
+;;;; Load the planetarium.
 
-(load-option 'GTK)
-(with-working-directory-pathname
-    (directory-pathname (current-load-pathname))
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
     (load "mit-compile")
     (load "mit-make")))
\ No newline at end of file