;;; Scheme Recursive Art Contest Entry ;;; ;;; Please do not include your name or personal info in this file. ;;; ;;; Title: Tornado's eye ;;; ;;; Description: ;;; It tumbles 3D hailstones ;;; It rises with that 3D spirals in the sky ;;; But the center the chaos, lies its serenely eye. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ---------- GENERAL HELPER FUNCTIONS ---------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (map proc items) (if (null? items) nil (cons (proc (car items)) (map proc (cdr items))))) (define (cadr x) (car (cdr x))) (define (caddr x) (car (cdr (cdr x)))) (define (cadddr x) (car (cdr (cdr (cdr x))))) (define (get_element_at_index lst index) (if (eq? index 0) (car lst) (get_element_at_index (cdr lst) (- index 1)))) (define (list_length lst) (if (null? lst) 0 (+ 1 (list_length (cdr lst))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ---------- VECTOR3 ---------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; vec3 helper methods ;;; DOT PRODUCT (define (vec3_dot vecA vecB) (+ (+ (* (car vecA) (car vecB)) (* (cadr vecA) (cadr vecB))) (* (caddr vecA) (caddr vecB)))) ;;; ADD & SUB (define (vec3_add vecA vecB) (list (+ (car vecA) (car vecB)) (+ (cadr vecA) (cadr vecB)) (+ (caddr vecA) (caddr vecB)))) (define (vec3_sub vecA vecB) (list (- (car vecA) (car vecB)) (- (cadr vecA) (cadr vecB)) (- (caddr vecA) (caddr vecB)))) ;;; MUL (define (vec3_mul_element vecA vecB) (list (* (car vecA) (car vecB)) (* (cadr vecA) (cadr vecB)) (* (caddr vecA) (caddr vecB)))) (define (vec3_mul_scalar vecA scale) (list (* (car vecA) scale) (* (cadr vecA) scale) (* (caddr vecA) scale))) ;;; ROTATE (define (vec3_rl vecA) (list (cadr vecA) (caddr vecA) (car vecA))) (define (vec3_rr vecA) (list (caddr vecA) (car vecA) (cadr vecA))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ---------- 3D IMPLEMENTATION ---------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ----- 3D FUNCTIONS ----- ;;; ROTATE - rotate vertices (define (rotate points angle direction point) (begin (define c0 (cos angle)) (define s (sin angle)) (define c1 (- 1 c0)) (define direction2 (vec3_mul_element direction direction)) (define aubvcw (vec3_mul_element point direction)) (define xyz1 (vec3_add (vec3_mul_scalar (vec3_sub (vec3_mul_element point (vec3_add (vec3_rl direction2) (vec3_rr direction2))) (vec3_mul_element direction (vec3_add (vec3_rl aubvcw) (vec3_rr aubvcw)))) c1) (vec3_mul_scalar (vec3_sub (vec3_mul_element (vec3_rl point) (vec3_rr direction)) (vec3_mul_element (vec3_rr point) (vec3_rl direction))) s))) (define xyz2 (vec3_mul_scalar direction c1)) (define pt (car points)) (define dotp (vec3_dot point direction)) (define new_xyz (vec3_add (vec3_add xyz1 (vec3_mul_scalar xyz2 dotp)) (vec3_add (vec3_mul_scalar pt c0) (vec3_mul_scalar (vec3_sub (vec3_mul_element (vec3_rl direction) (vec3_rr pt)) (vec3_mul_element (vec3_rr direction) (vec3_rl pt))) s)))) (let ((result (list (list (car new_xyz) (cadr new_xyz) (caddr new_xyz))))) (if (> (list_length points) 1) (append result (rotate (cdr points) angle direction point)) result)))) ;;; 3D -> 2D Representation (define (calc_perspective points camera viewer) (let ((a (car viewer)) (b (cadr viewer)) (c (caddr viewer)) (xyz (vec3_sub (car points) camera))) (let ((x (car xyz)) (y (cadr xyz)) (z (caddr xyz)) (t4 (/ a (car xyz)))) (let ((new_points (list (list (- b (* t4 y)) (- c (* t4 z)))))) (if (> (list_length points) 1) (append new_points (calc_perspective (cdr points) camera viewer)) new_points))))) ;;; ----- 3D OBJECTS ----- (define (make_cube p s) (begin (define x (car p)) (define y (cadr p)) (define z (caddr p)) (let ((xs (- x s)) (ys (- y s)) (zs (- z s)) ) (list p (list x y zs) (list x ys zs) (list x ys z) (list xs ys z) (list xs ys zs) (list xs y zs) (list xs y z) )))) (define (draw_cube cube camera viewer) (let ((a (car camera)) (b (cadr camera)) (c (caddr camera)) (faces (list (list 0 1 2 3) (list 0 7 4 3) (list 0 1 6 7) (list 2 5 4 3) (list 1 2 5 6) (list 5 6 7 4))) (ps (calc_perspective cube camera viewer)) ) (draw_cube_faces faces ps))) (define (draw_cube_faces faces ps) (if (null? faces) nil (let ((r (car (car faces))) (s (cadr (car faces))) (t (caddr (car faces))) (u (cadddr (car faces))) ) (begin (pu) (goto (car (get_element_at_index ps r)) (cadr (get_element_at_index ps r))) (pd) (goto (car (get_element_at_index ps s)) (cadr (get_element_at_index ps s))) (goto (car (get_element_at_index ps t)) (cadr (get_element_at_index ps t))) (goto (car (get_element_at_index ps u)) (cadr (get_element_at_index ps u))) (goto (car (get_element_at_index ps r)) (cadr (get_element_at_index ps r))) (draw_cube_faces (cdr faces) ps) )))) (define cube (make_cube (list 2 2 2) 4)) ;;; ----- 3D PROPERTIES ----- (define camera (list 600 0 0)) (define viewer (list 600 0 0)) (define angle 0.05) (define axis (list 1.5 1.5 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ---------- TURTLE PROPERTIES ---------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (tracer 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ---------- DRAW ---------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (draw cube) (begin (draw_cube cube camera viewer) (update) ; (clear) (define cube (rotate (map (lambda (vertex) (vec3_add vertex (list 1 0 1))) cube) angle axis (list 0 0 0))) (draw_cube cube camera viewer) (draw cube) ) ; (exitonclick) ) (define draw (draw cube)) ; Please leave this last line alone. You may add additional procedures above ; this line. All Scheme tokens in this file (including the one below) count ; toward the token limit. (draw)