gtk-graphics/draw-text
gtk-graphics/draw-circle
gtk-graphics/fill-polygon-list
+ gtk-graphics/clear
gtk-graphics/flush
gtk-graphics/make))
(compile-system "planetarium" (directory-pathname (current-load-pathname))
'dependencies
`(("solar" "geometry")
- ("earth" "geometry" "matrices")
- ("mit-scheme-cil" "earth" ,@(directory-read "cil-*.txt"))
- ("tellurion" "geometry" "matrices")))
\ No newline at end of file
+ ("earth" "geometry")
+ ("mit-scheme-cil"
+ "mit-scheme-syntax" ,@(directory-read "cil-*.txt"))
+ ("tellurion" "geometry")))
\ No newline at end of file
;;; Much of this is stolen from Arthur's WorldMap.java, which he
;;; mistakenly lent me.
-(declare (usual-integrations)
- (integrate-external "geometry" "matrices"))
-
(define (draw-earth device orientation solar-lat/long)
(let ((solar-orientation
(let ((Mx (make-x-rotation-matrix
(draw-segment device start end color))
(loop (flo:+ i 1.) end)))))
-(define-integrable-operator (project latitude longitude orientation)
+(define (project latitude longitude orientation)
(let ((point (make-3d-point
(flo:* (flo:cos latitude) (flo:sin longitude))
(flo:sin latitude)
|#
-(declare (usual-integrations))
-
(define-integrable pi (flo:* 4. (flo:atan2 1. 1.)))
(define-integrable 2pi (flo:* 8. (flo:atan2 1. 1.)))
(define-integrable pi/2 (flo:* 2. (flo:atan2 1. 1.)))
":"(string-pad-left (number->string (car min.r)) 2 #\0)
":"(string-pad-left (number->string (cdr min.r)) 2 #\0))))
-(define-integrable-operator (lesser-angle a b)
+(define (lesser-angle a b)
;; Angle B translated to (not more than 2pi) numerically less than A.
(let loop ((b b))
(cond ((flo:< b (flo:- a 2pi))
(else
(loop (flo:- b 2pi))))))
-(define-integrable-operator (greater-angle a b)
+(define (greater-angle a b)
;; Angle B translated to (not more than 2pi) numerically greater than A.
(let loop ((b b))
(cond ((flo:< a (flo:- b 2pi))
|#
-(declare (usual-integrations) (no-type-checks) (no-range-checks))
+(declare (no-type-checks) (no-range-checks))
-(define-integrable-operator (3d-transform! point transform projection)
+(define (3d-transform! point transform projection)
;; point X transform => projection The projection may be eq point.
(define-integrable (t i j)
(flo:vector-ref transform (fix:+ (fix:* i 3) j)))
(flo:vector-set! projection 1 (f 1))
(flo:vector-set! projection 2 (f 2))))
-(define-integrable-operator (3d-multiply! A B C)
+(define (3d-multiply! A B C)
;; A X B => C C may be eq A or B.
(define-integrable (ref m row col)
(flo:vector-ref m (fix:+ (fix:* (fix:-1+ row) 3) (fix:-1+ col))))
(flo:vector-set! C 7 (f+ (f* A31 B12) (f* A32 B22) (f* A33 B32)))
(flo:vector-set! C 8 (f+ (f* A31 B13) (f* A32 B23) (f* A33 B33)))))
-(define-integrable (make-3d-identity-matrix)
+(define (make-3d-identity-matrix)
(flo:3d-matrix 1. 0. 0.
0. 1. 0.
0. 0. 1.))
-(define-integrable-operator (make-x-rotation-matrix radians)
+(define (make-x-rotation-matrix radians)
(let ((cos (flo:cos radians))
(sin (flo:sin radians)))
(let ((-sin (flo:negate sin)))
0. cos -sin
0. sin cos))))
-(define-integrable-operator (make-y-rotation-matrix radians)
+(define (make-y-rotation-matrix radians)
(let ((cos (flo:cos radians))
(sin (flo:sin radians)))
(let ((-sin (flo:negate sin)))
0. 1. 0.
-sin 0. cos))))
-(define-integrable-operator (make-z-rotation-matrix radians)
+(define (make-z-rotation-matrix radians)
(let ((cos (flo:cos radians))
(sin (flo:sin radians)))
(let ((-sin (flo:negate sin)))
;;;; System specific code for MIT Scheme with simple graphics.
-(declare (usual-integrations))
-
(define (make-suitable-graphics-device)
(let ((device (make-graphics-device)))
(graphics-set-coordinate-limits device -1.1 -1.1 1.1 1.1)
;;;; System specific code for MIT Scheme with X graphics.
-(declare (usual-integrations))
-
(define (make-suitable-graphics-device)
(let ((device (make-graphics-device 'x)))
(graphics-set-coordinate-limits device -1.1 -1.1 1.1 1.1)
(lambda ()
(let ((env (->environment '(planetarium))))
- (define (compile-load file #!optional dependencies declarations)
+ (define (compile-load file #!optional dependencies)
(let ((deps (if (default-object? dependencies) '() dependencies)))
(fluid-let (;;(compile-file:sf-only? #t)
- (sf/default-declarations
- (if (default-object? declarations)
- '()
- declarations)))
+ (compiler:generate-lap-files? #t))
(compile-file file deps env))
(load file env)))
- (define ignore-errors?
+ (define errors-ignored?
(let ((ok "ok"))
(lambda (thunk)
(let ((v (ignore-errors (lambda () (thunk) ok))))
(compile-load "mit-scheme-syntax")
(compile-load "geometry")
- (compile-load "matrices" '() '((no-range-checks)(no-type-checks)))
+ (compile-load "matrices")
(compile-load "time")
(compile-load "solar" '("geometry"))
- (compile-load "earth" '("matrices" "geometry"))
- (compile-load "mit-scheme-cil" (cons "earth"
+ (compile-load "earth" '("geometry"))
+ (compile-load "mit-scheme-cil" (cons "mit-scheme-syntax"
(directory-read "cil-*.txt")))
- (compile-load "tellurion" '("geometry" "matrices"))
+ (compile-load "tellurion" '("geometry"))
(environment-link-name (->environment '()) env 'make-tellurion)
- (cond ((not (ignore-errors? (lambda () (load-option 'gtk))))
+ (cond ((not (errors-ignored? (lambda () (load-option 'gtk))))
(compile-load "mit-scheme-gtk"))
((graphics-type-available? 'x)
(compile-load "mit-scheme-x"))
;;; specifically the second English edition (1998) "with corrections
;;; as of August 10, 2009" of _Astronomical_Algorithms_ by Jean Meeus.
-(declare (integrate-external "geometry")
- (reduce-operator (* flo:*)
+(declare (reduce-operator (* flo:*)
(sin flo:sin) (cos flo:cos)
(asin flo:asin) (atan2 flo:atan2)
(- flo:- (null-value 0. single) (group left))
|#
-(declare (usual-integrations)
- (integrate-external "geometry" "matrices"))
-
(define (make-tellurion)
(test-julian-day)
(test-greenwich-mean-sidereal-time)
;;; specifically the second English edition (1998) "with corrections
;;; as of August 10, 2009" of _Astronomical_Algorithms_ by Jean Meeus.
-(declare (usual-integrations))
-
(define (universal-time->julian-day time)
;; The Julian Ephemeris Day (JDE) corresponding to TIME.
(let ((decoded (universal-time->global-decoded-time time)))
projects / mit-scheme.git / commitdiff