Advertisement
Pixel_Outlaw

I like Turtles

Sep 30th, 2014
263
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 1.91 KB | None | 0 0
  1. ;; Turtle is just a list of (x, y, direction, color, tail-down)
  2. ;; I'm not Scheme expert, Common Lisp is superior
  3.  
  4. (define (nth n l)
  5.   (if (= n 0)
  6.       (car l)
  7.       (nth (- n 1) (cdr l))))
  8.  
  9. (define (deg-to-rad degrees)
  10.   (* degrees 0.0174532925))
  11.  
  12. (define (draw-line x y x2 y2) ;; Define on own here
  13.   '())
  14.  
  15. (define (make-Turtle x y direction)
  16.   `(,x ,y ,direction 'black #t))
  17.  
  18. (define (get-x Turtle)
  19.   (car Turtle))
  20.  
  21. (define (get-y Turtle)
  22.   (cadr Turtle))
  23.  
  24. (define (get-direction Turtle)
  25.   (caddr Turtle))
  26.  
  27. (define (get-color Turtle)
  28.   (cadddr Turtle))
  29.  
  30. (define (get-tail-down Turtle)
  31.   (nth 4 Turtle))
  32.  
  33. (define (pos x y Turtle)
  34.   `(,x
  35.     ,y
  36.     ,(get-direction Turtle)
  37.     ,(get-color Turtle)
  38.     ,(get-tail-down Turtle)))
  39.  
  40. (define (rt angle Turtle)
  41.   `(,(get-x Turtle)
  42.     ,(get-y Turtle)
  43.     ,(+ (get-direction Turtle) angle)
  44.     ,(get-color Turtle)
  45.     ,(get-tail-down Turtle)))
  46.  
  47. (define (lt angle Turtle)
  48.   `(,(get-x Turtle)
  49.     ,(get-y Turtle)
  50.     ,(- (get-direction Turtle) angle)
  51.     ,(get-color Turtle)
  52.     ,(get-tail-down Turtle)))
  53.  
  54. (define (fd step Turtle)
  55.   (let* ((rad-angle (deg-to-rad (get-direction Turtle)))
  56.      (old-x (get-x Turtle))
  57.      (old-y (get-y Turtle))
  58.      (new-x (* (+ (get-x Turtle) (cos rad-angle)) step))
  59.      (new-y (* (+ (get-y Turtle) (sin rad-angle)) step)))
  60.     (if (get-tail-down Turtle)
  61.     (draw-line old-x old-y new-x new-y))
  62.     `(,new-x
  63.       ,new-y
  64.       ,(get-direction Turtle)
  65.       ,(get-color Turtle)
  66.       ,(get-tail-down Turtle))))
  67.  
  68. (define (col color Turtle)
  69.   `(,(get-x Turtle)
  70.     ,(get-y Turtle)
  71.     ,(get-direction Turtle)
  72.     ,color
  73.     ,(get-tail-down Turtle)))
  74.  
  75. (define (pu Turtle)
  76.   `(,(get-x Turtle)
  77.     ,(get-y Turtle)
  78.     ,(get-direction Turtle)
  79.     ,(get-color Turtle)
  80.     ,#f))
  81.  
  82. (define (pd Turtle)
  83.   `(,(get-x Turtle)
  84.     ,(get-y Turtle)
  85.     ,(get-direction Turtle)
  86.     ,(get-color Turtle)
  87.     ,#t))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement