115 lines
3.2 KiB
Scheme
Executable File
115 lines
3.2 KiB
Scheme
Executable File
#!/bin/sh
|
|
#|
|
|
exec mred -u "$0" "$@"
|
|
|#
|
|
(module run-tests mzscheme
|
|
|
|
(require (lib "plot.ss" "plot")
|
|
(lib "md5.ss")
|
|
(lib "pretty.ss"))
|
|
|
|
|
|
;; thisi should be big enough to read thse files
|
|
(define (read-file file)
|
|
(with-input-from-file file (lambda () (read-bytes 100000))))
|
|
|
|
(define-syntax run-test
|
|
(syntax-rules ()
|
|
[(_ description (plot args ...) file-name)
|
|
(let* ([result-file-name (string-append file-name "-out.png")]
|
|
[expected-file-name (string-append file-name ".png")])
|
|
(plot args ... (out-file result-file-name))
|
|
;; WILL COMPARE by MD5 hash.
|
|
(printf "testing \"~a\" ... " description)
|
|
(if (equal? (md5 (read-file result-file-name))
|
|
(md5 (read-file expected-file-name)))
|
|
(begin (display "passed\n") (delete-file result-file-name))
|
|
(printf "failed! expected results in ~a, plot produced results in ~a\n"
|
|
expected-file-name
|
|
result-file-name)))]))
|
|
|
|
|
|
(run-test "Line"
|
|
(plot
|
|
(line (lambda (x) x) (color 'red)))
|
|
"red-identity")
|
|
|
|
|
|
|
|
(run-test
|
|
"Vector Field"
|
|
(plot
|
|
(vector-field
|
|
(gradient (lambda (x y) (* (sin x) (cos y))))
|
|
(samples 25))
|
|
(title "gradient field of F(x,y) = sin(x) * sin(y)"))
|
|
"vector-field")
|
|
|
|
(define (trig x y) (* (sin x) (sin y)))
|
|
|
|
(run-test
|
|
"Shading"
|
|
(plot (shade trig)
|
|
(x-min -1.5) (x-max 1.5) (y-min -1.5) (y-max 1.5)
|
|
(title "shdade of F(x,y) = sin(x) * sin(y)"))
|
|
"shade")
|
|
|
|
(run-test
|
|
"Contours"
|
|
(plot (contour trig)
|
|
(x-min -1.5) (x-max 1.5) (y-min -1.5) (y-max 1.5)
|
|
(title "contours of F(x,y) = sin(x) * sin(y)"))
|
|
"contours")
|
|
|
|
(run-test
|
|
"Mix of all three"
|
|
(plot (mix
|
|
(shade trig)
|
|
(contour trig)
|
|
(vector-field (gradient trig ) (samples 25)))
|
|
(x-min -1.5) (x-max 1.5) (y-min -1.5) (y-max 1.5)
|
|
(title
|
|
"gradient field +shdade + contours of F(x,y) = sin(x) * sin(y)"))
|
|
"mix")
|
|
|
|
(run-test
|
|
"3d mesg"
|
|
(plot3d (mesh3d trig)
|
|
(x-min -3.5) (x-max 3.5) (y-min -3.5) (y-max 3.5) (z-min -1.0) (z-max 1.5) (bgcolor '(0 0 0)) (fgcolor '(255 0 0)))
|
|
"3d-mesh")
|
|
|
|
(require (lib "class.ss")
|
|
(lib "plot-extend.ss" "plot")
|
|
(lib "etc.ss"))
|
|
|
|
|
|
; (number -> number) mumbo-jumbo -> 2d-renderer
|
|
(define-plot-type dashed-line
|
|
fun 2dview (x-min x-max) ((samples 100) (segments 20) (color 'red) (width 1))
|
|
(let* ((dash-size (/ (- x-max x-min) segments))
|
|
(x-lists (build-list (/ segments 2)
|
|
(lambda (index)
|
|
(x-values
|
|
(/ samples segments)
|
|
(+ x-min (* 2 index dash-size))
|
|
(+ x-min (* (add1 ( * 2 index)) dash-size)))))))
|
|
(send* 2dview
|
|
(set-line-color color)
|
|
(set-line-width width))
|
|
(for-each (lambda (dash)
|
|
(send 2dview plot-line
|
|
(map (lambda (x) (vector x (fun x))) dash)))
|
|
x-lists)))
|
|
|
|
(run-test
|
|
"Simple plot-extend"
|
|
(plot (dashed-line (lambda (x) x) (color 'red)))
|
|
"dashed-line")
|
|
|
|
(run-test
|
|
"canvas sizing"
|
|
(plot (line sin) (height 100) (width 100))
|
|
"size")
|
|
|
|
)
|