;;; Scheme Recursive Art Contest Entry ;;; ;;; Please do not include your name or personal info in this file. ;;; ;;; Title: ;;; ;;; Description: ;;; ;;; Simplified edition ;;; going to make something cool ;;; fly from the scheme turtle! (define pen_position (list 0 0)) (define rec_pen_position (list 0 0)) (define temp (list 0 0)) (define x-angle 240) (define y-angle 90) (define z-angle 0) (define cz-length 700) (define cx-length 600) (define cy-length 1500) (define d-length 20) (define drift-x 500) (define drift-y 200) (ht) (speed 10) (define (record) (nonlocal rec_pen_position pen_position)) (define (back) (pu)(glb_goto rec_pen_position)) (define (record-temp) (nonlocal temp pen_position)) (define (back-temp) (pu)(glb_goto temp)) (define (for-loop proc var time) (cond ((= time 0) (cons var (cons time nil))) (else (for-loop proc (proc var) (- time 1)))) ) (define (element lst index_lst) (cond ((< (- (length lst) 1) (car index_lst)) (begin (print "Index exceeds the maximum length ( ⊙ o ⊙ )"))) ((= (length index_lst) 1) (cond ((= (car index_lst) 0) (car lst)) (else (element (cdr lst) (list (- (car index_lst) 1)))) )) (else (element (element lst (list (car index_lst))) (cdr index_lst))) ) ) (define (slice lst start end) (cond ((> start 0) (slice (cdr lst) (- start 1) (- end 1))) ((and (= start 0) (> end 0)) (cons (car lst) (slice (cdr lst) start (- end 1)))) ((= end 0) nil) ) ) (define (fill fn var cl) (begin (color (element cl '(0)) (element cl '(1)) (element cl '(2))) (begin_fill) (fn var) (end_fill)) ) (define (glb_fd x) (begin (record) (define ang (- 90 (current_angle))) (define xx (element pen_position '(0))) (define yy (element pen_position '(1))) (define dx (* x (cos ang))) (define dy (* x (sin ang))) (nonlocal pen_position (list (+ xx dx) (+ yy dy))) (fd x) ) ) (define (glb_bk x) (begin (record) (define ang (- 90 (current_angle))) (define xx (element pen_position '(0))) (define yy (element pen_position '(1))) (define dx (* x (cos ang))) (define dy (* x (sin ang))) (nonlocal pen_position (list (- xx dx) (- yy dy))) (bk x) ) ) (define (glb_goto var) (begin (record) (nonlocal pen_position var) (goto (- (element var '(0)) drift-x) (- (element var '(1)) drift-y)) ) ) (define (lcl_goto var) (let ((x (element var '(0))) (y (element var '(1)))) (glb_goto (list (+ x (element pen_position '(0))) (+ y (element pen_position '(1))))) ) ) (define (rel_calc a b) (list (- (element b '(0)) (element a '(0))) (- (element b '(1)) (element a '(1)))) ) (define (p2p var) (cond ((= (length var) 2) (begin (pd) (lcl_goto (rel_calc (element var '(0)) (element var '(1)))))) (else (begin (pd)(lcl_goto (rel_calc (element var '(0)) (element var '(1)))) (p2p (slice var 1 (length var))))) ) ) (define (graph var) (begin (record-temp) (pu)(lcl_goto (element var '(0))) (p2p var) (pd)(lcl_goto (rel_calc (element var (list (- (length var) 1))) (element var '(0))))) ) (define (draw-coordinates) (begin (pu)(goto (- 0 drift-x) (- 0 drift-y)) (for-cod (list (list x-angle cx-length) (list y-angle cy-length) (list z-angle cz-length))) (pu)(glb_goto '(0 0)) (for-cod (list (list y-angle cy-length) (list x-angle cx-length) (list z-angle cz-length))) (pu)(glb_goto '(0 0)) (for-cod (list (list z-angle cz-length) (list x-angle cx-length) (list y-angle cy-length))) (pu)(glb_goto '(0 0)) ) ) (define (for-cod var) (for-loop draw-coordinates-for var (/ (element var '(0 1)) d-length)) ) (define (go_angle_line var) (begin (seth (element var '(0))) (glb_fd (element var '(1)))) ) (define (draw-coordinates-for var);;; var = '((axis1 length1) (axis2 length2) (axis3 length3)) (begin (seth (element var '(0 0))) (pd)(color 0 0 0)(glb_fd d-length) (pd)(color 200 200 200)(record)(go_angle_line (list (element var '(1 0)) (element var '(1 1))))(back) (pd)(color 200 200 200)(record)(go_angle_line (list (element var '(2 0)) (element var '(2 1))))(back) var ) ) (define plane-frame-data '(((0 0) (6.82 0.46) (1.38 -0.7)) ((1.38 -0.7) (1.45 -1.01) (6.82 0.46)) ((1.4 -1.02) (-0.28 -3) (6.82 0.46)) ((1.68 -2.05) (1.74 -2.34) (6.82 0.46)))) (define plane-color-structure-data '( ((0 0) (6.82 0.46) (1.38 -0.7)) ((0 0) (1.13 -0.57) (5.59 0.38)) ((0 0) (0.83 -0.42) (4.83 0.33)) ((0 0) (0.53 -0.27) (4.06 0.27)) ((0 0) (0.22 -0.11) (3.12 0.21)) ((1.38 -0.7) (1.45 -1.01) (6.82 0.46)) ((1.4 -1.02) (-0.28 -3) (6.82 0.46)) ((0.95 -1.55) (-0.28 -3) (6.18 0.15)) ((0.61 -1.95) (-0.28 -3) (5.34 -0.26)) ((0.2 -2.43) (-0.28 -3) (3.97 -0.93)) ((-0.04 -2.71) (-0.28 -3) (2.65 -1.57)) ((1.68 -2.05) (1.74 -2.34) (6.82 0.46)))) )) (define plane-color-data1 '( (161 172 255) (121 137 255) (81 101 255) (40 66 255) (0 30 255) (37 39 58) (197 168 255) (172 131 255) (148 94 255) (123 57 255) (98 20 255) (73 15 191) )) (define plane-color-data2 '( (255 212 161) (255 194 121) (255 176 81) (255 158 40) (212 116 0) (155 69 49) (255 192 161) (255 165 121) (255 138 81) (255 111 40) (212 70 0) (132 25 0) )) (define plane-color-data3 '( (161 255 173) (121 255 138) (81 255 102) (40 255 67) (0 214 27) (35 46 29) (191 255 161) (164 255 121) (137 255 81) (110 255 40) (69 214 0) (60 139 22) )) (define shadow-data '( (0.1 -0.02) (1.42 -0.67) (-0.79 -3.01) (7.76 0.48) )) (define bar-data '( (250 75) (250 570) (1200 570) (1200 75) )) (define bar2 '( (260 85) (260 550) (1190 550) (1190 85) )) (define shadow-color '(70 70 70)) (define (aug var x) (cond ((= (length var) 0) nil) ((list? (element var '(0))) (cons (aug (element var '(0)) x) (aug (slice var 1 (length var)) x))) (else (cons (* x (element var '(0))) (aug (slice var 1 (length var)) x))) ) ) (define (move var dx dy) (cond ((= (length var) 0) nil) (else (cons (list (+ dx (element var '(0 0))) (+ dy (element var '(0 1)))) (move (slice var 1 (length var)) dx dy))) ) ) (define (move-col var dx dy) (cond ((= (length var) 0) nil) (else (cons (move (element var '(0)) dx dy) (move-col (slice var 1 (length var)) dx dy))) ) ) (define (paper-plane-color var1 var2);var1 = plane-color-structure-data , var2 = plane-color-data (cond ((= (length var1) 1) (begin (fill graph (element var1 '(0)) (element var2 '(0))) (back-temp))) (else (begin (fill graph (element var1 '(0)) (element var2 '(0))) (back-temp) (paper-plane-color (slice var1 1 (length var1)) (slice var2 1 (length var2))))) ) ) (define (paper-plane-frame var);var is the frame of the paper plane (cond ((= (length var) 1) (begin (graph (element var '(0))) (back-temp))) (else (begin (graph (element var '(0))) (back-temp) (paper-plane-frame (slice var 1 (length var))))) ) ) (define (draw-a-paper-plane var) (begin (paper-plane-color (element var '(0)) (element var '(1))) (color 0 0 0)(paper-plane-frame (element var '(2)))) ) (define (draw) (begin (draw-coordinates) (pd)(fill graph bar-data '(80 80 80)) (pu)(glb_goto '(0 0)) (pd)(fill graph bar2 '(60 115 214)) (pu)(glb_goto '(0 0)) (pu)(glb_goto '(260 555)) (pd)(begin_fill)(color 220 4 0)(circle 4)(end_fill) (pu)(glb_goto '(275 555)) (pd)(begin_fill)(color 220 181 0)(circle 4)(end_fill) (pu)(glb_goto '(290 555)) (pd)(begin_fill)(color 124 255 81)(circle 4)(end_fill) (pu)(glb_goto '(700 552)) (pd)(color 0 0 0)(write "Scheme Turtles" 13) (pu)(glb_goto '(263 525)) (pd)(color 0 0 0)(write "Mapur-MacBook-Air:scheme_final Mapur$ python3 scheme.py contest.scm" 20) (pu)(glb_goto '(263 505)) (pd)(color 0 0 0)(write "scm> (define pen_position (list 0 0))" 20) (pu)(glb_goto '(263 485)) (pd)(color 0 0 0)(write "scm> (define rec_pen_position (list 0 0))" 20) (pu)(glb_goto '(263 465)) (pd)(color 0 0 0)(write "scm> (define temp (list 0 0))" 20) (pu)(glb_goto '(263 445)) (pd)(color 0 0 0)(write "temp" 20) (pu)(glb_goto '(263 425)) (pd)(color 0 0 0)(write "scm> (define x-angle 240)" 20) (pu)(glb_goto '(263 405)) (pd)(color 0 0 0)(write "x-angle" 20) (pu)(glb_goto '(263 385)) (pd)(color 0 0 0)(write "scm> (define y-angle 90)" 20) (pu)(glb_goto '(263 365)) (pd)(color 0 0 0)(write "y-angle" 20) (pu)(glb_goto '(263 345)) (pd)(color 0 0 0)(write "scm> (define z-angle 0)" 20) (pu)(glb_goto '(263 325)) (pd)(color 0 0 0)(write "z-angle" 20) (pu)(glb_goto '(263 305)) (pd)(color 0 0 0)(write "scm> (define cz-length 700)" 20) (pu)(glb_goto '(263 285)) (pd)(color 0 0 0)(write "cz-length" 20) (pu)(glb_goto '(263 265)) (pd)(color 0 0 0)(write "scm> (define cx-length 600)" 20) (pu)(glb_goto '(263 245)) (pd)(color 0 0 0)(write "cx-length" 20) (pu)(glb_goto '(263 225)) (pd)(color 0 0 0)(write "scm> (define cy-length 1500)" 20) (pu)(glb_goto '(263 205)) (pd)(color 0 0 0)(write "cy-length" 20) (pu)(glb_goto '(263 185)) (pd)(color 0 0 0)(write "(define d-length 20)" 20) (pu)(glb_goto '(263 165)) (pd)(color 0 0 0)(write "(define drift-x 500)" 20) (pu)(glb_goto '(263 145)) (pd)(color 0 0 0)(write "drift-x" 20) (pu)(glb_goto '(263 125)) (pd)(color 0 0 0)(write "(define drift-y 200)" 20) (pu)(glb_goto '(263 105)) (pd)(color 0 0 0)(write "drift-y" 20) (pu)(glb_goto '(263 85)) (pd)(color 0 0 0)(write "scm> (ht)" 20) (pu)(glb_goto '(0 0)) (pd)(fill graph (move (aug shadow-data 75) 600 -150) shadow-color) (pu)(glb_goto '(0 0)) (pd)(fill graph (move (aug shadow-data 40) 200 -50) shadow-color) (pu)(glb_goto '(0 0)) (pd)(fill graph (move (aug shadow-data 40) -100 -150) shadow-color) (pu)(glb_goto '(0 0)) (pd) (draw-a-paper-plane (list (move-col (aug plane-color-structure-data 75) 600 500) plane-color-data1 (move-col (aug plane-frame-data 75) 600 500))) (draw-a-paper-plane (list (move-col (aug plane-color-structure-data 50) 200 300) plane-color-data2 (move-col (aug plane-frame-data 50) 200 300))) (draw-a-paper-plane (list (move-col (aug plane-color-structure-data 50) -200 100) plane-color-data3 (move-col (aug plane-frame-data 50) -200 100))) (exitonclick) ) ) ; 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)