codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; turtle graphics (define xpos 0) (define ypos 0) (define pen? #t) (define head 0) (define (send x . xs) (cond ((null? xs) (display x) (newline)) (else (display x) (display " ") (apply send xs)))) (define (clearscreen) (set! xpos 0) (set! ypos 0) (set! pen? #t) (set! head 0) (send "%!") (send "initgraphics") (send "newpath 306 396 moveto") (send "currentpoint translate") (send "0 setgray 2 setlinewidth")) (define (penup) (set! pen? #f)) (define (pendown) (set! pen? #t)) (define (forward n) (let ((newx (inexact->exact (round (+ xpos (* n (sin (* head 0.017453292519943295))))))) (newy (inexact->exact (round (+ ypos (* n (cos (* head 0.017453292519943295)))))))) (send newx newy (if pen? "lineto" "moveto")) (set! xpos newx) (set! ypos newy))) (define (back n) (let ((newx (inexact->exact (round (- xpos (* n (sin (* head 0.017453292519943295))))))) (newy (inexact->exact (round (- ypos (* n (cos (* head 0.017453292519943295)))))))) (send newx newy (if pen? "lineto" "moveto")) (set! xpos newx) (set! ypos newy))) (define (left n) (set! head (modulo (- head n) 360))) (define (right n) (set! head (modulo (+ head n) 360))) (define (setpos x y) (send x y (if pen? "lineto" "moveto")) (set! xpos x) (set! ypos y)) (define (setheading n) (set! head n)) (define (pos) (values xpos ypos)) (define (heading) head) (define (done) (send "stroke showpage")) (define (tree size) (cond ((< size 5) (forward size) (back size)) (else (forward (/ size 3)) (left 30) (tree (* size 2/3)) (right 30) (back (/ size 3)) (forward (/ size 2)) (right 25) (tree (/ size 2)) (left 25) (back (/ size 2)) (forward (* size 5/6)) (right 25) (tree (/ size 2)) (left 25) (back (* size 5/6))))) (clearscreen) (tree 50) (done)
Private
[
?
]
Run code
Submit