Spass mit Turtle

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
remi_meier
Beiträge: 1078
Registriert: 29.08.2004 20:11
Wohnort: Schweiz

Spass mit Turtle

Beitrag von remi_meier »

Stichworte:
- Interfaces
- Turtle graphics / Schildkrötengrafik
- Rekursion
- Fraktale
- Sierpinski, Peano, Koch

Have fun!

Code: Alles auswählen

Interface ITurtle
	PenDown()
	PenUp()
	MoveTo(x.f, y.f)
	SetColor(Color.l)
	SetDir(Angle.f)
	Turn(Angle.f)
	Forward(Steps.f)
EndInterface

Structure cTurtle
	VTable.l
	
	; Functions
	fPenDown.l
	fPenUp.l
	fMoveTo.l
	fSetColor.l
	fSetDir.l
	fTurn.l
	fForward.l
	
	; Data
	x.f
	y.f
	angle.f
	pen.l
	color.l
EndStructure


Procedure turtle_PenDown(*this.cTurtle)
	*this\pen = #True
EndProcedure

Procedure turtle_PenUp(*this.cTurtle)
	*this\pen = #False
EndProcedure

Procedure turtle_MoveTo(*this.cTurtle, x.f, y.f)
	*this\x = x
	*this\y = y
EndProcedure

Procedure turtle_SetColor(*this.cTurtle, Color.l)
	*this\color = Color
EndProcedure

Procedure turtle_SetDir(*this.cTurtle, Angle.f)
	*this\angle = Angle
EndProcedure

Procedure turtle_Turn(*this.cTurtle, Angle.f)
	*this\angle + Angle
EndProcedure

Procedure turtle_Forward(*this.cTurtle, Steps.f)
	Protected x.f, y.f
	
	x = *this\x
	y = *this\y
	*this\x + Cos(*this\angle) * Steps
	*this\y + Sin(*this\angle) * Steps
	
	If *this\Pen
		LineXY(x, y, *this\x, *this\y, *this\color)
	EndIf
EndProcedure



Procedure.l new_turtle()
	Protected *t.cTurtle
	
	*t = AllocateMemory(SizeOf(cTurtle))
	*t\VTable = *t + OffsetOf(cTurtle\fPenDown)
	
	*t\fPenDown		= @turtle_PenDown()
	*t\fPenUp			= @turtle_PenUp()
	*t\fMoveTo		= @turtle_MoveTo()
	*t\fSetColor	= @turtle_SetColor()
	*t\fSetDir		= @turtle_SetDir()
	*t\fTurn			= @turtle_Turn()
	*t\fForward		= @turtle_Forward()
	
	ProcedureReturn *t
EndProcedure


Procedure.f D2R(x.f)
	ProcedureReturn x / 360.0 * 2 * 3.1415926
EndProcedure




Global *s.ITurtle


Procedure DrawSierpinski(t, s.f)
	If t = 0
		*s\Forward(s)
	Else
		DrawSierpinski(t - 1, s / 3)
		*s\Turn(D2R(-60))
		DrawSierpinski(t - 1, s / 3)
		*s\Turn(D2R(120))
		DrawSierpinski(t - 1, s / 3)
		*s\Turn(D2R(-60))
		DrawSierpinski(t - 1, s / 3)
	EndIf
EndProcedure

Procedure DrawKoch(t, s.f)
	If t = 0
		*s\Forward(s)
	Else
		DrawKoch(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawKoch(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawKoch(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawKoch(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawKoch(t - 1, s / 3)
	EndIf
EndProcedure

Procedure DrawPeano(t, s.f)
	If t = 0
		*s\Forward(s)
	Else
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(-90))
		DrawPeano(t - 1, s / 3)
		*s\Turn(D2R(90))
		DrawPeano(t - 1, s / 3)
	EndIf
EndProcedure

Procedure DrawTemp1(t, s.f)
	If t = 0
		*s\Forward(s)
	Else
		DrawTemp1(t - 1, s / 3)
		*s\Turn(D2R(-60))
		DrawTemp1(t - 1, s / 3)
		*s\Turn(D2R(-60))
		DrawTemp1(t - 1, s / 3)
		*s\Turn(D2R(60))
		DrawTemp1(t - 1, s / 3)
		*s\Turn(D2R(-60))
		DrawTemp1(t - 1, s / 3)
	EndIf
EndProcedure



img = CreateImage(#PB_Any, 500, 500)

OpenWindow(0, 200,200, 500,500, #PB_Window_SystemMenu|#PB_Window_ScreenCentered, "Turtle")
CreateGadgetList(WindowID())
	ImageGadget(1, 0,0, 500,500, UseImage(img))


*s = new_turtle()
StartDrawing(ImageOutput())

	*s\SetColor($FF)
	*s\PenDown()
	
	
	*s\SetDir(D2R(0))
	*s\MoveTo(50, 100)
	DrawSierpinski(3, 150)
	
	*s\SetDir(D2R(0))
	*s\MoveTo(300, 100)
	DrawKoch(3, 150)
	
	*s\SetDir(D2R(0))
	*s\MoveTo(50, 200)
	DrawPeano(3, 150)
	
	*s\SetDir(D2R(0))
	*s\MoveTo(300, 200)
	DrawTemp1(3, 150)
	
StopDrawing()

SetGadgetState(1, UseImage(img))

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow