|
Эта программа при запуске (имя головной процедуры -- ReCurves) создает на экране набор кнопок, а также, при необходимости, дополнительных черепашек. По окончании работы нужно щелкнуть кнопку "Good Bye", это уберет все созданные объекты и подготовит программу к повторному запуску. Чтобы не возникало лишних проблем с запуском, рекомендую скопировать текст на лист программ "нового проекта". Не стоит создавать или удалять какие-либо объекты вручную, пока Вы не разберетесь с работой программы.
; Collection of recursive curves:
; Andromeda, Hilbert, Dragon, Knuth,
; Peano, Sierpinski, Tree, Wirth, Cage,
; 4 x Dragon, Trees
;
; (c)1988,1991 V. Batagelj
; adaptation LCSI/LogoS 21. maj 1991
; adaptation MSW Logo 18. jan 1996
; (c) 1999 McKryak -- adaptation MicroWorlds
TO Hilb :n :a :h
If :n = 0 [ Stop ]
RT :a
Hilb :n - 1 (0 - :a) :h FD :h LT :a
Hilb :n - 1 :a :h FD :h
Hilb :n - 1 :a :h LT :a FD :h
Hilb :n - 1 (0 - :a) :h RT :a
END
TO Hilbert
PU SetPos [-150 -130] PD SetC 105
Hilb 5 90 7
END
TO Drag :n :a :h
IF :n < 1 [ FD :h Stop ]
Drag :n - 1 90 :h RT :a
Drag :n - 1 -90 :h
END
TO Dragon
HT PU SetPos [ -60 -80 ] PD SetH -90
SetC 15 SetPenSize 2
Drag 11 90 5
ST
END
TO Dragons
Make "c [ 15 55 105 45 ]
SetPenSize 2 Make "k 0
Repeat 4
[
PU Home PD RT 90 * :k Make "k :k + 1 SetC Item :k :c
Drag 11 90 5
]
END
TO Follow :tr1 :tr2
Ask :tr2 [Make "T Pos]
Ask :tr1 [Towards :tr2 FD 2]
END
TO Andromeda
SetC 5 Fill
Ask "t1 [PU SetPos [ -170 -170] PD]
Ask "t2 [PU SetPos [ -170 170] PD]
Ask "t3 [PU SetPos [ 170 170] PD]
Ask "t4 [PU SetPos [ 170 -170] PD]
Repeat 170 [
SetC 105 Follow "t1 "t2
SetC 15 Follow "t2 "t3
SetC 45 Follow "t3 "t4
SetC 125 Follow "t4 "t1
]
END
TO Knu :n :a :t :h
IF :n = 0 [ RT 45 + :t FD :h LT 45 + :t Stop ]
RT 2 * :t + :a
Knu :n - 1 2 * :t (0 - :t) :h
RT 45 - 3 * :t - :a FD :h LT 45 - :t + :a
Knu :n - 1 0 (0 - :t) :h
RT :a
END
TO Knuth
Home
PU SetPos [ 250 -130 ] PD LT 90
SetC 9 Fill SetC 0
Knu 9 -90 45 8
END
TO Pean :n :a :h
If :n = 0 [Stop]
RT :a Pean :n - 1 (0 - :a) :h
FD :h Pean :n - 1 :a :h
FD :h Pean :n - 1 (0 - :a) :h LT :a
END
TO Peano
Home Clean
PU SetPos [ -150 -135 ] PD SetC 55 Fill SetC 15
Pean 6 90 10
END
TO Sierp :n :a :h :k
If :n = 0 [ FD :k Stop ]
RT :a Sierp :n - 1 (0 - :a) :h :k LT :a FD :h
LT :a Sierp :n - 1 (0 - :a) :h :k RT :a
END
TO Sierpinski
PU SetPos [ -160 -125 ] PD SetC 125 Fill SetC 85
Repeat 4
[
Sierp 7 45 10 / Sqrt 2 7
RT 45 FD 10 / Sqrt 2 RT 45
]
SetC 55 PU SetPos [-145 -115] PD Fill
END
TO Tr :n :h :q
If :n = 0 [ Stop ]
FD :h LT 90
Tr :n - 1 :q * :h :q LT 90 FD 2 * :h LT 90
Tr :n - 1 :q * :h :q LT 90 FD :h
END
TO Tree
Home RT 90 SetC 85 Fill SetC 9
Tr 10 100 1 / Sqrt 2
END
TO wi :n :a :h :k
If :n = 0 [ FD :h Stop ]
RT :a iw :n (0 - :a) :h :k LT :a FD :h
LT :a iw :n (0 - :a) :h :k RT :a
END
TO iw :n :a :h :k
RT :a wi :n - 1 (0 - :a) :h :k FD :k LT 2 * :a
FD :k wi :n - 1 (0 - :a) :h :k RT :a
END
TO Wirth
PU SetPos [ -155 -130 ] PD SetC 65 Fill SetC 9
Repeat 4
[
wi 4 45 6 2
FD 3 RT 90 FD 3
]
PU SetC 85 PU SetPos [-150 -130] PD Fill
END
TO Two :a :c :w
IF :c < 1 [ Stop ]
RT :a FD 1 RT :a FD :w LT :a
IF :c > 1 [FD 1]
LT :a FD :w
Two :a :c - 2 :w
END
TO Square :a :h :w
FD :w Two :a :h - 1 :w
END
TO Cag :n :a :w :h
IF :n = 0 [ Square :a :h :w Stop ]
RT :a
Cag :n - 1 (0 - :a) :h / 4 :w FD :h / 8
Cag :n - 1 :a :h / 4 :w FD :h / 8
Cag :n - 1 (0 - :a) :h / 4 :w LT :a
END
TO Cage
PU SetPos [ -160 -130 ] PD SetC 18 Fill SetC 9
Cag 4 90 260 260
END
TO Leaf
RT 30 FD :d LT 120 FD :d LT 120 FD :d LT 150
END
TO TreeB :n :a
IF :n < 1 [ FD (:a / 4) SetC :l Leaf SetC :t PU BK (:a / 4) PD Stop ]
TreeA :a / 3 0.75 * :a 30 :n
TreeA :a / 3 0.65 * :a -35 :n
TreeA :a / 3 0.50 * :a 45 :n
PU BK :a PD
END
TO TreeA :s :a :r :n
FD :s RT :r
IfElse (:q < Random 10)
[ Make "k 2]
[ Make "k 1]
TreeB (:n - :k) :a
LT :r
END
TO Trees
Make "q 8 HT SetC 65 Fill
Make "l 85 Make "t 9 Make "d 6 SetC :t
PU SetPos [ -90 -130 ] PD SetH 0 TreeB 5 130
Make "l 115 Make "t 15 Make "d 8 SetC :t
PU SetPos [ 80 -100 ] PD SetH 0 TreeB 3 80
END
to ClearScreen
SetC 9 SetPenSize 1 cg
END
TO GoodBye
ClearScreen t1, st
DoList [ element [ t2 t3 t4 b13 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b1] ]
[ Remove :element ]
StopAll
END
TO Draw
SetC 9 SetPenSize 2
END
TO ReCurves
CG HT SetPenSize 2
NewTurtle "t2 HT
NewTurtle "t3 HT
NewTurtle "t4 HT
t1,
NewButton "b1 [210 -120] [GoodBye]
NewButton "b2 [210 -100] [ClearScreen]
NewButton "b3 [210 120] [Hilbert]
NewButton "b4 [210 100] [Sierpinski]
NewButton "b5 [210 80] [Trees]
NewButton "b6 [210 60] [Cage]
NewButton "b7 [210 40] [Andromeda]
NewButton "b8 [210 20] [Dragon]
NewButton "b9 [210 0] [Knuth]
NewButton "b10 [210 -20] [Peano]
NewButton "b11 [210 -40] [Dragons]
NewButton "b12 [210 -60] [Tree]
NewButton "b13 [210 -80] [Wirth]
END
|
