From 999743d75d91601c0244fee93519cd93d5360819 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Tue, 12 Nov 2013 16:27:50 -0700 Subject: [PATCH] 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. --- src/planetarium/mit-compile-3d.scm | 50 ---------------------------- src/planetarium/mit-compile.scm | 53 ++++++++++++++++++++---------- src/planetarium/mit-make.scm | 4 ++- src/planetarium/mit-scheme.scm | 6 ++-- 4 files changed, 40 insertions(+), 73 deletions(-) delete mode 100644 src/planetarium/mit-compile-3d.scm diff --git a/src/planetarium/mit-compile-3d.scm b/src/planetarium/mit-compile-3d.scm deleted file mode 100644 index b3af74808..000000000 --- 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-timeenvironment '(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 5ec5ae039..b4566ebc4 100644 --- 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-timeenvironment '(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 c5ff2dbdc..35c0450d0 100644 --- 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 -- 2.25.1