diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
commit | ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7 (patch) | |
tree | eee15e02ae016333546d3841712be591b2bcb06f /grtest.scm | |
parent | 302e3218b7d487539ec305bf23881a6ee7d5be99 (diff) | |
download | scm-ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7.tar.gz scm-ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7.zip |
Import Upstream version 5e2upstream/5e2
Diffstat (limited to 'grtest.scm')
-rw-r--r-- | grtest.scm | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/grtest.scm b/grtest.scm new file mode 100644 index 0000000..7401308 --- /dev/null +++ b/grtest.scm @@ -0,0 +1,82 @@ + +; This is a quick hack to test the graphics primitives. +; The SLIB scheme library is needed for random. +; IMHO, the syntax of `do' in scheme is horrible! +; - sjm + +(define (grtest) + (require 'random) ; needs SLIB + (graphics-mode!) + + (display "testing draw-to") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 3))) + ((> x (max-x)) 0) + (set-color! (remainder (/ x 3) (max-color))) + (draw-to x 0) + (draw-to x (max-y)) + ) + + (do ((y 0 (+ y 3))) + ((> y (max-y)) 0) + (set-color! (remainder (/ y 3) (max-color))) + (goto-center!) + (draw-to! 0 y) + (goto-center!) + (draw-to! (max-x) y) + ) + + (goto-nw!) + (do ((x 0 (+ x 2))) + ((> x (max-x)) 0) + (set-color! (remainder (/ x 2) (max-color))) + (draw-to x (max-y)) + ) + (do ((y (+ (max-y) 1) (- y 2))) + ((< y 0) 0) + (set-color! (remainder (/ y 2) (max-color))) + (draw-to (max-x) y) + ) + + (display "testing set-dot!") (newline) + (clear-graphics!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-dot! (+ (random (max-x)) 1) (+ (random (max-y)) 1) + (+ (random (max-color)) 1)) + ) + + (display "testing draw with turn-to!") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-to! (random 360)) + (draw (random 50)) + ) + + (display "testing draw with turn-right") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-right (random 90)) + (draw (random 50)) + ) + + (display "testing draw with turn-left") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-left (random 90)) + (draw (random 50)) + ) + + (text-mode!) +) + |