home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
logo
/
powerlogo
/
examples
/
turtles
< prev
next >
Wrap
Text File
|
1992-11-10
|
9KB
|
362 lines
; Examples of turtle graphics procedures.
; *********************************************************************
; snowflake size depth-limit
; The Koch snowflake.
; snowflake 100 3
make "snowflake [
procedure [ [ :size :depth ] [ ] [ :d ] ]
make "d * 0.577350269189626 :size
pu
bk :d
lt 30
pd
flake :size :depth
rt 120
flake :size :depth
rt 120
flake :size :depth
rt 150
pu
fd :d
pd ]
; One side of the snowflake.
make "flake [
procedure [ [ :size :depth ] ]
if =0 :depth [ fd :size stop ] [ ]
make "size / :size 3
make "depth - :depth 1
flake :size :depth
lt 60
flake :size :depth
rt 120
flake :size :depth
lt 60
flake :size :depth ]
; *********************************************************************
; inspi size angle increment ( turtle-pointer )
; An angle increment spiral.
; inspi 3 0 7
; inspi 8 2 20
make "inspi [
procedure [ [ :side :angle :inc ] [ :tp ] [ :h :a ] ]
if listp :tp [ make "tp :t1 ] [ ]
make "h heading :tp
make "a :angle
dowhile
[ fd :side
rt :angle
make "angle remainder + :angle :inc 360 ]
[ not and = :h heading :tp = :angle :a ] ]
; *********************************************************************
; cornerpoly size angle depth-limit factor
; polygon with more polygons at it's corners.
; cornerpoly 40 144 3 0.4
; cornerpoly 30 90 4 0.5
; cornerpoly 40 150 3 0.25
make "cornerpoly [
procedure [ [ :size :angle :limit :factor ] [ ] [ :totalturn ] ]
if =0 :limit [ stop ] [ ]
make "totalturn 0
dowhile
[ fd :size
cornerpoly * :factor :size +- :angle - :limit 1 :factor
rt :angle
make "totalturn + :totalturn :angle ]
[ not =0 remainder :totalturn 360 ] ]
; *********************************************************************
; starspi
; Crazy spirals.
make "starspi [
procedure [ [ ] [ ] [ :r1 :r2 :a1 :a2 :d :df ] ]
clean
home
setrgb :s1 1 item + 1 random 7 [ [ 15 15 15 ]
[ 15 0 0 ]
[ 15 15 0 ]
[ 0 15 0 ]
[ 0 15 15 ]
[ 3 2 15 ]
[ 15 0 15 ] ]
make "r1 + 30 random 25
make "r2 + 3 random 5
make "a1 * rand 360
make "a2 * rand 180
make "d 5
make "df + 1.05 * 0.25 rand
repeat :r1 [
repeat :r2 [
fd :d
rt :a2 ]
make "d * :d :df
rt :a1 ]
starspi
stop ]
; *********************************************************************
; tree size size-limit factor angle
; A simple turtle tree.
; tree 50 5 0.5 45
; tree 50 2 0.7 90
; tree 40 3 0.6 15
make "tree [
procedure [ [ :size :limit :f :angle ] ]
if < :size :limit [ fd :size bk :size stop ] [ ]
fd :size
rt :angle
tree * :size :f :limit :f :angle
lt + :angle :angle
tree * :size :f :limit :f :angle
rt :angle
bk :size ]
; *********************************************************************
; leantree size angle depth-limit
; Another simple turtle tree.
; leantree 10 25 6
; leantree 8 10 8
make "leantree [
procedure [ [ :size :angle :level ] ]
fd :size
ltree :size :angle :level
bk :size ]
make "ltree [
procedure [ [ :size :angle :level ] ]
if =0 :level [ stop ] [ ]
lt :angle
fd :size
ltree :size :angle - :level 1
bk :size
rt * 2 :angle
fd / :size 2
ltree :size :angle - :level 1
bk / :size 2
lt :angle ]
; *********************************************************************
; sidetree
; Yet another tree.
; sidetree 6 0.5 10 55 0.75 0.65
make "sidetree [
procedure [ [ :size
:size-limit
:stem-angle
:branch-angle
:stem-factor
:branch-factor ] ]
repeat 4
[ rt :stem-angle
fd :size ]
if > :size :size-limit
[ sidetree * :size :stem-factor
:size-limit
:stem-angle
:branch-angle
:stem-factor
:branch-factor
if >0 :stem-angle
[ lt :branch-angle
sidetree * :size :branch-factor
:size-limit
+- :stem-angle
:branch-angle
:stem-factor
:branch-factor
rt :branch-angle ]
[ rt :branch-angle
sidetree * :size :branch-factor
:size-limit
+- :stem-angle
:branch-angle
:stem-factor
:branch-factor
lt :branch-angle ] ] [ ]
repeat 4
[ bk :size
lt :stem-angle ] ]
; *********************************************************************
; fern size size-limit
; A simple fern leaf (a three branch tree).
; fern 50 0.5
make "fern [
procedure [ [ :size :limit ] ]
if > :limit :size [ stop ] [ ]
fd * 0.18 :size
rt 4
fern * 0.82 :size :limit
rt 58
fern * 0.3 :size :limit
lt 122
fern * 0.3 :size :limit
rt 60
bk * 0.18 :size ]
; *********************************************************************
; fern2 size size-limit curl thickness node-spacing branch-angle
; A more versatile fern leaf.
; fern2 90 3 2 0.2 0.1 60
; fern2 90 3 2 0.3 0.18 60
; fern2 90 2 4 0.35 0.3 60
make "fern2 [
procedure [ [ :size :limit :curl :thick :nspace :angle ] [ ]
[ :d1 :d2 :a1 ] ]
make "d1 * :size :nspace
make "d2 * - 1 :nspace :size
fd :d1
if > :limit :size
[ make "a1 atan / :thick - 1 :nspace
fd :d2
rt :a1
bk :d2
fd :d2
lt + :a1 :a1
bk :d2
fd :d2
rt :a1
bk :d2 ]
[ rt :curl
fern2 :d2 :limit :curl :thick :nspace :angle
rt - :angle :curl
fern2 * :thick :size :limit :curl :thick :nspace :angle
lt + :angle :angle
fern2 * :thick :size :limit :curl :thick :nspace :angle
rt :angle ]
bk :d1 ]
; *********************************************************************
; golden-rect size
; Golden mean rectangle.
make "golden-rect [
procedure [ [ :size ] [ ] [ :m1 :m2 ] ]
make "m1 1.61803398874989
while [ not = :m1 :m2 ] [
make "m2 :m1
make "m1 + / 1 :m1 1 ]
golden-rect1 :size ]
make "golden-rect1 [
procedure [ [ :size ] [ ] [ :ms ] ]
make "ms / :size :m1
fd :size
rt 90
fd :ms
rt 90
fd :size
rt 90
if < 0.2 :ms [ golden-rect1 :ms stop ] [ ] ]
; *********************************************************************
; s-dragon size size-limit angle
; Size limit dragon.
; s-dragon 50 5 45
make "s-dragon [
procedure [ [ :size :size-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
make "angle2 - 90 :angle1
make "leg1 / * 0.5 sin - 180 * 2 :angle1 sin :angle1
make "leg2 / * 0.5 sin - 180 * 2 :angle2 sin :angle2
s-dragon1 :size 1 ]
make "s-dragon1 [
procedure [ [ :size :par ] ]
if > :size-limit :size [ fd :size stop ] [ ]
if >0 :par
[ rt :angle1
s-dragon1 * :size :leg1 1
lt 90
s-dragon1 * :size :leg2 -1
rt :angle2 ]
[ lt :angle2
s-dragon1 * :size :leg2 1
rt 90
s-dragon1 * :size :leg1 -1
lt :angle1 ] ]
; Lots of dragons.
make "s-dragons [
procedure [ [ ] [ ] [ :angle :size-limit ] ]
make "size-limit 80
while [ make "size-limit / :size-limit 3 > :size-limit 0.5 ] [
make "angle 0
while [ make "angle + :angle 5 < :angle 90 ] [
clean
home
pu
lt 70
bk 52
lt 20
pd
s-dragon 100 :size-limit :angle ] ] ]
; *********************************************************************
; d-dragon size depth-limit angle
; Depth limit dragon
; d-dragon 50 5 45
make "d-dragon [
procedure [ [ :size :depth-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
make "angle2 - 90 :angle1
make "leg1 / * 0.5 sin - 180 * 2 :angle1 sin :angle1
make "leg2 / * 0.5 sin - 180 * 2 :angle2 sin :angle2
d-dragon1 :size :depth-limit 1 ]
make "d-dragon1 [
procedure [ [ :size :depth-limit :par ] ]
if > 1 :depth-limit [ fd :size stop ] [ ]
make "depth-limit - :depth-limit 1
if >0 :par
[ rt :angle1
d-dragon1 * :size :leg1 :depth-limit 1
lt 90
d-dragon1 * :size :leg2 :depth-limit -1
rt :angle2 ]
[ lt :angle2
d-dragon1 * :size :leg2 :depth-limit 1
rt 90
d-dragon1 * :size :leg1 :depth-limit -1
lt :angle1 ] ]
; Lots of dragons.
make "d-dragons [
procedure [ [ ] [ ] [ :angle :depth-limit ] ]
make "depth-limit 3
while [ make "depth-limit + :depth-limit 3 < :depth-limit 12 ] [
make "angle 0
while [ make "angle + :angle 5 < :angle 90 ] [
clean
home
pu
lt 70
bk 52
lt 20
pd
d-dragon 100 :depth-limit :angle ] ] ]
; *********************************************************************
pr [ ]
pr [ Examples of turtle graphics procedures. ]
pr [ ]