home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / dirs / powerlogo_377.lzh / PowerLOGO / Examples / Turtles < prev   
Text File  |  1990-10-10  |  7KB  |  248 lines
  1.  
  2. ;  Examples of turtle graphics procedures.
  3.  
  4. ; *********************************************************************
  5. ;  turtle         ( bit-planes )
  6. ;     Prepare screen, window, and turtle for simple turtle graphics.
  7.  
  8. if not buriedp "turtle [
  9. make "turtle [
  10.    procedure [ [ ] [ :d ] ]
  11.    if numberp :d [ ] [ make "d 1 ]
  12.    ( intuition 6 @0 )
  13.    recycle
  14.    make "s1 ( openscreen 3 :d [ turtle ] )
  15.    make "w1 openwindow :s1
  16.    make "t1 openturtle :w1
  17.    setrgb :s1 0 [ 0  0  0 ]
  18.    setrgb :s1 1 [ 14 14 14 ]
  19.    ( intuition 2 @0 0 0 )
  20.    ( intuition 8 @0 550 54 )
  21.    if < 300 peek -2 psum peek 0 :s1 14
  22.    [  ( intuition 1 @0 0 350 ) ]
  23.    [  ( intuition 1 @0 0 150 ) ]
  24.    ( intuition 6 @0 ) ]
  25. ] [ ]
  26.  
  27. ; *********************************************************************
  28. ;  starspi
  29. ;     Crazy spirals.
  30.  
  31. make "starspi [
  32.    procedure [ [ ] [ ] [ :r1 :r2 :a1 :a2 :d :df ] ]
  33.    clean
  34.    home
  35.    setrgb :s1 1 item + 1 random 7   [  [ 15 15 15 ]
  36.                                        [ 15 0  0 ]
  37.                                        [ 15 15 0 ]
  38.                                        [ 0  15 0 ]
  39.                                        [ 0  15 15 ]
  40.                                        [ 3  2  15 ]
  41.                                        [ 15 0  15 ] ]
  42.    make "r1 + 30 random 25
  43.    make "r2 + 3 random 5
  44.    make "a1 * rand 360
  45.    make "a2 * rand 180
  46.    make "d 5
  47.    make "df + 1.05 * 0.25 rand
  48.    repeat :r1 [
  49.       repeat :r2 [
  50.          fd :d
  51.          rt :a2 ]
  52.       make "d * :d :df
  53.       rt :a1 ]
  54.    starspi
  55.    stop ]
  56.  
  57. ; *********************************************************************
  58. ;  tree           size limit factor angle
  59. ;     A simple turtle tree.
  60. ;  tree 50 5 0.5 45
  61. ;  tree 50 2 0.7 90
  62. ;  tree 40 3 0.6 15
  63.  
  64. make "tree [
  65.    procedure [ [ :size :limit :f :angle ] ]
  66.    if < :size :limit [ fd :size bk :size stop ] [ ]
  67.    fd :size
  68.    rt :angle
  69.    tree * :size :f :limit :f :angle
  70.    lt + :angle :angle
  71.    tree * :size :f :limit :f :angle
  72.    rt :angle
  73.    bk :size ]
  74.  
  75. ; *********************************************************************
  76. ;  poly           size sides
  77. ;     Polygon.
  78.  
  79. make "poly [
  80.    procedure [ [ :size :sides ] [ ] [ :angle ] ]
  81.    make "angle / 360 :sides
  82.    repeat :sides [ fd :size rt :angle ] ]
  83.  
  84. ; *********************************************************************
  85. ;  golden-rect    size
  86. ;     Golden mean rectangle.
  87.  
  88. make "golden-rect [
  89.    procedure [ [ :size ] [ ] [ :m1 :m2 ] ]
  90.    make "m1 1.61803398874989
  91.    while [ not = :m1 :m2 ] [
  92.       make "m2 :m1
  93.       make "m1 + / 1 :m1 1 ]
  94.    golden-rect1 :size ]
  95.  
  96. make "golden-rect1 [
  97.    procedure [ [ :size ] [ ] [ :ms ] ]
  98.    make "ms / :size :m1
  99.    fd :size
  100.    rt 90
  101.    fd :ms   
  102.    rt 90
  103.    fd :size
  104.    rt 90
  105.    if < 0.2 :ms [ golden-rect1 :ms stop ] [ ] ]
  106.  
  107. ; *********************************************************************
  108. ;  s-dragon       size limit angle
  109. ;     Size limit dragon.
  110. ;  s-dragon 50 5 45
  111.  
  112. make "s-dragon [
  113.    procedure [ [ :size :size-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
  114.    make "angle2 - 90 :angle1
  115.    make "leg1  /  * 0.5 sin - 180 * 2 :angle1  sin :angle1
  116.    make "leg2  /  * 0.5 sin - 180 * 2 :angle2  sin :angle2
  117.    s-dragon1 :size 1 ]
  118.  
  119. make "s-dragon1 [
  120.    procedure [ [ :size :par ] ]
  121.    if > :size-limit :size [ fd :size stop ] [ ]
  122.    if >0 :par
  123.       [  rt :angle1
  124.          s-dragon1 * :size :leg1 1
  125.          lt 90
  126.          s-dragon1 * :size :leg2 -1
  127.          rt :angle2 ]
  128.       [  lt :angle2
  129.          s-dragon1 * :size :leg2 1
  130.          rt 90
  131.          s-dragon1 * :size :leg1 -1
  132.          lt :angle1 ] ]
  133.  
  134. ;  Lots of dragons.
  135.  
  136. make "s-dragons [
  137.    procedure [ [ ] [ ] [ :angle :size-limit ] ]
  138.    make "size-limit 80
  139.    while [ make "size-limit / :size-limit 3  > :size-limit 0.5 ] [
  140.       make "angle 0
  141.       while [ make "angle + :angle 5  < :angle 90 ] [
  142.          clean
  143.          home
  144.          pu
  145.          lt 70
  146.          bk 52
  147.          lt 20
  148.          pd
  149.          s-dragon 100 :size-limit :angle ] ] ]
  150.  
  151. ; *********************************************************************
  152. ;  d-dragon       size limit angle
  153. ;     Depth limit dragon
  154. ;  d-dragon 50 5 45
  155.  
  156. make "d-dragon [
  157.    procedure [ [ :size :depth-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
  158.    make "angle2 - 90 :angle1
  159.    make "leg1  /  * 0.5 sin - 180 * 2 :angle1  sin :angle1
  160.    make "leg2  /  * 0.5 sin - 180 * 2 :angle2  sin :angle2
  161.    d-dragon1 :size :depth-limit 1 ]
  162.  
  163. make "d-dragon1 [
  164.    procedure [ [ :size :depth-limit :par ] ]
  165.    if > 1 :depth-limit [ fd :size stop ] [ ]
  166.    make "depth-limit - :depth-limit 1
  167.    if >0 :par
  168.       [  rt :angle1
  169.          d-dragon1 * :size :leg1 :depth-limit 1
  170.          lt 90
  171.          d-dragon1 * :size :leg2 :depth-limit -1
  172.          rt :angle2 ]
  173.       [  lt :angle2
  174.          d-dragon1 * :size :leg2 :depth-limit 1
  175.          rt 90
  176.          d-dragon1 * :size :leg1 :depth-limit -1
  177.          lt :angle1 ] ]
  178.  
  179. ;  Lots of dragons.
  180.  
  181. make "d-dragons [
  182.    procedure [ [ ] [ ] [ :angle :depth-limit ] ]
  183.    make "depth-limit 3
  184.    while [ make "depth-limit + :depth-limit 3  < :depth-limit 12 ] [
  185.       make "angle 0
  186.       while [ make "angle + :angle 5  < :angle 90 ] [
  187.          clean
  188.          home
  189.          pu
  190.          lt 70
  191.          bk 52
  192.          lt 20
  193.          pd
  194.          d-dragon 100 :depth-limit :angle ] ] ]
  195.  
  196. ; *********************************************************************
  197. ;  fern           size size-limit
  198. ;     A simple fern leaf.
  199. ;  fern 50 0.5
  200.  
  201. make "fern [
  202.    procedure [ [ :size :limit ] ]
  203.    if > :limit :size [ stop ] [ ]
  204.    fd * 0.18 :size
  205.    rt 4
  206.    fern * 0.82 :size :limit
  207.    rt 58
  208.    fern * 0.3 :size :limit
  209.    lt 122
  210.    fern * 0.3 :size :limit
  211.    rt 60
  212.    bk * 0.18 :size ]
  213.  
  214. ; *********************************************************************
  215. ;  fern2          size size-limit curl thickness node-spacing branch-angle
  216. ;     A more versatile fern leaf.
  217. ;  fern2 90 3 2 0.2 0.1 60
  218. ;  fern2 90 3 2 0.3 0.18 60
  219. ;  fern2 90 2 4 0.35 0.3 60
  220.  
  221. make "fern2 [
  222.    procedure [ [ :size :limit :curl :thick :nspace :angle ] [ ]
  223.                [ :d1 :d2 :a1 ] ]
  224.    make "d1 * :size :nspace
  225.    make "d2 * - 1 :nspace :size
  226.    fd :d1
  227.    if > :limit :size
  228.    [  make "a1 atan / :thick - 1 :nspace
  229.       fd :d2
  230.       rt :a1
  231.       bk :d2
  232.       fd :d2
  233.       lt + :a1 :a1
  234.       bk :d2
  235.       fd :d2
  236.       rt :a1
  237.       bk :d2 ]
  238.    [  rt :curl
  239.       fern2 :d2 :limit :curl :thick :nspace :angle
  240.       rt - :angle :curl
  241.       fern2 * :thick :size :limit :curl :thick :nspace :angle
  242.       lt + :angle :angle
  243.       fern2 * :thick :size :limit :curl :thick :nspace :angle
  244.       rt :angle ]
  245.    bk :d1 ]
  246.  
  247.  
  248.