Rekurzivne krivulje

; Logo
; Example: ReCurves
;
; 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

TO Hilb :n :a :h
   IF :n = 0 [ STOP ]
   RT :a Hilb :n - 1 (-: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 (-:a) :h RT :a
END

TO Hilbert
   PU SETPOS [-150 -150] PD SETPC [000 000 255]
   Hilb 5 90 10
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
   PU SETPOS [ -60 -100 ] PD LT 90
   SETPC [255 000 000] SetPenSize [2 2]
   Drag 11 90 7
END

TO Dragons
   MAKE "c [ [255 000 000] [000 2555 000] [000 000 255] [000 255 255] ]
   SetPenSize [2 2] MAKE "k 0
   REPEAT 4 [
      PU HOME PD RT 90 * :k MAKE "k :k + 1 SETPC ITEM :k :c
      Drag 11 90 5
   ]
END

to follow :tr1 :tr2
   SetTurtle :tr2
   Make "T Pos
   SetTurtle :tr1
   SETH Towards :T
   FD 2
end

to Andromeda
   SetScreenColor [150 150 150]
   SetTurtle 1 PU SETPOS [ -170 -170] PD
   SetTurtle 2 PU SETPOS [ -170  170] PD
   SetTurtle 3 PU SETPOS [  170  170] PD
   SetTurtle 4 PU SETPOS [  170 -170] PD
   repeat 170 [
      SetPC [000 000 255] follow 1 2
      SetPC [255 000 000] follow 2 3
      SetPC [255 255 000] follow 3 4
      SetPC [255 000 255] follow 4 1
   ]
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 (-:t) :h
   RT 45 - 3 * :t - :a FD :h  LT 45 - :t + :a
   Knu :n - 1 0 (-:t) :h RT :a
END

TO Knuth
   PU SETPOS [ 250 -130 ] PD LT 90
   SETPC [255 255 255] SetScreenColor [000 000 000]
   Knu 9 -90 45 8
END

TO Pean :n :a :h
   IF :n = 0 [STOP]
   RT :a Pean :n - 1 (-:a) :h FD :h Pean :n - 1 :a :h
   FD :h Pean :n - 1 (-:a) :h LT :a
END

TO Peano
   PU SETPOS [ -150 -160 ] PD SETPC [255 000 000] SetScreenColor [000 255 000]
   Pean 6 90 12
END

TO Sierp :n :a :h :k
   IF :n = 0 [ FD :k STOP ]
   RT :a Sierp :n - 1 (-:a) :h :k LT :a FD :h
   LT :a Sierp :n - 1 (-:a) :h :k RT :a
END

TO Sierpinski
   PU SETPOS [ -160 -170 ] PD SETPC [200 000 200] SetScreenColor [255 255 000]
   REPEAT 4 [ Sierp 7 45 12/sqrt 2 10 RT 45 FD 12/sqrt 2 RT 45 ]
   SetFloodColor [000 255 000] PU SetPos [-155 -170] 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 SETPC [0 0 0] SetScreenColor [255 255 000]
   Tr 10 120 1 / sqrt 2
END

TO wi :n :a :h :k
   IF :n = 0 [ FD :h STOP ]
   RT :a iw :n (-:a) :h :k LT :a FD :h
   LT :a iw :n (-:a) :h :k RT :a
END

TO iw :n :a :h :k
   RT :a wi :n - 1 (-:a) :h :k FD :k LT 2 * :a
   FD :k wi :n - 1 (-:a) :h :k RT :a
END

TO Wirth
   PU SETPOS [ -155 -153 ] PD SETPC [0 0 0] SetScreenColor [150 150 255]
   REPEAT 4 [ wi 4 45 7 3 FD 3 RT 90 FD 3 ] PU
   SetFloodColor [255 255 0] PU SetPos [-150 -150] 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 (-:a) :h/4 :w FD :h/8
   Cag :n - 1 :a :h/4 :w FD :h/8
   Cag :n - 1 (-:a) :h/4 :w LT :a
END

TO Cage
   PU SETPOS [ -160 -160 ] PD SETPC [0 0 0] SetScreenColor [255 100 100]
   Cag 4 90 320 320
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) SETPC :l Leaf SETPC :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
   (IF (:q < RANDOM 10) [MAKE "k 2] [MAKE "k 1])
   TreeB (:n - :k) :a
   LT :r
END

TO Trees
   MAKE "q 8 HT SetScreenColor [80 200 80]; RANDOMIZE
   MAKE "l [255 255 0] MAKE "t [0 0 0] MAKE "d 6 SETPC :t
   PU SETPOS [ -90 -160 ] PD SETH 0 TreeB 5 190
   MAKE "l [255 0 255] MAKE "t [255 0 0] MAKE "d 8 SETPC :t
   PU SETPOS [ 180 -100 ] PD SETH 0 TreeB 3 100
END

to GoodBye
   WindowDelete "SelWin
   SetScreenColor [255 255 255] SetPC [000 000 000] SetPenSize [1 1] cs
end

TO ReCurves
   CS HT
   WindowCreate "main "SelWin "Curves 0 0 80 200 []
   staticcreate "SelWin "st14 [Select a curve] 10 10 55 10
   ListBoxCreate "SelWin "SelList 10 25 55 100
   ListBoxAddString "SelList [Hilbert]
   ListBoxAddString "SelList [Sierpinski]
   ListBoxAddString "SelList [Trees]
   ListBoxAddString "SelList [Cage]
   ListBoxAddString "SelList [Andromeda]
   ListBoxAddString "SelList [Dragon]
   ListBoxAddString "SelList [Knuth]
   ListBoxAddString "SelList [Peano]
   ListBoxAddString "SelList [Dragons]
   ListBoxAddString "SelList [Tree]
   ListBoxAddString "SelList [Wirth]
   buttoncreate "SelWin "b1 "Exit  10 170 55 10 [GoodBye]
   buttoncreate "SelWin "b3 "Clear 10 155 55 10 [
      SetScreenColor [255 255 255] SetPC [000 000 000] SetPenSize [1 1] cs
   ]
   buttoncreate "SelWin "b2 "Draw  10 140 55 10 [
      SetPenColor [0 0 0] SetPenSize [2 2] SetScreenColor [255 255 255]
      PU Home PD CS HT
      Run  ListBoxGetSelect "SelList
   ]
END