racket/collects/tests/plot/run-tests.rkt
Eli Barzilay fcedc30ee4 Rename "collects/tests/mred" -> ".../gracket".
Some additional mred-related tweaks.
2010-05-17 01:44:27 -04:00

97 lines
3.3 KiB
Racket
Executable File

#!/bin/sh
#| -*- scheme -*-
exec gracket "$0" "$@"
|#
#lang scheme
(require plot file/md5 scheme/runtime-path)
(define-runtime-path here "./")
(define (read-file file)
(with-input-from-file file (lambda () (read-bytes (file-size file)))))
(define-syntax run-test
(syntax-rules ()
[(_ description (plot args ...) file-name)
(let* ([result-file-name
(build-path here (string-append file-name "-out.png"))]
[expected-file-name
(build-path here (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 & shade & contours")
"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 plot/plot-extend)
; (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")