AppTitle "Fractal 01"
SeedRnd MilliSecs()

Graphics 800,600,0,2
SetBuffer BackBuffer()


Global x_percent#=30
Global y_percent#=30

Global MAX_DEPTH = 20
Global depth

Dim col_r%(MAX_DEPTH)
Dim col_g%(MAX_DEPTH)
Dim col_b%(MAX_DEPTH)

For I = 0 To MAX_DEPTH
   col_r(I) = Rand(150,255)
   col_g(I) = Rand(150,255)
   col_b(I) = Rand(150,255)
Next


position_x# = 0
position_y# = 0
zoom# = 2.0

help = True

Global waittime=0
t=MilliSecs()

While Not KeyHit(1)
   Cls

   If KeyDown(203) Then x_percent# = x_percent# - (0.03*waittime)
   If KeyDown(205) Then x_percent# = x_percent# + (0.03*waittime)
   
   If KeyDown(208) Then y_percent# = y_percent# - (0.03*waittime)
   If KeyDown(200) Then y_percent# = y_percent# + (0.03*waittime)
   
   If KeyDown(78) Then zoom# = zoom# + (0.007*waittime)
   If KeyDown(74) Then zoom# = zoom# - (0.007*waittime)
   
   If KeyDown(17) Then position_y# = position_y# + (0.2*waittime)/zoom#
   If KeyDown(31) Then position_y# = position_y# - (0.2*waittime)/zoom#
   If KeyDown(32) Then position_x# = position_x# + (0.2*waittime)/zoom#
   If KeyDown(30) Then position_x# = position_x# - (0.2*waittime)/zoom#
   
   
   If x_percent# < 0 Then x_percent# = 0
   If y_percent# < 0 Then y_percent# = 0
   If x_percent# > 100 Then x_percent# = 100
   If y_percent# > 100 Then y_percent# = 100
   
   gw = GraphicsWidth()/2
   gh = GraphicsHeight()/2
   
   x1 = gw-(200.0+position_x#)*zoom#
   y1 = gh+(250.0+position_y#)*zoom#
   x2 = gw-(90.0+position_x#)*zoom#
   y2 = gh+(250.0+position_y#)*zoom#
   
   depth=0
   InitRect(x1,y1,x2,y2)
   DrawRect()
   
   ;SaveBuffer BackBuffer(),"render.bmp"
   ;ExecFile "mspaint render.bmp"
   ;End
   
   
   If KeyHit(35) Then help=1-help
   
   If help=1 Then
      Color 255,255,255
      
      Text 30,30,"Fractal 01 by Daniel Borchart"
      Text 30,55,"- use Arrowkeys to modify"
      Text 30,75,"- zoom with + / -"
      Text 30,95,"- move width W, A, S, D"
      Text 30,115,"- press h to hide text"
      
      fps% = Int(1000.0/Float(waittime))
      Text 790-StringWidth("Fps: "+fps),10,"Fps: "+fps
   EndIf
   

   Flip
   
   
   waittime=MilliSecs()-t
   t=MilliSecs()
Wend
End


Function InitRect(x1,y1,x2,y2)

   t.tRects = New tRects
   t\x1=x1
   t\y1=y1
   t\x2=x2
   t\y2=y2
   
   t\eot = True

End Function

Function DrawRect()

   depth = depth + 1
   If depth>MAX_DEPTH Then
   
      For t.tRects = Each tRects
         Delete t
      Next
   
      Return
   EndIf
   
   Color col_r(depth),col_g(depth),col_b(depth)
   
   
   For t.tRects = Each tRects

      l# = Sqr((t\x1-t\x2)*(t\x1-t\x2) + (t\y1-t\y2)*(t\y1-t\y2))
      a# = ATan2((t\y2-t\y1),(t\x2-t\x1))
   
      x3 = t\x1+Cos(a#-90.0)*l#
      y3 = t\y1+Sin(a#-90.0)*l#
   
      x4 = t\x2+Cos(a#-90.0)*l#
      y4 = t\y2+Sin(a#-90.0)*l#
      
      
      Line t\x1,t\y1,t\x2,t\y2
      Line t\x1,t\y1,x3,y3
      Line t\x2,t\y2,x4,y4
      Line x3,y3,x4,y4
      
      
      x5 = x3+Cos(a#)*l#*(x_percent#/100.0)  + Cos(a#-90)*l#*(y_percent#/100.0)
      y5 = y3+Sin(a#)*l#*(x_percent#/100.0)  + Sin(a#-90)*l#*(y_percent#/100.0)
   
      eot=t\eot
      Delete t
   
      If Abs(x3-x5)>1 Or Abs(y3-y5)>1 Then
         t_l.tRects = New tRects
         t_l\x1=x3
         t_l\y1=y3
         t_l\x2=x5
         t_l\y2=y5
         t_l\eot=False
      EndIf
      
      If Abs(x4-x5)>1 Or Abs(y4-y5)>1 Then
         t_r.tRects = New tRects
         t_r\x1=x5
         t_r\y1=y5
         t_r\x2=x4
         t_r\y2=y4
         t_r\eot=False
      EndIf
      
      If eot=True Then
         t_last.tRects = Last tRects
         If t_last <> Null Then t_last\eot=True
      EndIf
      
      If eot=True Then Exit
   
   Next
   
   DrawRect()
   
End Function


Type tRects
   Field x1,y1,x2,y2
   Field eot
End Type

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Const MIN_CX# = 0
Const MIN_CY# = 0
Const MAX_ITERATIONS = 255
Const MAX_NORM# = 200

Global Scale# = 0.00013
Global Displacement_X# = 13100
Global Displacement_Y# = -80

Timer = CreateTimer( 60 )

While Not KeyHit( 1 )
   Cls
   
   Counter = MilliSecs()
   BurningShip()
   Text 0, 0, ( MilliSecs() - Counter )
   
   ;Scale# = Scale# + ( KeyDown( 208 ) - KeyDown( 200 ) )*( Scale#/5 )
   Displacement_X# = Displacement_X# + ( KeyDown( 205 ) - KeyDown( 203 ) )*100
   
   Flip 0
   WaitTimer Timer
Wend
End

Function BurningShip()
   LockBuffer BackBuffer()
   For X = 0 To GWIDTH - 1
      Local CX# = MIN_CX# + ( X + Displacement_X# )*Scale#
      For Y = 0 To GHEIGHT - 1
         Local CY# = MIN_CY# + ( Y + Displacement_Y# )*Scale#
         
         Local Iteration = 0, X1# = 0, X2# = 0, Y1# = 0, Y2# = 0, X1SQ# = X1#*X1#, Y1SQ# = Y1#*Y1#
         While ( Iteration < MAX_ITERATIONS ) And ( X1SQ# + Y1SQ# < MAX_NORM# )
            X1SQ# = X1#*X1#
            Y1SQ# = Y1#*Y1#
            X2# = X1SQ# - Y1SQ# - CX#
            Y2# = 2*Abs( X1#*Y1# ) - CY#
            X1# = X2#
            Y1# = Y2#
            Iteration = Iteration + 1
         Wend
         
         Ratio# = Iteration/255.
         WritePixelFast X, GHEIGHT - Y - 1, $FF000000 + ( Ratio#*128 Shl 16 + Ratio#*255 Shl 8 + Ratio#*00 )
      Next
   Next
   UnlockBuffer BackBuffer()
End Function

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

SeedRnd MilliSecs()

Timer = CreateTimer( 60 )

Local Scale# = 30

While Not KeyHit( 1 )
   If ( KeyDown( 208 ) + KeyDown( 200 ) ) Then
      Cls
      Scale# = Scale# - KeyDown( 208 ) + KeyDown( 200 )
   EndIf
   
   Fractal_Farn( 10000, Scale# )
   
   Flip 0
   WaitTimer Timer
Wend
End

Function Fractal_Farn( Iterations, Scale# )
   Local X#, Y#, NewX#, NewY#
   
   LockBuffer BackBuffer()
   For i = 0 To Iterations
      Func = Rand( 1, 100 )
      
      If Func = 1 Then
         NewX# = 0
         NewY# = 0.16*Y#
      ElseIf Func > 1 And Func < 8 Then
         NewX# = 0.2*X# - 0.26*Y#
         NewY# = 0.23*X# + 0.22*Y# + 1.6
      ElseIf Func > 8 And Func < 15 Then
         NewX# = -0.15*X# + 0.28*Y#
         NewY# = 0.26*X# + 0.24*Y# + 0.44
      Else
         NewX# = 0.85*X# + 0.04*Y#
         NewY# = -0.04*X# + 0.85*Y# + 1.6
      EndIf
      
      WritePixel X#*Scale# + GWIDTH/2, GHEIGHT - Y#*Scale#, $FFFFFFFF
      
      X# = NewX#
      Y# = NewY#
   Next
   UnlockBuffer BackBuffer()
End Function

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Const DRAWSTEP = 10

Timer = CreateTimer( 60 )

Global Iterations = 1

While Not KeyHit( 1 )
   Cls
   
   ParsePenrose( LSystem( Iterations, "[7]++[7]++[7]++[7]++[7]", "6->81++91----71[-81----61]++,7->+81--91[---61--71]+,8->-61++71[+++81++91]-,9->--81++++61[+91++++71]--71,1->" ) )
   
   Iterations = Iterations + KeyHit( 200 ) - KeyHit( 208 )
   
   Flip 0
   WaitTimer Timer
Wend
End

Function LSystem$( Generations, StartString$, Rules$ )
   For i = 1 To Generations
      Local ResultString$ = ""
      For t = 1 To Len( StartString$ )
         Offset = Instr( Rules$, Mid( StartString$, t, 1 ) + "->" )
         
         If Offset Then
            Offset2 = Instr( Rules$, ",", Offset )
            If Not Offset2 Then Offset2 = Len( Rules$ ) + 1
            ResultString$ = ResultString$ + Mid( Rules$, Offset + 3, Offset2 - Offset - 3 )
         Else
            ResultString$ = ResultString$ + Mid( StartString$, t, 1 )
         EndIf
      Next
      
      StartString$ = ResultString$
   Next
   
   Return ResultString$
End Function

Function ParsePenrose( InString$ )
   Local X = GWIDTH/2, Y = GHEIGHT/2, Angle = 0
   Local Rotation[ 100 ], PositionX[ 100 ], PositionY[ 100 ]
   Local SavePointer
   
   LockBuffer BackBuffer()
   For i = 1 To Len( InString$ )
      Select Mid( InString$, i, 1 )
         Case "1"
            NewX = X + DRAWSTEP*Cos( Angle )
            NewY = Y + DRAWSTEP*Sin( Angle )
            
            Line X, Y, NewX, NewY
            
            X = NewX
            Y = NewY
         Case "+"
            Angle = Angle + 36
         Case "-"
            Angle = Angle - 36
         Case "["
            Rotation[ SavePointer ] = Angle
            PositionX[ SavePointer ] = X
            PositionY[ SavePointer ] = Y
            SavePointer = SavePointer + 1
         Case "]"
            SavePointer = SavePointer - 1
            Angle = Rotation[ SavePointer ]
            X = PositionX[ SavePointer ]
            Y = PositionY[ SavePointer ]
      End Select
   Next
   UnlockBuffer BackBuffer()
End Function

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Const DRAWSTEP = 5

Timer = CreateTimer( 60 )

Global Iterations = 1

While Not KeyHit( 1 )
   Cls
   
   ParsePlant( LSystem( Iterations, "--X", "X->F-[[X]+X]+F[+FX]-X,F->FF" ) )
   
   Iterations = Iterations + KeyHit( 200 ) - KeyHit( 208 )
   
   Flip 0
   WaitTimer Timer
Wend
End

Function LSystem$( Generations, StartString$, Rules$ )
   For i = 1 To Generations
      Local ResultString$ = ""
      For t = 1 To Len( StartString$ )
         Offset = Instr( Rules$, Mid( StartString$, t, 1 ) + "->" )
         
         If Offset Then
            Offset2 = Instr( Rules$, ",", Offset )
            If Not Offset2 Then Offset2 = Len( Rules$ ) + 1
            ResultString$ = ResultString$ + Mid( Rules$, Offset + 3, Offset2 - Offset - 3 )
         Else
            ResultString$ = ResultString$ + Mid( StartString$, t, 1 )
         EndIf
      Next
      
      StartString$ = ResultString$
   Next
   
   Return ResultString$
End Function

Function ParsePlant( InString$ )
   Local X, Y = GHEIGHT, Angle = 0
   Local Rotation[ 100 ], PositionX[ 100 ], PositionY[ 100 ]
   Local SavePointer
   
   LockBuffer BackBuffer()
   For i = 1 To Len( InString$ )
      Select Mid( InString$, i, 1 )
         Case "F"
            NewX = X + DRAWSTEP*Cos( Angle )
            NewY = Y + DRAWSTEP*Sin( Angle )
            
            Line X, Y, NewX, NewY
            
            X = NewX
            Y = NewY
         Case "+"
            Angle = Angle + 25
         Case "-"
            Angle = Angle - 25
         Case "["
            Rotation[ SavePointer ] = Angle
            PositionX[ SavePointer ] = X
            PositionY[ SavePointer ] = Y
            SavePointer = SavePointer + 1
         Case "]"
            SavePointer = SavePointer - 1
            Angle = Rotation[ SavePointer ]
            X = PositionX[ SavePointer ]
            Y = PositionY[ SavePointer ]
      End Select
   Next
   UnlockBuffer BackBuffer()
End Function

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Global Iterations = 1
Global DrawStep, AngleStep, StartString$, Rules$, StartX, StartY, DrawVariables$

ParseFile( "Fractal.txt" )

Timer = CreateTimer( 60 )

While Not KeyHit( 1 )
   Cls
   
   DrawCurve( LSystem( Iterations, StartString$, Rules$ ), DrawStep, AngleStep, DrawVariables$ )
   
   Iterations = Iterations + KeyHit( 200 ) - KeyHit( 208 )
   If Iterations = 0 Then Iterations = 1
   
   Flip 0
   WaitTimer Timer
Wend
End

Function ParseFile( Path$ )
   Instream = ReadFile( Path$ )
   
   If Not Instream Then RuntimeError Path$ + " konnte nicht geöffnet werden. Überprüfen sie deren Existenz."
   
   While Not Eof( Instream )
      ScriptLine$ = Trim( Replace( ReadLine( Instream ), " ", "" ) )
      
      If Instr( ScriptLine$, ";" ) Then ScriptLine$ = Left( ScriptLine$, Instr( ScriptLine$, ";" ) - 1 )
      
      Offset = Instr( ScriptLine$, "=" )
      
      If Offset Then
         Select Lower( Left( ScriptLine$, Offset - 1 ) )
            Case "startx"
               StartX = Int( Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) ) )
            Case "starty"
               StartY = Int( Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) ) )
            Case "drawstep"
               DrawStep = Int( Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) ) )
            Case "angle"
               AngleStep = Int( Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) ) )
            Case "start"
               StartString$ = Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) )
            Case "rules"
               Rules$ = Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) )
            Case "variables"
               DrawVariables$ = Mid( ScriptLine$, Offset + 1, Len( ScriptLine$ ) )
         End Select
      EndIf
   Wend
End Function

Function LSystem$( Generations, StartString$, Rules$ )
   For i = 1 To Generations
      Local ResultString$ = ""
      For t = 1 To Len( StartString$ )
         Offset = Instr( Rules$, Mid( StartString$, t, 1 ) + "->" )
         
         If Offset Then
            Offset2 = Instr( Rules$, ",", Offset )
            If Not Offset2 Then Offset2 = Len( Rules$ ) + 1
            ResultString$ = ResultString$ + Mid( Rules$, Offset + 3, Offset2 - Offset - 3 )
         Else
            ResultString$ = ResultString$ + Mid( StartString$, t, 1 )
         EndIf
      Next
      
      StartString$ = ResultString$
   Next
   
   Return ResultString$
End Function

Function DrawCurve( InString$, DrawStep, DrawAngle, Vars$ )
   Local X = StartX, Y = StartY, Angle = 0
   Local Rotation[ 100 ], PositionX[ 100 ], PositionY[ 100 ]
   Local SavePointer
   
   For i = 1 To Len( Vars$ )
      InString$ = Replace( Instring$, Mid( Vars$, i, 1 ), "F" )
   Next
   
   LockBuffer BackBuffer()
   For i = 1 To Len( InString$ )
      Select Mid( InString$, i, 1 )
         Case "F"
            NewX = X + DrawStep*Cos( Angle )
            NewY = Y + DrawStep*Sin( Angle )
            
            Line X, Y, NewX, NewY
            
            X = NewX
            Y = NewY
         Case "+"
            Angle = Angle + DrawAngle
         Case "-"
            Angle = Angle - DrawAngle
         Case "f"
            X = X + DrawStep*Cos( Angle )
            Y = Y + DrawStep*Sin( Angle )
         Case "["
            Rotation[ SavePointer ] = Angle
            PositionX[ SavePointer ] = X
            PositionY[ SavePointer ] = Y
            SavePointer = SavePointer + 1
         Case "]"
            SavePointer = SavePointer - 1
            Angle = Rotation[ SavePointer ]
            X = PositionX[ SavePointer ]
            Y = PositionY[ SavePointer ]
      End Select
   Next
   UnlockBuffer BackBuffer()
End Function

Graphics 1280,1024,16,1

Type entity
   Field x#,y#,dir#,scale#
   Field handled, art ;Art: 1 = Quadrat, 2 = Dreieck
End Type

Const variante = 1 ;1 = In eine Richtung, 2 = in 2 Richtungen

If variante = 1 Then
   t.entity = New entity
   t\x# = 580
   t\y# = 900
   t\dir# = 0
   t\scale# = 180
   t\handled = 0
   t\art = 1
Else
   t.entity = New entity
   t\x# = 580
   t\y# = 602
   t\dir# = 0
   t\scale# = 100
   t\handled = 0
   t\art = 1
   
   t.entity = New entity
   t\x# = 680
   t\y# = 602
   t\dir# = 180
   t\scale# = 100
   t\handled = 0
   t\art = 2
EndIf

Const tiefe = 50
Const logtype = 2 ;0=kein, 1=write, 2=text
Const waitk = 0 ;waitkey enabled/disabled

For i = 0 To tiefe
   If logtype = 1 Then
      Write i+";"
   EndIf
   If logtype = 2 Then
      Color 0,0,0
      Rect 9,9,100,20
      Color 255,255,255
      Text 10,10,i+"/"+tiefe
   EndIf
   
   For t.entity = Each entity ;DREIECK
      If KeyHit(1) Then End
      If t\handled = 0 Then
         If t\art = 2 Then
            t\handled = 1
            ;drawtriangle(t\x#,t\y#,t\dir#,t\scale#)
            
            e.entity = New entity
            e\x# = t\x#
            e\y# = t\y#
            e\dir# = t\dir#-37
            e\scale = t\scale*.8
            e\handled = 0
            e\art = 1
            
            e.entity = New entity
            e\x# = t\x#+Cos(t\dir#-37)*t\scale#*.8
            e\y# = t\y#+Sin(t\dir#-37)*t\scale#*.8
            e\dir# = t\dir#+53
            e\scale = t\scale*.6
            e\handled = 0
            e\art = 1
            Delete t.entity
         EndIf
      EndIf
   Next
   
   For t.entity = Each entity ;QUADRATE
      If KeyHit(1) Then End
      If t\handled = 0 Then
         If t\art = 1 Then
            t\handled = 1
            drawquad(t\x#,t\y#,t\dir#,t\scale#)
            
            e.entity = New entity
            e\x# = t\x#+Cos(t\dir#-90)*t\scale
            e\y# = t\y#+Sin(t\dir#-90)*t\scale
            e\dir# = t\dir#
            e\scale = t\scale
            e\handled = 0
            e\art = 2
            Delete t.entity
         EndIf
      EndIf
   Next
   If i = tiefe Then Text 640,10,"FERTIG",1,1
   If waitk Then WaitKey
Next
WaitKey

xx#=4.0
yy#=4.0

Graphics xx*200,yy*200,32,2

LockBuffer FrontBuffer()

For x#=-xx To xx Step .01
   
   For y#=-yy To yy Step .01
      
      hoehe%=Normalisieren(Hoch(x,y),-0.04999,1.75,0,255)
      
      fx%=Int((x+xx)*100)
      fy%=Int((y+yy)*100)
      
      rgb=hoehe*$10000+hoehe*$100+hoehe
      
      If fx<xx*200 And fy<yy*200 Then WritePixelFast fx,fy,rgb,FrontBuffer()
   Next
Next

UnlockBuffer FrontBuffer()

WaitKey

End

Function Hoch#(x1#,y1#)
   
   Local z#=2.0
   Local xa#=0.0
   Local ya#=0.0
   Local xc#=x1
   Local yc#=y1
   Local x2#,y2#,xn#
   
   Repeat
      
      x2=Abs(xa)
      y2=Abs(ya)
      
      xn=x2-y2-xc
      
      ya=xa*ya
      ya=ya+ya-yc
      
      xa=xn
      
      z=z-.05
      
      If z<=0 Or (x2+y2>=1000) Then Return z
      
   Forever
   
End Function

Function Normalisieren#(value#=128.0,value_min#=0.0,value_max#=255.0,norm_min#=0.0,norm_max#=1.0)
   
   Return ((value-value_min)/(value_max-value_min))*(norm_max-norm_min)+norm_min
   
End Function

;Ax# ist der Xwert des Punkt A
;ay# ist der Ywert des Punkt A
;d# ist der Winkel zur Waagerechten
;s# ist die Länge aller seiten im Quadrat
;a# ist der Winkel im Dreieck
;mtie ist die maximale Tiefe
;zufall kann die werte 1 und 0 annehmen und entscheidet ob die winkel zufällieg sind oder nicht

Function Baum (ax#,ay#,d#,s#,a#,mtie,zufall,wach)
    SeedRnd MilliSecs ()
   
    If KeyHit (1) Then End ;Damit die Function beendet werden kann (Falls es zu lange dauert)
   
    rx# = Cos (d) * s
    ry# = Sin (d) * s
   
    bx# = ax# + rx#
    by# = ay# - ry#
   
    cx# = bx# - ry#
    cy# = by# - rx#
   
    dx# = cx# - rx#
    dy# = cy# + ry#
   
    f = 90 - (a + d)
   
    de# = Cos (a) * s#
   
    ec# = Sqr ( (s#^2) - (de#^2) )
   
    df# = Cos (f) * de#
   
    fe# = Sin (f) * de#
   
    ex# = dx# + fe#
    ey# = dy# - df#
   
    ; Farben der Linien
    LockBuffer BackBuffer()
    If tiefe < mtie - 1 Then Color 128 ,64,0
    If tiefe > mtie - 2 Then Color 0 ,Rnd (50 ,220) ,0
    Line bx#,by#,cx#,cy#
    If tiefe > mtie - 2 Then Color 0 ,Rnd (50 ,220) ,0
    Line dx#,dy#,ax#,ay#
 
    If pytlin=1 Then
     Line ax#,ay#,bx#,by# ;Line Unten
     Line cx#,cy#,dx#,dy# ;Line Oben
    EndIf

    If tiefe > mtie - 1 Then
        Line ex#,ey#,cx#,cy# ;Das Dreieck (wird nur am Ende Gestzt)
        Line ex#,ey#,dx#,dy#
    EndIf
    UnlockBuffer BackBuffer()
    Color 255 ,255,255 ;Wieder auf Weiß stellen
   
 

   
    If wach = 1 Then
        Flip
    EndIf
   
    If tiefe < mtie Then
        tiefe = tiefe + 1
       
        If zufall = 1 Then
            Baum (dx#,dy#,a# + d#,de#,Rand (30 ,70) ,mtie,zufall,wach)
            Baum (ex#,ey#,a# + d# - 90 ,ec#,Rand (30 ,70) ,mtie,zufall,wach)
         Else
            Baum (dx#,dy#,a# + d#,de#,a#,mtie,zufall,wach)
            Baum (ex#,ey#,a# + d# - 90 ,ec#,a#,mtie,zufall,wach)
        EndIf
       
        tiefe = tiefe - 1
    EndIf
   
End Function

win=CreateWindow("Einstellungen",10,10,200,500,0,1)
button=CreateButton("Erstellen",45,400,100,50,win)
talp=CreateLabel("Winkel von Alpha(<90):",10,42,120,20,win)
anzwin=CreateTextField(140,40,20,20,win)
SetGadgetText anzwin,"45"
twinwa=CreateLabel("Winkel zur Waagerechten:",10,82,130,20,win)
tfwinwa=CreateTextField(140,80,20,20,win)
SetGadgetText tfwinwa,"0"
tmtie=CreateLabel("Anzahl der Iterationen:",10,122,130,20,win)
tfmtie=CreateTextField(140,120,20,20,win)
SetGadgetText tfmtie,"10"
tgro=CreateLabel("Größe des Quadrates:",10,162,110,20,win)
tfgro=CreateTextField(120,160,40,20,win)
SetGadgetText tfgro,"50"
hilfs=CreateButton("Hilfslinien",50,270,100,20,win,2)
butwa=CreateButton("Baum wächst",50,300,100,20,win,2)
butzuf=CreateButton("Zufall",50,330,100,20,win,2)



Graphics 800 ,600,16,2
SetBuffer BackBuffer ()
Global tiefe,pytlin=0


Repeat
   If GetKey()=27 Then End
   Select WaitEvent()
      Case $803 : End
   End Select
   sou=EventSource ()
   Select sou
   Case button
        Cls
           winkalp=TextFieldText (anzwin)
      winwa=TextFieldText(tfwinwa)
         mtie=TextFieldText(tfmtie)
         gro=TextFieldText(tfgro)
         DisableGadget button
              Baum (400,400,winwa,gro,winkalp,mtie,zufall,wach)
      EnableGadget button
              Flip
   Case butzuf
     If zufall=0 Then
           zufall=1
     Else
           zufall=0
     EndIf
   Case butwa
    If wach=0 Then
          wach=1
    Else
        wach=0
    EndIf
   Case hilfs
    If pytlin=0 Then
          pytlin=1
    Else
        pytlin=0
    EndIf
   End Select
Forever


;Ax# ist der Xwert des Punkt A
;ay# ist der Ywert des Punkt A
;d# ist der Winkel zur Waagerechten
;s# ist die Länge aller seiten im Quadrat
;a# ist der Winkel im Dreieck
;mtie ist die maximale Tiefe
;zufall kann die werte 1 und 0 annehmen und entscheidet ob die winkel zufällieg sind oder nicht

Function Baum (ax#,ay#,d#,s#,a#,mtie,zufall,wach)
    SeedRnd MilliSecs ()
   
    If KeyHit (1) Then End ;Damit die Function beendet werden kann (Falls es zu lange dauert)
   
    rx# = Cos (d) * s
    ry# = Sin (d) * s
   
    bx# = ax# + rx#
    by# = ay# - ry#
   
    cx# = bx# - ry#
    cy# = by# - rx#
   
    dx# = cx# - rx#
    dy# = cy# + ry#
   
    f = 90 - (a + d)
   
    de# = Cos (a) * s#
   
    ec# = Sqr ( (s#^2) - (de#^2) )
   
    df# = Cos (f) * de#
   
    fe# = Sin (f) * de#
   
    ex# = dx# + fe#
    ey# = dy# - df#
   
    ; Farben der Linien
    LockBuffer BackBuffer()
    If tiefe < mtie - 1 Then Color 128 ,64,0
    If tiefe > mtie - 2 Then Color 0 ,Rnd (50 ,220) ,0
    Line bx#,by#,cx#,cy#
    If tiefe > mtie - 2 Then Color 0 ,Rnd (50 ,220) ,0
    Line dx#,dy#,ax#,ay#
 
    If pytlin=1 Then
     Line ax#,ay#,bx#,by# ;Line Unten
     Line cx#,cy#,dx#,dy# ;Line Oben
    EndIf

    If tiefe > mtie - 1 Then
        Line ex#,ey#,cx#,cy# ;Das Dreieck (wird nur am Ende Gestzt)
        Line ex#,ey#,dx#,dy#
    EndIf
    UnlockBuffer BackBuffer()
    Color 255 ,255,255 ;Wieder auf Weiß stellen
   
 

   
    If wach = 1 Then
        Flip
    EndIf
   
    If tiefe < mtie Then
        tiefe = tiefe + 1
       
        If zufall = 1 Then
            Baum (dx#,dy#,a# + d#,de#,Rand (30 ,70) ,mtie,zufall,wach)
            Baum (ex#,ey#,a# + d# - 90 ,ec#,Rand (30 ,70) ,mtie,zufall,wach)
         Else
            Baum (dx#,dy#,a# + d#,de#,a#,mtie,zufall,wach)
            Baum (ex#,ey#,a# + d# - 90 ,ec#,a#,mtie,zufall,wach)
        EndIf
       
        tiefe = tiefe - 1
    EndIf
   
End Function