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