home *** CD-ROM | disk | FTP | other *** search
/ Dream 44 / Amiga_Dream_44.iso / RiscPc / programmation / scm4e2.arc / !Scm / scm / turtle < prev   
Text File  |  1994-10-23  |  2KB  |  129 lines
  1. ;
  2. ; Minimal demos of new turtling routines
  3. ; ams 31/7/94 
  4. ;
  5.  
  6. ; clunky way to draw squares
  7. (define (square n)
  8.     (begin
  9.         (forward n)
  10.         (turn 90)
  11.         (forward n)
  12.         (turn 90)
  13.         (forward n)
  14.         (turn 90)
  15.         (forward n)
  16.     ))
  17.  
  18. (define (ft)
  19.     (lambda () (begin (forward 100) (turn 90))))
  20.  
  21. ;
  22. ; minimal repeat type command
  23. ;
  24. (define (repeat e n)
  25.     (if (= 0 n)
  26.         '()
  27.     (begin
  28.         (e)
  29.         (repeat e (- n 1))
  30.     )))
  31. ;
  32. ; to try `repeat' >
  33. ; (repeat (ft) 4)
  34. ;
  35. (define (triangle n)
  36.     (repeat (lambda () (begin (forward n)(turn 120))) 3))
  37.  
  38. ;
  39. ; draw an object having `n' sides, with each side being `ls' long
  40. ; note inefficient - should use a (let ...) for the angle calculation
  41. ; (or memoise it..)
  42. ;
  43. (define (n-obj n ls)
  44.     (repeat 
  45.         (lambda () 
  46.             (begin 
  47.                 (forward ls)
  48.                 (turn (trunc (- 360 (/ 360 n))))
  49.             ))
  50.         n))
  51. ;
  52. ; Hit escape to stop this - basically to prove our plotting isn't lossy...
  53. ;
  54. (define (demo-square)
  55.     (begin
  56.         (square 100)
  57.         (demo-square)
  58.     ))
  59.  
  60. (define (hex n)
  61.     (begin
  62.         (forward n) (turn 60)
  63.         (forward n) (turn 60)
  64.         (forward n) (turn 60)
  65.         (forward n) (turn 60)
  66.         (forward n) (turn 60)
  67.         (forward n)
  68.     ))
  69.  
  70. (define (trunc f) (inexact->exact (floor f)))
  71.  
  72. (define (koch d s)
  73.     (begin
  74.         (if (= 0 d)
  75.             (forward s)
  76.             (begin
  77.                 (koch (- d 1) (trunc (/ s 3))) (turn -60)
  78.                 (koch (- d 1) (trunc (/ s 3))) (turn 120)
  79.                 (koch (- d 1) (trunc (/ s 3))) (turn -60)
  80.                 (koch (- d 1) (trunc (/ s 3)))
  81.             ))
  82.  
  83.     ))
  84.  
  85. (define (flake d s)
  86.     (begin
  87.         (koch d s)(turn 120)
  88.         (koch d s)(turn 120)
  89.         (koch d s)(turn 120)
  90.     ))
  91.  
  92. (define (dragon d s)
  93.     (if (= d 0)
  94.         (forward s)
  95.         (if (> d 0)
  96.             (begin
  97.                 (dragon (- d 1) (trunc s))
  98.                 (turn 90)
  99.                 (dragon (- 0 (- d 1)) (trunc s))
  100.             )
  101.             (begin
  102.                 (dragon (- 0 (+ d 1)) (trunc s))
  103.                 (turn 270)
  104.                 (dragon (+ d 1) (trunc s))
  105.             )
  106.         )
  107.     ))    
  108.  
  109.  
  110. ;; try (rightkoch 5 500)
  111. (define (rightkoch d s)
  112.     (if (= d 0)
  113.         (forward s)
  114.         (begin
  115.             (rightkoch (- d 1) (trunc (/ s 3))) (turn -90)
  116.             (rightkoch (- d 1) (trunc (/ s 3))) (turn 90)
  117.             (rightkoch (- d 1) (trunc (/ s 3))) (turn 90)
  118.             (rightkoch (- d 1) (trunc (/ s 3))) (turn -90)
  119.             (rightkoch (- d 1) (trunc (/ s 3))) 
  120.         )))
  121.  
  122. (define (ccurve d s)
  123.     (if (= d 0)
  124.         (forward s)
  125.         (begin
  126.             (ccurve (- d 1) (trunc s)) (turn 90)
  127.             (ccurve (- d 1) (trunc s)) (turn -90)
  128.     )))
  129.