Der Krug geht zum Brunnen bis er bricht

Donnerstag, 15. Juli 2010 von darth

Hallo,

ich bin gerade daran mir die notwendigen Komponenten für mein geplantes Spiel zusammenzustellen. Die Physikengine kann momentan eigentlich so ziemlich alles was ich möchte (auch wenn die Kollisionsantwort bei konkaven Objekten noch besser sein könnte). Also arbeitete ich am nächsten Teil, der Spielfigur.

Animation in 3D

Für ein früheres Spiel habe ich mal ein XML-Animationsformat aufgestellt das ich dann geparst habe. Allerdings war dieser Parser enorm umständlich und unübersichtlich, also habe ich ihn neu geschrieben, nun ist er handlicher und verständlicher (und hält sich grösstenteils an meine eigenen Code-Konventionen). Das System basiert auf Joints, die je nach "Iterations"-Tiefe zu Knochen verwandelt werden, man kann den Knochen Meshes zuweisen wenn man will (mit bevorzugter Grösse), ansonsten wird eine Stange als Knochen erstellt. Hier ein Beispiel:



Bei der Animation werden die Knochen auf (ca) konstanter Länge gehalten mit einer Verlet-artigen Stauchung/Streckung, das kann dazu führen, dass der Endzustand der Animation jeweils ein wenig anders aussieht. Man kann das (im Code..) ausschalten, indem man eine Zeile auskommentiert. Wer das System in Aktion erleben möchte, kann sich hier das Programm herunterladen, inklusive 3D-Animations-Parser-Code. Mit der Leertaste kann man das Skelett laufen lassen, Pfeiltasten drehen die Kamera im Kreis um die Figur.

Ich habe nicht vor die 3D-Version weiterzuverwenden. Dies aus zwei Gründen: Es passt nicht in den Rest des Spiels (das 2D und "2.5D" ist) und es ist absolut mühsam die Animationen zu machen, es hat viel zu viele Punkte auf die man achten muss, das wird mühsam -.-

Animation in 2D

Aus den oben erwähnten Gründen habe ich beschlossen, das System um eine Dimension zu kürzen. Es funktioniert nun (auch) in 2(.5)D. Statt der Meshes kann man nun Bilder angeben, die als Sprite geladen werden. Die Figur hat auch eine Richtung, entweder nach rechts (=1) oder nach links (=-1) schauend. Das sieht etwa so aus:



Die Rechtecke im Hintergrund sind die Verknüpfung der Animation mit der DaDaPhysik, die Figur wird an die Stelle des roten Klotzes gestellt, so kann ich ziemlich einfach Kollisionen für Sprünge und ähnliches einbauen. Allerdings it das Prinzip noch nicht wirklich steuerungstechnisch ausgereift, es fühlt sich lahm und wackelig an, da bin ich noch ein wenig am experimentieren. (Anm: Eine SNES Sprite-Animation hat etwa 4 Frames pro Schritt, meine Figur hat 60.. und der Sprung ist enorm verzögert, weil er sich zuerst duckt und dann abspringt.) Sobald ich in dieser Hinsicht etwas Interessantes erreiche, werde ich das wahrscheinlich zeigen

(Gekürzt auf das Wesentliche.. sprich: Setter/Getter gestrichen)
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

Global RENDERCAM

Function initRenderCam()
	RENDERCAM=CreateCamera()
	
	TurnEntity RENDERCAM, 180, 0, 0
	PositionEntity RENDERCAM, GraphicsWidth()/2, GraphicsHeight()/2, GraphicsWidth()/2
	
	CameraClsMode RENDERCAM, 0, 1
End Function

;/*
; * Figure Definition
; */

Const MAX_JOINTS=50
Const MAX_BONES=50
Const MAX_ANIMSEQ=20
Const MAX_KEYFRAME=10

Type TFigure
	Field posX#
	Field posY#
	
	Field phiZ#
	
	Field dir
	
	Field jList.TJoint[MAX_JOINTS]
	Field jCount
	Field bList.TBone[MAX_BONES]
	Field bCount
	
	Field aList.TAnimationSequence[MAX_ANIMSEQ]
	Field aCount
	
	Field frame
	Field kf
	Field animRunning ;=-1 falls keine Animation läuft
	
	Field relX#
	Field relY#
	
	Field dX#
	Field dY#
	
	Field piv
	
	Field vX#
	Field vY#
End Type

Type TAnimationSequence
	Field kList.TKeyframe[MAX_KEYFRAME]
	Field kCount
End Type

Type TKeyframe
	Field endFrame
	
	Field jList.TJoint[MAX_JOINTS]
	Field jCount
	
	Field posX#
	Field posY#
End Type

Type TJoint
	Field x#
	Field y#
	
	Field parent.TJoint
	Field cList.TJoint[MAX_JOINTS]
	Field cCount
	
	Field vX#
	Field vY#
	
	Field name$
	
	Field fix
End Type

Type TBone
	Field j1.TJoint
	Field j2.TJoint
	
	Field length#
	
	Field sprite
End Type

;/*
; * String Handling
; */

Const MAX_SPLITS=64
Function splitString(source$, splitter$[MAX_SPLITS], splitterCount, split$[MAX_SPLITS])
	Local idx=0
	Local pos, minPos, minSplit
	
	While Len(source)>0
		minPos=Len(source)
		minSplit=-1
		
		For i=0 To splitterCount-1
			pos=Instr(source, splitter[i])
			
			If pos<minPos And pos>0
				minPos=pos
				minSplit=i
			EndIf
		Next
		
		pos=minPos
		
		If pos=0 Or minSplit=-1
			split[idx]=Mid(source, 1, Len(source))
			idx=idx+1
			
			Exit
		Else
			split[idx]=Mid(source, 1, pos-1)
			idx=idx+1
			
			If Len(split[idx-1])=0
				idx=idx-1
			EndIf
			
			source=Right(source, Len(source)-pos-Len(splitter[minSplit])+1)
		EndIf
	Wend
	
	Return idx
End Function

Function cleanStringSplit(split$[MAX_SPLITS], count)
	Local charsLeft$[2]
	Local charsRight$[2]
	
	charsLeft[0]="<"
	charsLeft[1]="'"
	
	charsRight[0]=">"
	charsRight[1]="'"
	
	Local chg=True
	
	While chg
		chg=False
		
		For i=0 To count-1
			For j=0 To 1
				If Left(split[i], 1)=charsLeft[j]
					split[i]=Right(split[i], Len(split[i])-1)
					chg=True
				EndIf
				
				If Right(split[i], 1)=charsRight[j]
					split[i]=Left(split[i], Len(split[i])-1)
					chg=True
				EndIf
			Next
		Next
	Wend
	
	For i=0 To count-1
		split[i]=Lower(split[i])
	Next
End Function

Function stringMid$(txt$,start,stopp)
	Return Mid(txt$,start+1,stopp-start-1)
End Function

Function loadFigure.TFigure(file$)
	Local stream=ReadFile(file)
	
	If stream=0
		RuntimeError "File does not exist"
	EndIf
	
	Local f.TFigure=New TFigure
	Local a.TAnimationSequence
	Local k.TKeyframe
	
	Local sLine$
	Local split$[MAX_SPLITS], sCount
	
	Local splitter$[MAX_SPLITS]
	splitter[0]=" "
	splitter[1]="="
	
	Local jStack.TJoint[MAX_JOINTS]
	Local sIdx
	
	Local vertexMode=0
	
	Local x#, y#, z#
	
	f\piv=CreatePivot()
	f\animRunning=-1
	
	f\dir=1
	
	While Not Eof(stream)
		sLine=Trim(ReadLine(stream))
		
		If Left(sLine, 1)="<"
			sLine=Right(sLine, Len(sLine)-1)
		EndIf
		If Right(sLine, 1)=">"
			sLine=Left(sLine, Len(sLine)-1)
		EndIf
		
		For i=0 To MAX_SPLITS-1
			split[i]=""
		Next
		
		sCount=splitString(sLine, splitter, 2, split)
		cleanStringSplit(split, sCount)
		
		;dbg$=""
		;For i=0 To sCount-1
		;	dbg=dbg+split[i]+" "
		;Next
		;DebugLog dbg
		
		Select split[0]
			;/*
			; * Joint
			; */
				
			Case "joint"
				jStack[sIdx]=newJoint(0, 0)
				sIdx=sIdx+1
				
				If sIdx>1
					jStack[sIdx-1]\parent=jStack[sIdx-2]
					
					jStack[sIdx-2]\cList[jStack[sIdx-2]\cCount]=jStack[sIdx-1]
					jStack[sIdx-2]\cCount=jStack[sIdx-2]\cCount+1
				EndIf
				
				If vertexMode=0 ;Fill into Figure
					f\jList[f\jCount]=jStack[sIdx-1]
					f\jCount=f\jCount+1
				Else ;Fill into Keyframe
					If k<>Null
						addJointToKeyframe(k, jStack[sIdx-1])
					EndIf
				EndIf
				
				For i=1 To sCount-1
					Select split[i]
						Case "name"
							jStack[sIdx-1]\name=split[i+1]
							
							i=i+1
						Case "coo", "coords", "coordinates"
							jStack[sIdx-1]\x=Float(split[i+1])
							jStack[sIdx-1]\y=Float(split[i+2])
							
							i=i+3
					End Select
				Next
				
				If vertexMode=0
					If sIdx>1
						;								parent			child
						f\bList[f\bCount]=newBone(jStack[sIdx-2], jStack[sIdx-1])
						f\bCount=f\bCount+1
						
						For i=1 To sCount-1
							Select split[i]
								Case "sprite", "bonesprite"
									f\bList[f\bCount-1]\sprite=nLoadSprite(split[i+1], 1+4)
									
									EntityFX f\bList[f\bCount-1]\sprite, 16+1
									;SpriteViewMode f\bList[f\bCount-1]\sprite, 2
									
									;ScaleSprite f\bList[f\bCount-1]\sprite, f\bList[f\bCount-1]\length/2*1.2, f\bList[f\bCount-1]\length/2*1.2
									ScaleEntity f\bList[f\bCount-1]\sprite, f\bList[f\bCount-1]\length/2*1.2, f\bList[f\bCount-1]\length/2*1.2, 1
									
									i=i+1
								Case "order"
									If f\bList[f\bCount-1]\sprite<>0
										EntityOrder f\bList[f\bCount-1]\sprite, Int(split[i+1])
									EndIf
									
									i=i+1
							End Select
						Next
						
						If f\bList[f\bCount-1]\sprite=0
							f\bList[f\bCount-1]\sprite=nCreateSprite()
							
							EntityFX f\bList[f\bCount-1]\sprite, 16+1
							;SpriteViewMode f\bList[f\bCount-1]\sprite, 2
							
							;ScaleSprite f\bList[f\bCount-1]\sprite, 2, f\bList[f\bCount-1]\length/2
							ScaleEntity f\bList[f\bCount-1]\sprite, 2, f\bList[f\bCount-1]\length/2, 1
						EndIf
					EndIf
				EndIf
				
				If split[sCount-1]="/"
					sIdx=sIdx-1
				EndIf
			Case "coo", "coord", "coordinates"
				If sIdx>0
					For i=1 To sCount-1
						If split[i]<>"/"
							Select i
								Case 1
									jStack[sIdx-1]\x=Float(split[i])
								Case 2
									jStack[sIdx-1]\y=Float(split[i])
							End Select
						Else
							Exit
						EndIf
					Next
				EndIf
			Case "name"
				If sIdx>0
					jStack[sIdx-1]\name=split[1]
				EndIf
			Case "/joint"
				sIdx=sIdx-1
				
			;/*
			; * Bone
			; */
				
			Case "sprite", "bonesprite"
				If f\bList[f\bCount-1]\sprite<>0
					FreeEntity f\bList[f\bCount-1]\sprite
				EndIf
				
				f\bList[f\bCount-1]\sprite=nLoadSprite(split[1], 1+4)
				
				EntityFX f\bList[f\bCount-1]\sprite, 16+1
				;SpriteViewMode f\bList[f\bCount-1]\sprite, 2
			Case "order"
				If f\bList[f\bCount-1]\sprite<>0
					EntityOrder f\bList[f\bCount-1]\sprite, Int(split[1])
				EndIf
				
			;/*
			; * Animation
			; */
				
			Case "animation", "anim"
				sIdx=0
				
				a=newAnimationSeq()
				
				f\aList[f\aCount]=a
				f\aCount=f\aCount+1
				
				vertexMode=1
			Case "/animation", "/anim"
				a=Null
				
				vertexMode=0
				
			;/*
			; * Keyframe
			; */
				
			Case "keyframe", "kf"
				k=newKeyframe()
				
				If a<>Null
					a\kList[a\kCount]=k
					a\kCount=a\kCount+1
				EndIf
				
				For i=1 To sCount-1
					Select split[i]
						Case "frame", "endframe", "f"
							k\endFrame=Int(split[2])
					End Select
				Next
				
				vertexMode=1
			Case "frame", "endframe", "f"
				If k<>Null
					k\endFrame=Int(split[1])
				EndIf
			Case "pos", "position"
				If k<>Null
					k\posX=Float(split[1])
					k\posY=Float(split[2])
				EndIf
			Case "/keyframe", "/kf"
				k=Null
				
				vertexMode=0
				
			;/*
			; * Uhm.. dunno what else
			; */
				
			Default
			;	DebugLog split[0]
		End Select
	Wend
	
	f\jList[0]\fix=True
	
	Return f
End Function

Function nLoadSprite(path$, mode)
	Local tmpSprite=CreateMesh()
	Local tmpSurf=CreateSurface(tmpSprite)
	
	v1=AddVertex(tmpSurf, -1, -1, 0, 0, 1)
	v2=AddVertex(tmpSurf, 1, -1, 0, 1, 1)
	v3=AddVertex(tmpSurf, -1, 1, 0, 0, 0)
	v4=AddVertex(tmpSurf, 1, 1, 0, 1, 0)
	
	AddTriangle(tmpSurf, v1, v2, v3)
	AddTriangle(tmpSurf, v2, v4, v3)
	
	EntityTexture tmpSprite, LoadTexture(path, mode)
	
	Return tmpSprite
End Function

Function nCreateSprite()
	Local tmpSprite=CreateMesh()
	Local tmpSurf=CreateSurface(tmpSprite)
	
	v1=AddVertex(tmpSurf, -1, -1, 0, 0, 1)
	v2=AddVertex(tmpSurf, 1, -1, 0, 1, 1)
	v3=AddVertex(tmpSurf, -1, 1, 0, 0, 0)
	v4=AddVertex(tmpSurf, 1, 1, 0, 1, 0)
	
	AddTriangle(tmpSurf, v1, v2, v3)
	AddTriangle(tmpSurf, v2, v4, v3)
	
	Return tmpSprite
End Function

;/*
; * Figure Functions
; */

Function newFigure.TFigure()
	Local f.TFigure=New TFigure
	
	f\posX=0
	f\posY=0
	
	f\animRunning=-1
	
	f\piv=CreatePivot()
	
	Return f
End Function

Function moveFigure(f.TFigure, x#, y#)
	Local piv=CreatePivot()
	
	PositionEntity piv, f\posX, f\posY, 0
	RotateEntity piv, 0, 0, f\phiZ
	MoveEntity piv, x, y, 0
	
	f\posX=EntityX(piv)
	f\posY=EntityY(piv)
	
	FreeEntity piv
End Function

Function updateFigure(f.TFigure)
	If f\animRunning>-1
		nextFrame(f)
	EndIf
	
	moveFigure(f, f\vX, f\vY)
	
	For i=0 To 5
		adjustFigureLength(f)
	Next
	createFigureModel(f)
End Function

Function destroyFigure(f.TFigure)
	For i=0 To f\bCount-1
		FreeEntity f\bList[i]\sprite
		Delete f\bList[i]
	Next
	
	For i=0 To f\jCount-1
		Delete f\jList[i]
	Next
	
	Delete f
End Function

Function createFigureModel(f.TFigure)
	Local trash, x1#, y1#, x2#, y2#, length#
	
	RotateEntity f\piv,0,0,0
	PositionEntity f\piv,0,0,0
	
	For i=0 To f\bCount-1
		trash=f\bList[i]\sprite
		
		If trash<>0
			EntityParent trash, 0
			
			x1#=f\bList[i]\j1\x
			y1#=f\bList[i]\j1\y
			
			x2#=f\bList[i]\j2\x
			y2#=f\bList[i]\j2\y
			
			PositionEntity trash, (x1+x2)/2, (y1+y2)/2, 0
			RotateEntity trash, 0, 180, 180+ATan2(x2-x1, y2-y1)
			
			EntityParent trash, f\piv
		EndIf
	Next
	
	PositionEntity f\piv, f\posX, f\posY, 0
	
	If f\dir=1
		RotateEntity f\piv, 0, 0, f\phiZ
	EndIf
	If f\dir=-1
		RotateEntity f\piv, 0, 180, f\phiZ
	EndIf
End Function

Function newJoint.TJoint(x#, y#)
	Local j.TJoint=New TJoint
	
	j\x=x
	j\y=y
	
	j\cCount=0
	
	Return j
End Function

Function addJointToKeyframe(k.TKeyframe, j.TJoint)
	k\jList[k\jCount]=j
	k\jCount=k\jCount+1
End Function

Function getJointFromKeyframe.TJoint(k.TKeyframe, name$)
	name=Lower(name)
	
	For i=0 To k\jCount-1
		If k\jList[i]\name$=name$
			Return k\jList[i]
		EndIf
	Next
	
	Return Null
End Function

Function cloneJoint.TJoint(j.TJoint)
	Local jc.TJoint=New TJoint
	
	jc\x=j\x
	jc\y=j\y
	
	jc\name=j\name
	
	Return jc
End Function

Function newBone.TBone(j1.TJoint, j2.TJoint)
	Local b.TBone=New TBone
	
	b\j1=j1
	b\j2=j2
	
	b\length=Sqr((j1\x-j2\x)^2+(j1\y-j2\y)^2)
	
	Return b
End Function

Function newAnimationSeq.TAnimationSequence()
	Return New TAnimationSequence
End Function

Function newKeyframe.TKeyframe()
	Return New TKeyframe
End Function

Function animateFigure(f.TFigure, seq=0)
	Local copy.TJoint
	
	f\kf=0
	f\frame=0
	
	If seq>=f\aCount
		Return
	EndIf
	
	f\animRunning=seq
	
	If f\aList[seq]\kList[0]\endFrame=0 Then
		For i=0 To f\jCount-1
			copy=getJointFromKeyframe(f\aList[seq]\kList[0], f\jList[i]\name$)
			
			If copy<>Null
				f\jList[i]\x=copy\x
				f\jList[i]\y=copy\y
			EndIf
		Next
		
		f\posX=f\posX+f\aList[seq]\kList[0]\posX
		f\posY=f\posY+f\aList[seq]\kList[0]\posY
		
		f\relX=f\aList[seq]\kList[0]\posX*f\dir
		f\relY=f\aList[seq]\kList[0]\posY
		
		moveFigure(f, f\relX, f\relY)
	Else
		setAnimationVelocity(f)
	EndIf
End Function

Function nextFrame(f.TFigure)
	Local copy.TJoint
	Local seq=f\animRunning
	
	If f\frame>=f\aList[seq]\kList[f\kf]\endFrame
		f\kf=f\kf+1
		
		If f\kf>=f\aList[seq]\kCount
			f\animRunning=-1
			f\frame=0
			f\kf=0
			
			Return
		Else
			setAnimationVelocity(f)
		EndIf
	EndIf
	
	For i=0 To f\jCount-1
		f\jList[i]\x=f\jList[i]\x+f\jList[i]\vX
		f\jList[i]\y=f\jList[i]\y+f\jList[i]\vY
	Next
	
	moveFigure(f, f\dX, f\dY)
	
	f\relX=f\relX+f\dX
	f\relY=f\relY+f\dY
	
	f\frame=f\frame+1
End Function

Function setAnimationVelocity(f.TFigure)
	Local x1#, y1#, x2#, y2#
	
	Local copy.TJoint
	Local seq=f\animRunning
	Local ef=f\aList[seq]\kList[f\kf]\endFrame
	
	For i=0 To f\jCount-1
		copy=getJointFromKeyframe(f\aList[seq]\kList[f\kf], f\jList[i]\name$)
		
		If copy<>Null
			x1#=f\jList[i]\x
			y1#=f\jList[i]\y
			
			x2#=copy\x
			y2#=copy\y
			
			f\jList[i]\vX=(x2-x1)/(ef-f\frame)
			f\jList[i]\vY=(y2-y1)/(ef-f\frame)
		Else
			f\jList[i]\vX=0
			f\jList[i]\vY=0
		EndIf
	Next
	
	f\dX=(f\aList[seq]\kList[f\kf]\posX*f\dir-f\relX)/(ef-f\frame)
	f\dY=(f\aList[seq]\kList[f\kf]\posY-f\relY)/(ef-f\frame)
End Function

Function adjustFigureLength(f.TFigure)
	For i=0 To f\bCount-1
		stretchBone(f\bList[i])
	Next
End Function

Function stretchBone(b.TBone)
	Local dx#, dy#, deltaL#, diff#
	
	Local j1.TJoint
	Local j2.TJoint
	
	j1=b\j1
	j2=b\j2
	
	dx#=j1\x-j2\x
	dy#=j1\y-j2\y
	
	deltaL#=Sqr(dx^2+dy^2)
	diff#=0.5*(b\length-deltaL)/deltaL
	
	If j1\fix Or j2\fix
		diff=diff*2
	EndIf
	
	If Not j1\fix
		j1\x=j1\x+dx*diff
		j1\y=j1\y+dy*diff
	EndIf
	
	If Not j2\fix
		j2\x=j2\x-dx*diff
		j2\y=j2\y-dy*diff
	EndIf
End Function

Edit: Nach dem Versagen der Sprite Variante habe ich die Sprites nun durch kleine quadratische Meshes ersetzt, ich habe es noch nicht testen lassen, aber ich hoffe es funktioniert nun besser.

Ich wollte die Animation in irgend einem lustigen Spielchen testen, allerdings war mir ein gescheites Jump&Run zu viel Aufwand (und zu träge, siehe oben). Im Chat hatten wir es (aus irgend einem Grund :> ) von Point&Click Adventures, und da wollte ich das mal ausprobieren. Von daher habe ich mich hingesetzt und ein kurzes Point&Click Spielchen geschrieben. Da ich kein Grafiker bin und auch keine Erfahrung im Rätsel stellen habe, spielt sich alles nur in einem Raum ab. Ausserdem ist alles absolut hardgecoded, weil ich nicht noch ein Scriptsystem oder ähnliches entwickeln wollte. Aber eigentlich macht mir sowas einen Haufen Spass. Vielleicht mach ich daran noch weiter..



Eine kurze Erklärung zum Spiel:
Ganz oben ist eine Zeile in der eure letzte Aktion/Mitteilung geschrieben steht, wenn ihr etwas aufhebt, steht da "You got .." und weitere auftretende Vorkommnisse.
Im Kreis unten links steht, welche Aktion gerade ausgewählt ist. Wenn ihr die rechte Maustaste drückt erscheint ein Auswahlmenü über der Figur, fahrt mit der Maus auf die Aktion die ihr auswählen möchtet und lasst die rechte Maustaste los. Dann könnt ihr auf eine Zone klicken und die Aktion wird ausgeführt.
Im Kreis unten rechts steht, welches Item ihr ausgewählt habt, klickt mit der linken Maustaste in den Kreis um zum nächsten verfügbaren Objekt zu wechseln.

Hier gehts zum Download, ich hoffe das Spiel ist soweit Bug-frei und alle Dateien sind vorhanden :/ Ich sollte mir wirklich mal einen Content-Manager oder sowas schreiben, damit mir auffällt wenn ich etwas vergesse. Naja, Zeit hätte ich ja

Edit: Hmm, ich habe gerade erfahren, dass der Code bei (mindestens einer) gewissen Grafikkarten scheinbar Probleme macht (meine Vermutung liegt bei der Sprite-Verwendung die zickt). Aus diesem Grund habe ich dem Archiv den Code beigelegt (wollte ich vermeiden :> ist ein ziemlich grausamer Stil), damit ihr bei einem MAV testen könnt, wo der Fehler auftritt.
Edit: Ich habe die Version geändert, es ist nun auch hier nicht länger Sprite sondern Surface-basiert. Hoffentlich funktioniert das nun bei (fast) allen.

Inventarsystem

Als letzes noch etwas das ich zu verwenden gedenke, wessen ich mir aber noch nicht sicher bin. Ich habe ein kleines "Inventar"-System geschrieben. Eigentlich habe ich vor, in meinem Spiel eine Art von Zauberei einzuführen, und dies wollte ich dann dazu verwenden, die verschiedenen Sprüche auszuwählen. Mal sehen was daraus wird So wie ich mich und meine Planung kenne, weiss ich nicht ob ich die Idee fallen lassen werde oder durchziehe, die Zeit wirds zeigen. Bildchen gibts nicht (es sind ein paar nummerierte Rechtecke, die im Kreis angeordnet sind, whoo!). Zum Ausprobieren:

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * TItem
; *
; * TInventory
; */

Type TItem
	;füllen nach belieben
End Type

Function newItem.TItem()
	Return New TItem
End Function

Const MAX_ITEMS=128
Const MAX_RAD#=100

Type TInventory
	Field posX
	Field posY
	
	Field turning
	Field turnPhi
	
	Field turnStep#
	
	Field rad#
	Field open
	
	Field pos
	
	Field iList.TItem[MAX_ITEMS]
	Field iCount
End Type

Function newInventory.TInventory()
	Local i.TInventory=New TInventory
	
	i\turnStep=10
	
	i\turnPhi=1
	i\turning=False
	
	i\pos=0
	
	Return i
End Function

Function setInventoryPosition(inv.TInventory, x, y)
	inv\posX=x
	inv\posY=y
End Function

Function addItemToInveotory(inv.TInventory, it.TItem)
	If inv\iCount>=MAX_ITEMS
		Return
	EndIf
	
	inv\iList[inv\iCount]=it
	inv\iCount=inv\iCount+1
End Function

Function removeItemFromInventory(inv.TInventory, it.TItem)
	For i=0 To inv\iCount-1
		If inv\iList[i]=it
			removeEntryFromInvetory(inv, i)
		EndIf
	Next
End Function

Function removeEntryFromInvetory(inv.TInventory, i)
	For j=i+1 To inv\iCount-1
		inv\iList[j-1]=inv\iList[j]
	Next
	inv\iList[inv\iCount-1]=Null
	
	inv\iCount=inv\iCount-1
End Function

Function drawInventory(inv.TInventory)
	If Not inv\open
		Return
	EndIf
	
	Local phi#, it.TItem, posX#, posY#
	
	phi=360./inv\iCount
	
	For i=0 To inv\iCount-1
		posX=inv\posX + Cos(i*phi + inv\pos*phi + inv\turnPhi -90)*inv\rad
		posY=inv\posY + Sin(i*phi + inv\pos*phi + inv\turnPhi -90)*inv\rad
		
		Rect posX,posY,32,32,0
		Text posX,posY,i
		
		Count=Count+1
	Next
End Function

Function turnInventory(inv.TInventory, steps=10)
	If Not inv\open
		Return
	EndIf
	
	Local it.TItem
	
	If Not inv\turning
		If KeyDown(203)
			inv\turnPhi=-1
			
			inv\turning=True
		EndIf
		
		If KeyDown(205)
			inv\turnPhi=1
			
			inv\turning=True
		EndIf
	EndIf
	
	If inv\turning
		inv\turnStep=inv\turnStep+1
		
		inv\turnPhi=inv\turnPhi+360./inv\iCount/steps*Sgn(inv\turnPhi)
		
		If inv\turnStep>=steps
			inv\turning=False
			
			inv\pos=(inv\pos+Sgn(inv\turnPhi)) Mod inv\iCount
			
			inv\turnPhi=0
			inv\turnStep=0
		EndIf
	EndIf
End Function

Function openInventory(inv.TInventory, steps=10)
	inv\open=True
	inv\rad=0
	
	Local dRad#=MAX_RAD/steps
	
	For i=0 To steps-1
		inv\rad=inv\rad+dRad
		
		Cls
		drawInventory(inv)
		Flip
	Next
End Function

Function closeInventory(inv.TInventory, steps=10)
	inv\rad=MAX_RAD
	
	Local dRad#=MAX_RAD/steps
	
	For i=0 To steps-1
		inv\rad=inv\rad-dRad
		
		Cls
		drawInventory(inv)
		Flip
	Next
	
	inv\open=False
End Function

;/*
; * Test Program
; */

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

Local inv.TInventory=newInventory()
setInventoryPosition(inv, 400, 300)

timer=CreateTimer(60)
While Not KeyHit(1)
	
	;If Not inv\turning
	If KeyHit(30)
		addItemToInveotory(inv, newItem())
	EndIf
	;EndIf
	
	drawInventory(inv)
	turnInventory(inv)
	
	If KeyHit(57)
		If inv\open
			closeInventory(inv)
		Else
			openInventory(inv)
		EndIf
	EndIf
	
	Flip 0
	WaitTimer(timer)
	Cls
Wend
End

Mit [A] fügt man neue Items in den Kreis ein, mit [Space] öffnet und schliesst man das Inventar und mit den Pfeiltasten [Links] und [Rechts] dreht man das Inventar (das obere Objekt ist das ausgewählte, sollte man vielleicht noch markieren..).

Ende

So, das wärs für diesmal. Ich hoffe dass ich irgendwann die Motivation finde ein wenig intensiver zu arbeiten, bisher schaue ich lieber irgendwelche doofen Filme (meine Güte, "Avatar: The last Airbender" war ziemlich mies :/ ), oder lese Comics. Ferien sind doch etwas tolles!

So, schöne Ferien wünsche ich auch euch,
MfG,
Darth

Sommer, Sonne, Sonnenschein

Samstag, 26. Juni 2010 von darth

Hallo,

nach den letzten beiden Prüfungen habe ich nun wieder ein bisschen Zeit etwas von meiner Arbeit vorzustellen. Dann gehts wieder zurück ans Lernen. Aufgrund der Prüfungsphase, wird dieser Eintrag wahrscheinlich auch nicht so vielseitig wie vorgängige Exemplare, aber vielleicht tut etwas Kohärenz diesem Worklog gar nicht so schlecht. Nun denn, auf zur Tat!

Polygon Schatten

Wo Licht ist, sollte auch Schatten sein, sonst schwitzt man zu sehr. Ausserdem gibt Schatten einer Szene etwas mehr Realität (hoffentlich :>). Ich habe im Internet einen GameDev Artikel gefunden und nach dessen Anleitung einen "harten" Schatten gebastelt. Ich spare mir das posten des Codes, weil ähnliche Ansätze schon im Code - Archiv zu finden sind.



Ich benutze hierfür die gleichen Types wie in meiner PhysikRoutine, deshalb könnte man beide ziemlich einfach in einem Spiel parallel verwenden. Ich werde das allerdings nicht direkt in die Physik einbauen, weil ... deshalb!
Theoretisch könnte man auch Schatten von verschiedenen Lichtern einbauen (ich habs mal eingeführt, und dann wieder verworfen), allerdings sieht das nicht so toll aus, da ich kein Licht berechne, sondern halt eben nur den Schatten, und verschiedenfarbige Schatten (mit unterschiedlichen Alphas) sehen nicht wirklich toll aus, wenn ich vielleicht mit Licht arbeiten würde, dann könnte es etwas anderes werden, mal sehn.
Wer das Programm in Aktion sehen möchte, kann es hier herunterladen und ausprobieren. Beschreibung steht im Fenster, daher nur kurz: Maus bewegt die Lichtquelle, Pfeil rauf/runter ändert die Transparenz des Schattens [0, 1].

Feuer

Wenn man schon Schatten hat, braucht man auch etwas, das Schatten wirft! Licht. Weil Licht langweilig ist, dachte ich mir, als durchgeknallter Pyromane, ich mache ein Feuerchen. Im Internet fand ich ein ziemlich geniales Processing Applet, das eine ziemlich hübsche Feuersimulation bietet. So wie ich das sehe, arbeitet es mit dem ungefähr gleichen Stokes Löser, den ich im letzten Eintrag vorgestellt habe. Zusätzlich fand ich im Codearchiv einen ziemlich hübschen Ansatz von Krümel. Der benutzt zur Renderung ein Mesh, dessen Vertices er verfärbt. Dieses Prinzip habe ich mal flux übernommen und bei meinem Ding eingebaut. Dadurch kann ich jetzt Alpha und Überlagerung nutzen.
Damit habe ich mich dran gesetzt, Feuer zu basteln. Es ist eigentlich das gleiche. Ich habe eine neue "Matrix" eingeführt (jetzt sind es zwei: eine für Hitze, die andere für Rauch).



Zur Färbung des Feuers benutze ich ein Spektrum, das ich im Internet gefunden habe (.. leider finde ich den Link zur Seite nichtmehr ). Eigentlich wurde dabei nur die Strahlung eines schwarzen Körpers berechnet, aber das ist mit BB ziemlich mühsam (weil die Werte von 470*10^-6 für eine Wellenlänge bis 3*10^8 für Lichtgeschwindigkeit gehen), daher das Bild.
Das Ergebnis wird mit einer Kamera gerendert, die den 2D Stoff nicht löscht, das heisst, ich kann Feuer in ein Bild simulieren. Hier das Original, und da mein Feuer:



Das Ganze ist ziemlich langsam, leider. Ausserdem kommt es kaum an das Vorbild heran. Im Moment verwende ich 2 separate Meshes, in einem wird das Feuer, im anderen der Rauch gerendert. Ich kann die beiden natürlich auch verschmelzen, das beschleunigt das Programm ein wenig. Allerdings leidet dabei die Qualität, ziemlich viel Kontrast geht verloren, ein Bild als Illustration (links: die momentane Version, rechts: beides in einem):



Natürlich ist es möglich, dass ich bei der Überlagerung einen Fehler mache, darüber werd ich nochmal nachdenken. Allerdings ist auch das schnellere System (meiner Meinung nach) zu langsam, um in einem Spiel vernünftig eingesetzt werden zu können, deshalb werde ich das (vorläufig) nicht tun, oder nur in kleinen Dimensionen. Die FeuerRaster sind nämlich beliebig dimensionierbar (müssen nicht quadratisch sein, gibt aber eine Maximalgrösse).
Wer es ausprobieren möchte, kann es hier herunterladen. Auf Mausklick wird neues Feuer erzeugt.

-----

DaDaPhysics

There are three things i wanted to share about DaDaPhysics.
First off, is the water simulation. I tried changing the interaction between a body and the water-surface to make it more accurate, the only problem is, that there never seems to be an equilibrium, everything always moves - I did not particularly like this, so I changed it back.

Edit: Well, I went ahead and cheated a little. I made a threshold (on the body speed) for the wave displacement, now I can use my a little more accurate intersection test. Now I have the effect, that the body will be moved if there is a wave. Well, that's good enough for the moment.

The second thing is the splitter implementation. As you might remember, I had a huge worklog entry describing my failure trying to program a physical splitting of the body. So i settled for a given split by a square inside the body. I changed that, now the splitting is randomized, for a more interesting result.
And third, i tried a stress-test for my polygon-decomposition-algorithm (dividing a given polygon into convex subparts). I did that with a sketching-sandbox as seen in Phun or Crayon Physics.



I had some difficulties for specific types of drawings (try drawing a rectangle, and it will most certainly crash.. or just calculate forever) - which means, that the algorithm is not perfect. An error I knew would occur was for self-intersecting polygons, just .. don't do that, it's weird! But for simpler structures (with not that many points) it works pretty well.
Another error I observed: for huge concave objects there are some slight errors in the collision response (because of the distance). As for very slim (sub)objects, there can be some jumps in the response.
Because of these errors, i did not just yet implement it fully into the physics-routine, it is a separate program, that can be downloaded here.

Edit: I changed the drawing system a little, the polygon is now not iteratively found from the subbodys, but rather precalculated (before the decomposition) and saved as a list of indices, which map to the subbody and vector in order of appearance in the polygon. Now there can not be a array-overflow in the translation algorithm, and it is a lot faster than before. So .. win-lose (because it needs more memory) for me.

-----

So, das wars von meiner Seite, ich wünsche der Leserschaft ein schönes Wochenende, auf dass man die Sonne noch ein Weilchen geniessen möge.

MfG,
Darth

I am sailing

Freitag, 28. Mai 2010 von darth

Hallo,

es wird Sommer, das bedeutet, es wird warm, richtig heiss sogar. Also sucht man Abkühlung, und weil ich als Paradenerd lieber im kühlen Kellerzimmer hocke statt hinaus in ein Schwimmbad zu gehen, habe ich mir Wasser programmiert. Traurig, nichtwahr?
Aber zuerst etwas anderes.

Punkte:

Geometrische Algorithmen sind immer etwas Schönes, sind auch nützlich für verschiedene Dinge. Eigentlich habe ich die paar Algorithmen geschrieben, um sie in meinem Wasserding zu verwenden und dann festgestellt, dass es eigentlich viel zu aufwändig ist und einfacher gehen würde.
Hier die (grobe) Problemstellung: Gegeben ist eine Anzahl von Punkten in beliebiger Anordnung. Finde eine (minimale) konvexe Hülle um diese Punkte.
Zuerst sucht man eine konkave Hülle durch alle Punkte und nimmt dan die Verbindungen raus, die zu einem konkaven Knick führen würden, dieses Prinzip nennt man den Graham Scan Algorithmus, prinzipiell ordnet man einfach alle Punkte nach dem Winkel zu einem Startpunkt. Diesen Punkt muss man so wählen, dass er garantiert auf der Hülle liegt, also z.b den Punkt ganz unten links.
Nach der Hülle wollte ich dann die Fläche bestimmen, welche die Punkte benötigen. Dazu habe ich die Punkte mit dem Delaunay Algorithmus trianguliert und dann einfach die Flächen der Dreiecke addiert. (Anm: Im gegensatz zum Subtracting Ears Algorithmus trienguliert man hier nicht ein beliebiges Polygon, sondern das Polygon der konvexen Hülle!)



Der Triangulierungs-Algorithmus ist relativ einfach und vielseitig einsetzbar, für was auch immer man sich vorstellen könnte. Ich habe hier eine eher aufwändigere Methode gewählt (weil sie einfacher ist ), es gibt soweit ich weiss noch eine, die in O(n*log(n)) läuft, aber ich fand nirgends eine wirkliche Beschreibung dazu, nur ständige Verweise auf Voronoi Diagrammerzeugung (dadurch kriegt man Delaunay praktisch "geschenkt"). Und das war mir zu blöd.
Anm1: Es hat eine kleine Unsauberheit im Algorithmus, wenn man ein perfektes Rechteck zeichnet, kann dieses nicht zerlegt werden, ich werde noch versuchen das zu beheben.
Anm2: Alle Algorithmen behandeln im Moment alle Punkte (der Einfachheit halber), allerdings ist das Prinzip des Algorithmus ziemlich einfach anzupassen, dass man den Funktionen auch eine Liste von Punkten mitgeben kann, ich habe das bloss noch nicht so gemacht, kommt vielleicht noch.

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * Grundstruktur
; *
; *		TPoint
; *			x		X-Koordinate
; *			y		Y-Koordinage
; *			succ	Nächster Pfadpunkt
; *
; *		newPoint(x, y)
; *			erstellt einen neuen Punkt
; *
; *		comparePoints(p1, p2)
; *			Vergleichsoperation für die Sortierung
; *
; *		isCCW(p1, p2, p3)
; *			Prüfung auf Richtung (CounterClockWise - entgegen dem Uhrzeigersinn)
; *
; *		drawPoint(p, radius)
; *			zeichnet den Punkt mit gegebenem Radius
; *
; *		drawAllPoints(radius)
; *			zeichnet alle Punkte mit gegebenem Radius
; */

Type TPoint
	Field x#
	Field y#
	
	Field succ.TPoint
End Type

Function newPoint.TPoint(x#, y#)
	Local p.TPoint=New TPoint
	
	p\x=x
	p\y=y
	
	Return p
End Function

Function comparePoints(p1.TPoint, p2.TPoint)
	f#=p1\x*p2\y-p2\x*p1\y
	
	If f>0
		Return True
	EndIf
	
	If f>=-0.0001 ; == 0
		If Abs(p1\x)+Abs(p1\y)>Abs(p2\x)+Abs(p2\y)
			Return True
		EndIf
	EndIf
	
	Return False
End Function

Function isCCW(p1.TPoint, p2.TPoint, p3.TPoint)
	Return (p2\x-p1\x)*(p3\y-p1\y)-(p2\y-p1\y)*(p3\x-p1\x)
End Function

Function drawPoint(p.TPoint, rad#=2)
	Oval p\x-rad, p\y-rad, 2*rad, 2*rad
End Function

Function drawAllPoints(rad#=2)
	Local p.TPoint
	
	For p=Each TPoint
		drawPoint(p, rad)
	Next
End Function

;/*
; * Grundstruktur
; *
; *		TTriangle
; *			p1		Punkt 1
; *			p2		Punkt 2
; *			p3		Punkt 3
; *
; *		newTriangle(p1, p2, p3)
; *			erstellt ein neues Dreieck
; *
; *		drawTriangle(t)
; *			zeichnet ein Dreieck
; *
; *		drawAllTriangles()
; *			zeichnet alle Dreiecke
; *
; *		triangleArea()
; *			liefert die Fläche eines Dreiecks zurück
; */

Type TTriangle
	Field p1.TPoint
	Field p2.TPoint
	Field p3.TPoint
End Type

Function newTriangle.TTriangle(p1.TPoint, p2.TPoint, p3.TPoint)
	Local t.TTriangle=New TTriangle
	
	t\p1=p1
	t\p2=p2
	t\p3=p3
	
	Return t
End Function

Function drawTriangle(t.TTriangle)
	Line t\p1\x, t\p1\y, t\p2\x, t\p2\y
	Line t\p2\x, t\p2\y, t\p3\x, t\p3\y
	Line t\p3\x, t\p3\y, t\p1\x, t\p1\y
End Function

Function drawAllTriangles()
	Local t.TTriangle
	
	For t=Each TTriangle
		drawTriangle(t)
	Next
End Function

Function triangleArea#(t.TTriangle)
	Local x1#, y1#, x2#, y2#
	
	x1=t\p2\x-t\p1\x
	y1=t\p2\y-t\p1\y
	
	x2=t\p3\x-t\p1\x
	y2=t\p3\y-t\p1\y
	
	Return 0.5*Abs(x1*y2-y1*x2)
End Function

;/*
; * Hull Finder
; *
; *		MAX_POINTS
; *			Anzahl an maximal unterstützter Punkte
; *
; *		buildConvexHull()
; *			liefert eine verkettete Liste der Hüllenpunkte
; *
; *		buildConcaveHull()
; *			liefert eine verkettete Liste des Pfades durch alle Punkte
; *
; *		quickSort(p[], lo, hi)
; *			sortiert die Liste der Punkte
; *
; *		makeRelTo(p[], count, p0)
; *			verschiebt die Punkte ins Koordinatensystem von p0
; *
; *		indexOfLowestPoint(p[], count)
; *			Punkt mit dem kleinsten Y-Wert (und bei doppelten, mit dem kleinsten X-Wert)
; *
; *		exchange(p[], i, j)
; *			vertauscht Punkte i und j
; *
; *		drawHull(p)
; *			zeichnet die Hülle vom Startpunkt der verketteten Liste aus
; */

Const MAX_POINTS=100

Function buildConvexHull.TPoint()
	Local points.TPoint[MAX_POINTS]
	Local pCount=0
	
	Local p.TPoint
	
	For p=Each TPoint
		p\succ=Null
		
		points[pCount]=p
		pCount=pCount+1
	Next
	
	If pCount<3
		Return Null
	EndIf
	
	exchange(points, 0, indexOfLowestPoint(points, pCount))
	
	Local pl.TPoint=newPoint(points[0]\x, points[0]\y)
	makeRelTo(points, pCount, pl)
	
	quickSort(points, 1, pCount-1)
	
	pl\x=-pl\x : pl\y=-pl\y
	makeRelTo(points, pCount, pl)
	
	Delete pl
	
	Local m=2
	For i=3 To pCount-1
		While isCCW(points[m-1], points[m], points[i:1])<=0
			m=m-1
		Wend
		
		m=m+1
		exchange(points, m, i)
	Next
	
	For i=1 To m
		points[i-1]\succ=points[i]
	Next
	
	Return points[0]
End Function

Function buildConcaveHull.TPoint()
	Local points.TPoint[MAX_POINTS]
	Local pCount=0
	
	Local p.TPoint
	
	For p=Each TPoint
		p\succ=Null
		
		points[pCount]=p
		pCount=pCount+1
	Next
	
	If pCount<3
		Return Null
	EndIf
	
	exchange(points, 0, indexOfLowestPoint(points, pCount))
	
	Local pl.TPoint=newPoint(points[0]\x, points[0]\y)
	makeRelTo(points, pCount, pl)
	
	quickSort(points, 1, pCount-1)
	
	pl\x=-pl\x : pl\y=-pl\y
	makeRelTo(points, pCount, pl)
	
	Delete pl
	
	For i=1 To pCount-1
		points[i-1]\succ=points[i]
	Next
	
	Return points[0]
End Function

Function quickSort(p.TPoint[MAX_POINTS], lo, hi)
	Local i=lo, j=hi
	Local q.TPoint=p[(lo+hi)/2]
	
	While i<=j
		While comparePoints(p[i], q)
			i=i+1
		Wend
		
		While comparePoints(q, p[j])
			j=j-1
		Wend
		
		If i<=j
			exchange(p, i, j)
			i=i+1
			j=j-1
		EndIf
	Wend
	
	If lo<j
		quickSort(p, lo, j)
	EndIf
	
	If i<hi
		quickSort(p, i, hi)
	EndIf
End Function

Function makeRelTo(p.TPoint[MAX_POINTS], count, p0.TPoint)
	Local p1.TPoint=newPoint(p0\x, p0\y)
	
	For i=0 To count-1
		p[i]\x=p[i]\x-p1\x
		p[i]\y=p[i]\y-p1\y
	Next
	
	Delete p1
End Function

Function indexOfLowestPoint(p.TPoint[MAX_POINTS], count)
	Local i, min=0
	
	For i=1 To count-1
		If p[i]\y>p[min]\y Or (p[i]\y=p[min]\y And p[i]\x<p[min]\x)
			min=i
		EndIf
	Next
	
	Return min
End Function

Function exchange(p.TPoint[MAX_POINTS], i, j)
	Local t.TPoint=p[i]
	p[i]=p[j]
	p[j]=t
End Function

Function drawHull(p.TPoint)
	Local started, oldX#, oldY#
	
	Local startX#=p\x
	Local startY#=p\y
	
	Local pStart.TPoint=p
	
	While p<>Null
		If Not started
			oldX=p\x
			oldY=p\y
			
			started=True
		Else
			Line oldX, oldY, p\x, p\y
			
			oldX=p\x
			oldY=p\y
		EndIf
		
		p=p\succ
		
		If p=pStart
			Exit
		EndIf
	Wend
	
	If started
		Line oldX, oldY, startX, startY
	EndIf
End Function

;/*
; * Delaunay Triangulation
; *
; *		generateDelaunay()
; *			erstellt die Delaunay Triangulation der gegebenen Punkte
; */

Function generateDelaunay()
	Delete Each TTriangle
	
	Local p1.TPoint, p2.TPoint, p3.TPoint, p4.TPoint, t.TTriangle
	Local pointValid, mx#, my#, rad#, m1x#, m1y#, n1x#, n1y#, m2x#, m2y#, n2x#, n2y#, k#
	
	For p1=Each TPoint
		p2=After p1
		While p2<>Null
			p3=After p2
			While p3<>Null
				m1x=(p1\x+p2\x)/2
				m1y=(p1\y+p2\y)/2
				
				n1x=p2\y-p1\y
				n1y=p1\x-p2\x
				
				m2x=(p2\x+p3\x)/2
				m2y=(p2\y+p3\y)/2
				
				n2x=p3\y-p2\y
				n2y=p2\x-p3\x
				
				k=-(m1x*n2y-m1y*n2x-m2x*n2y+m2y*n2x)/(n1x*n2y-n1y*n2x)
				
				mx=m1x+k*n1x
				my=m1y+k*n1y
				
				rad=Sqr((p1\x-mx)^2+(p1\y-my)^2)
				
				pointValid=True
				For p4=Each TPoint
					If p4<>p1 And p4<>p2 And p4<>p3
						If Sqr((p4\x-mx)^2+(p4\y-my)^2)<=rad
							pointValid=False
							Exit
						EndIf
					EndIf
				Next
				
				If pointValid
					t=newTriangle(p1, p2, p3)
				EndIf
				
				p3=After p3
			Wend
			
			p2=After p2
		Wend
	Next
End Function

;/*
; * Test Programm
; */

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

Local p.TPoint
Local t.TTriangle

Local Timer=CreateTimer(60)
While Not KeyHit(1)
	Color 0,255,0
	If MouseHit(1)
		p=newPoint(MouseX(), MouseY())
	EndIf
	
	drawAllPoints(4)
	
	Color 255,255,0
	generateDelaunay()
	drawAllTriangles()
	
	Color 0,0,255
	p=buildConcaveHull()
	If p<>Null
	;	drawHull(p)
	EndIf
	
	Color 255,255,255
	p=buildConvexHull()
	If p<>Null
	;	drawHull(p)
	EndIf
	
	Flip 0
	WaitTimer(Timer)
	Cls
Wend
End

Stokes:

Ich habe mal versucht sowas wie "realistisches" Feuer zu gestalten. Dies ist eigentlich nur ein Test, dienend zur Grundlagenforschung. Nach den Stoke'schen Gleichungen, dazu gibt es viele Tutorials im Netz, die man ziemlich gut umsetzen kann. Eigentlich sind es gekoppelte Differentialgleichungen höherer Ordnung die man da zu lösen hat. Im Allgemeinen macht man das nicht von Hand (es sei denn man ist wahnsinnig oder hat genügend Zeit und Erfahrung), sondern numerisch. Genau das macht man in den beschriebenen Tutorials.



Das Prinzip ist Grid-based. Gerendert werden aufgeblasene Pixel (mit Rechtecken aus Lines, im LockBuffer Modus schnell genug). Wie gesagt ist das Programm als Grundlagenforschung gedacht, eigentlich möchte ich daraus eine kleine Partikelengine basteln, um lustige Dinge wie Fackeln oder Ähnliches zu simulieren. Ich möchte nicht einfach zufällig Partikel ausspucken, das sieht nicht wirklich toll aus (hab ich irgendwann mal gemacht und sollte irgendwo auf der Platte zu finden sein.. egal). Programm zum rumspielen kann hier heruntergeladen werden, Code im Paket. Steuerung ist ziemlich einfach, Maus drücken erstellt Rauch (erhöht Dichte), Maus bewegen erzeugt Geschwindigkeit.

Wasser:

Und nun zum versprochenen Wasser. Wer sich an meine ersten Einträge erinnert, mag sich vielleicht auch an meine partikelbasierte Wassersimulation erinnern. Die meisten werden wahrscheinlich auch Noobodys Worklog verfolgen und von seiner SPH-Implementation wissen.
Ich habe mich mittlerweilen davon gelöst, meine Variante war mir zu instabil, zu unruhig etc.
Ich habe deshalb beschlossen, einen festen Bereich für das Wasser zu definieren, ich stecke das Wasser in eine Box und definiere eine Wasseroberfläche aus Punkten. Danach kann ich die Punkte beliebig auslenken und sie werden wieder ausgeglichen, bis sich eine ruhige Oberfläche wieder eingestellt hat. Das funktioniert relativ gut, hier ein Beispiel:



Der Code ist 3D-basiert, benötigt also eine Kamera. Ich bin mir noch nicht ganz schlüssig, wie ich das System lösen soll. Im Moment mache ich es so, dass die Koordinate im Wasser der Bildschirm-Koordinate entspricht (d.h die Meshposition ist im Ecken oben links und die Kamera ist entsprechend gedreht). Aber vielleicht wäre es klüger, es so zu machen, dass ich es relativ zu einer gegebenen Wasserposition mache, wird sich noch herausstellen, die Änderung wäre nur eine kleine Anpassung.

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * Welle
; *
; *		MAX_WAVE_COUNT
; *			Anzahl der maximal möglichen Wellenpunkte
; *
; *		WATERCAM
; *			die Kamera für die Darstellung des Wassers in 2D
; *
; *		initWaterCam()
; *			erstellt die Wasserkamera (inkl. Drehung)
; *
; *		TWave
; *			pList[]			Liste der Wellenpunkte
; *			pCount			Anzahl der Wellenpunkte
; *			segmentSize		Länge der einzelnen Segmente
; *			xStart			X-Wert der linken Seite
; *			xStop			X-Wert der rechten Seite
; *			ySurface		Y-Wert der Oberfläche
; *			yBottom			Y-Wert des Untergrunds
; *			mesh			Mesh der Welle
; *			surf			Surface der Welle
; *
; *		TWavePoint
; *			x		X-Koordinate
; *			y		Y-Koordinate
; *			vx		X-Geschwindigkeit
; *			vy		Y-Geschwindigkeit
; *			fix		Festsetzung eines Punktes
; *
; *		newWavePoint(x, y)
; *			erstellt einen neuen Wellenpunkt
; *
; *		newWave(xStart, xEnd, y, yBottom, size)
; *			erstellt eine neue Welle nach angegebenen Parametern
; *
; *		addWavePoint(w, p)
; *			fügt der Welle einen neuen Punkt hinzu
; *
; *		addNewWavePoint(w, x, y)
; *			erstellt einen neuen Wellenpunkt und fügt ihn der Welle hinzu
; *
; *		updateWave(w)
; *			erneuert die Wellenpunkte und die Wellen-Mesh
; *
; *		addWaveSource(w, x, width, height)
; *			verschiebt die Wellenpunkte in einer Breite um x um eine gewisse Höhe
; */

Global WATERCAM

Function initWaterCam()
	WATERCAM=CreateCamera()
	
	TurnEntity WATERCAM, 180, 0, 0
	PositionEntity WATERCAM, 0, 0, GraphicsWidth()/2
End Function

Const MAX_WAVE_COUNT=128

Type TWave
	Field pList.TWavePoint[MAX_WAVE_COUNT]
	Field pCount
	
	Field segmentSize#
	
	Field xStart#
	Field xStop#
	Field ySurface#
	Field yBottom#
	
	Field mesh
	Field surf
End Type

Type TWavePoint
	Field x#
	Field y#
	
	Field vx#
	Field vy#
	
	Field fix
End Type

Function newWavePoint.TWavePoint(x#, y#)
	Local w.TWavePoint=New TWavePoint
	
	w\x=x
	w\y=y
	
	Return w
End Function

Function newWave.TWave(xStart#, xEnd#, y#, yBottom#, size#)
	Local w.TWave=New TWave
	
	w\segmentSize=size
	
	Local p1.TWavePoint, p2.TWavePoint
	Local x#=xStart
	
	w\xStart=xStart
	w\xStop=xEnd
	w\ySurface=y
	w\yBottom=yBottom
	
	While x<=xEnd
		addNewWavePoint(w, x, y)
		
		x=x+size
	Wend
	
	w\pList[0]\fix=True
	w\pList[w\pCount-1]\fix=True
	
	w\mesh=CreateMesh()
	w\surf=CreateSurface(w\mesh)
	
	PositionEntity w\mesh, -GraphicsWidth()/2, -GraphicsHeight()/2, 0
	EntityFX w\mesh,16
	
	Return w
End Function

Function addWavePoint(w.TWave, p.TWavePoint)
	w\pList[w\pCount]=p
	w\pCount=w\pCount+1
End Function

Function addNewWavePoint(w.TWave, x#, y#)
	w\pList[w\pCount]=newWavePoint(x, y)
	w\pCount=w\pCount+1
End Function

Function updateWave(w.TWave)
	Local wpAct.TWavePoint, wpPre.TWavePoint, wpSuc.TWavePoint
	Local mY#
	
	For i=1 To w\pCount-2
		wpPre=w\pList[i-1]
		wpAct=w\pList[i]
		wpSuc=w\pList[i+1]
		
		mY=(wpPre\y+wpSuc\y)/2
		
		wpAct\vy=(mY-wpAct\y+wpAct\vy)*0.98
	Next
	
	For i=0 To w\pCount-1
		If Not w\pList[i]\fix
			w\pList[i]\y=w\pList[i]\y+w\pList[i]\vy
		EndIf
	Next
	
	ClearSurface w\surf, True, True
	
	Local v1, v2, v3, v4
	Local stp#=1./w\pCount
	
	v1=AddVertex(w\surf, w\pList[0]\x, w\pList[0]\y, 0, stp*i, 0)
	v2=AddVertex(w\surf, w\pList[0]\x, w\yBottom, 0, stp*i, 1)
	
	For i=1 To w\pCount-1
		v3=AddVertex(w\surf, w\pList[i]\x, w\pList[i]\y, 0, stp*i, 0)
		v4=AddVertex(w\surf, w\pList[i]\x, w\yBottom, 0, stp*i, 1)
		
		AddTriangle(w\surf, v1, v2, v3)
		AddTriangle(w\surf, v3, v4, v2)
		
		v1=v3
		v2=v4
	Next
End Function

Function addWaveSource(w.TWave, x#, height#, width#)
	Local dist#
	
	For i=0 To w\pCount-1
		If Not w\pList[i]\fix
			dist=Abs(x-w\pList[i]\x)
			
			If dist<width/2
				w\pList[i]\y=w\pList[i]\y-height
			EndIf
		EndIf
	Next
End Function

;/*
; * Testprogramm
; */

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

initWaterCam()

Local w.TWave=newWave(0, 800, 300, 600, 10)
EntityColor w\mesh, 0, 150, 255

;Local waveTex=LoadTexture("water.png")
;ScaleTexture waveTex,.25,.25
;EntityTexture w\mesh, waveTex
;EntityAlpha w\mesh, 0.75

Local timer=CreateTimer(60)
While Not KeyHit(1)
	RenderWorld
	
	updateWave(w)
	
	If MouseHit(1)
		addWaveSource(w, MouseX(), 50, 30)
	EndIf
	
	fps=fps+1
	If MilliSecs()-fpsTime>999
		fpsCur=fps
		fpsTime=MilliSecs()
		fps=0
	EndIf
	Text 10,10,fpsCur
	
	Flip 0
	Cls
	WaitTimer(timer)
Wend
End

Intermezzo:

So, was jetzt folgt, wird vielleicht einige Leute verärgern, aber ich nehme mir die Freiheit es trotzdem zu tun. Der folgende Teil des Worklogs wird in Englisch gehalten sein. Der Grund dazu ist einfach, Deutsch ist eine Sprache, die eigentlich nur in Deutschland (und näherer Umgebung) gesprochen wird, Englisch ist weitläufiger verbreitet und auch grossflächiger akzeptiert. Wenn ihr einmal eine akademische Laufbahn einschlagen werdet, dann müsst ihr euch mit hoher Wahrscheinlichkeit mit Englisch auseinandersetzen (ist bei mir jedenfalls so). Und ich möchte gewisse Aspekte meines Worklogs einfach allgemeiner zugänglich gestalten. Soweit zu meinen Gründen, die Entscheidung steht nicht weiter zur Diskussion (es sei denn die Moderation verbietet es ).

-----

DaDaPhysics:

In the last days I restructured my DaDaPhysics engine a little, which means, I changed some function names and some type-names. I did not change much in the way the engine works. Furthermore I stripped it to the "bare minimum" - it now works an a 2D basis only (I excluded the 2.5D part in a separate file, which has to be included to use). I also got rid of my first implementation of the particle based water (reason will follow in a sec). The reason for these changes was, that the File kept getting longer and I completely lost the oversight. I also did not have any naming consistency whatsoever, which made it all the more confusing, that's why I decided to invest a little time to change that, so I could continue to work with it in the future. I am currently working on a documentation, but as lazy as I tend to be, this could take while, so you have to be patient :>.
In further news I am currently adding a "new" (as in renewed) feature: As you may have seen above, I started a box-based water, which is actually just a surface simulation. At the moment I do handle them separately, which means, that the water part uses the physics engine and manipulates the body-data, aside the normal physical update. Of course this means, that I just buried my attempt of ridding the system of it's 3D component (which has proven to be unstable on some modern machines), oh well, no matter. The first result is shown below:



The objects float or sink, depending on their density. I made certain simplifications to the collision detection. At the moment, I only check the flat surface, no waves are taken into consideration. I think this will be changed in the near future, to make it seem more realistic. Also, the body is just pushed upwards, but it will start to rotate, if it has not sunken evenly. I take the center of the overlapping area and add the hydrostatic force from there (which results in said rotation).

The demo of the new feature can be found here, by klicking on the link.
The controls are pretty basic, [i]Left Mouse spawns a new Box, Right Mouse makes the box breakable (it will basically explode whenever it is in contact with water..).

That's it for tonight, I wish you all a pleasant evening and a good night of sleep,
Yours sincerely,
Darth

-----

Das wärs heute, ich wünsche allen einen schönen Abend und eine gute Mütze voll Schlaf,
MfG,
Darth

Squad..

Freitag, 14. Mai 2010 von darth

Hallo,

heute ist mal wieder so ein Tag, da hab ich keine Lust mehr. Also schreib ich einen Worklogeintrag, um mich ein wenig abzulenken. Das wird wieder ein ziemlich unstrukturierter Mischmasch von Dingen die ich versucht habe, einfach um ein wenig Vorarbeit für das zu schaffen, was mir die Laune verdorben hat.

LSysteme:

Oh ja, das ist was ganz Neues, wurde noch nie gemacht. Hihi, nein, LSysteme sind wahrscheinlich die etwa bekanntesten Fraktale, neben ganzen Strukturen wie das Sierpinskydreieck. Eigentlich ist es ziemlich einfach:
Gegeben ist String A, und die Ersetzungsregeln M_i -> R_i, suche in A das Muster M_i und ersetze es durch R_i, und das für jede Iteration.
Zuerst dachte ich, dass ich dafür einen wirklich tollen Algorithmus brauche, Boyer-Moore oder Knuth-Morris-Pratt, öhm, ja.. dann fiel mir ein, dass BB ja sowas lustiges wie Instr() hat, das macht die Algorithmen natürlich obsolet



Ziel war es ursprünglich, aus den LSystemen Bäume zu basteln, und die als Hintergrund in mein Spiel einzubauen. Allerdings habe ich zwei Probleme damit. Erstens sind die Bäume doch ziemlich regelmässig und "unnatürlich" (naja, über den Punkt kann man diskutieren), und zweitens ist es meines Wissens unmöglich, von einer gegebenen Struktur auf ihr LSystem zurückzuschliessen, ich müsste also rumprobieren, bis ich einen eigenen Baum finde, oder einfach die gegebenen Beispiele nehmen, die man so im Internet findet.
Natürlich könnte man die Darstellungsart noch ändern, dickere Linien machen für die Stämme, dann sieht es nochmal etwas schöner aus, allerdings kann man aus dem String nicht direkt rauslesen, WO in der Struktur man ist, da müsste man noch etwas Gedanken investieren, und dazu gefällt mir das Prinzip nicht genug. Um trotzdem nicht mit leeren Händen dazustehen, habe ich einen kleinen "automatisch scrollenden" Wald gebastelt, Codes dazu gibt es eigentlich genug im Codearchiv/Internet, deshalb hier nur einen Download.

Pattern Recognition:

So, nun zur "Hauptattraktion". Ich habe ein lustiges Fach, das nennt sich Computational Biology, worum es geht weiss keiner so wirklich, es hat irgendwas mit Biologie zu tun und ganz viel Wahrscheinlichkeitstheorie. In der Vorlesung wurde u.a auch Pattern-Recognition diskutiert.
Die einfachste Methode ist, das ganze Muster in einem gegebenen String zu suchen, dazu gibt es (wie im LSystem Teil erwähnt) einige Algorithmen, der mir beste bekannte ist KMP, den zu implementieren ist nicht wirklich schwer, ich habe das mal gemacht (inkl. Beispiel):

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * KMP
; */

Const MAX_LENGTH=128

Function KMP_Analyze(m$, jump[MAX_LENGTH])
	Local mLen=Len(m)
	
	Local i=1, j=0
	
	While i<mLen
		If Mid(m, i+1, 1)=Mid(m, j+1, 1)
			jump[i:1]=j+1
			
			i=i+1
			j=j+1
		Else
			If j>0
				j=jump[j-1]
			Else
				jump[i]=0
				i=i+1
			EndIf
		EndIf
	Wend
End Function

Function KMP(txt$, muster$, i0=0)
	Local jump[MAX_LENGTH]
	KMP_Analyze(muster, jump)
	
	Local n=Len(txt)
	Local m=Len(muster)
	
	Local i=i0, j=0
	
	While i<n
		If Mid(txt, i+1, 1)=Mid(muster, j+1, 1)
			If j=m-1
				Return i-m+1
			EndIf
			
			i=i+1
			j=j+1
		Else
			If j>0
				j=jump[j-1]
			Else
				i=i+1
			EndIf
		EndIf
	Wend
	
	Return -1
End Function

;/*
; * Test
; */

Local muster$="abrakadabra"
Local txt$="er sprach abrakadabra, aber abrakadabra"

Local i=KMP(txt, muster)

Print i+":"
Print txt
Print String(" ",i)+muster

Local j=KMP(txt, muster, i+1)

Print j+":"
Print txt
Print String(" ",j)+muster

WaitKey()

Das dient natürlich nur dazu, eine Sequenz zu finden, von der man weiss, dass sie vorhanden ist. Allgemein interessiert man sich aber eher für "Fuzzy-Suchen", also man sucht etwas, das ungefähr ähnlich ist, aber nur gering abweicht. Und hier fangen die (=meine) Schwierigkeiten an.
Ich kenne ein paar Verfahren die mir theoretisch helfen könnten, da wäre die Levenshtein Distanz, der die "Unähnlichkeit" zweier Strings berechnet und das Sequence Alignment. Levenshtein hat das Problem, dass er [i]O(n^2) ist, das ist für kleine Strings kein Ding, mehr dazu später. SA hat auch seine Probleme, dafür braucht man eine Matrix, die ist im Speicher O(n^2), und mit BBs Verhalten gegenüber langen Blitz-Arrays ist das ziemlich unschön. Aber das hat mich nicht daran gehindert, die beiden mal zu programmieren und zu testen:

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * Definitionen
; *		d sind die Kosten für eine Lücke
; *		simularity sind die Kosten für den Nachfolger
; *		MAX_LENGTH ist die maximale Länge eines Strings
; *			(wird benötigt weil B-Arrays mit Konstanten initialisiert werden müssen)
; */

Const d=-5

;  A G C T
; A
; G  *
; C    *
; T

Global simularity[16]
simularity[ 0]=10 : simularity[ 1]=-1 : simularity[ 2]=-3 : simularity[3]=-4
simularity[ 4]=-1 : simularity[ 5]=7  : simularity[ 6]=-5 : simularity[7]=-3
simularity[ 8]=-3 : simularity[ 9]=-5 : simularity[10]=9  : simularity[11]=0
simularity[12]=-4 : simularity[13]=-3 : simularity[14]=0  : simularity[15]=8

Const MAX_LENGTH=64

;/*
; * Vorberechnungen
; *		calculateMatrix berechnet die Traversierungsmatrize für das Problem
; *		convertStringToArray wandelt den String in einen Array um
; *			A=0, G=1, C=2, T=3
; */

Function min(a, b)
	If a<b
		Return a
	Else
		Return b
	EndIf
End Function

Function max(a, b)
	If a>b
		Return a
	Else
		Return b
	EndIf
End Function

Function calculateMatrix(source[MAX_LENGTH], sLength, dest[MAX_LENGTH], dLength, res[(MAX_LENGTH+1)*(MAX_LENGTH+1)])
	For y=0 To sLength-1
		res[y]=d*y
	Next
	
	For x=0 To dLength-1
		res[x*(MAX_LENGTH+1)]=d*x
	Next
	
	Local k, l, m
	
	For y=1 To sLength
		For x=1 To dLength
			k=res[(y-1) + (x-1)*(MAX_LENGTH+1)] + simularity[source[y-1]*4 + dest[x-1]]
			l=res[(y-1) + x*(MAX_LENGTH+1)] + d
			m=res[y + (x-1)*(MAX_LENGTH+1)] + d
			
			res[y + x*(MAX_LENGTH+1)]=max(max(k, l),m)
		Next
	Next
End Function

Function convertStringToArray(s$, ar[MAX_LENGTH])
	Local n
	
	For i=1 To Len(s)
		Select Mid(s, i, 1)
			Case "A"
				n=0
			Case "G"
				n=1
			Case "C"
				n=2
			Case "T"
				n=3
			Default
				n=-1
		End Select
		
		ar[i-1]=n
	Next
End Function

;/*
; * Alignment Berechnung
; *		die beiden resultierenden Strings werden in result1 bzw result2 gespeichert
; */

Global result1$, result2$

Function getAlignment(ar[(MAX_LENGTH+1)*(MAX_LENGTH+1)], A[MAX_LENGTH], B[MAX_LENGTH], sA$, sB$)
	Local alA$=""
	Local alB$=""
	
	Local i=Len(sA)
	Local j=Len(sB)
	
	Local score, scorediag, scoreup, scoreleft
	
	While i>0 And j>0
		score=ar[i + j*(MAX_LENGTH+1)]
		scorediag=ar[(i-1) + (j-1)*(MAX_LENGTH+1)]
		scoreup=ar[i + (j-1)*(MAX_LENGTH+1)]
		scoreleft=ar[(i-1) + j*(MAX_LENGTH+1)]
		
		If score=scorediag+simularity[A[i-1]*4+B[j-1]]
			alA=Mid(sA, i, 1)+alA
			alB=Mid(sB, j, 1)+alB
			
			i=i-1
			j=j-1
		ElseIf score=scoreleft+d
			alA=Mid(sA, i, 1)+alA
			alB="-"+alB
			
			i=i-1
		ElseIf score=scoreup+d
			alA="-"+alA
			alB=Mid(sB, j, 1)+alB
			
			j=j-1
		EndIf
	Wend
	
	While i>0
		alA=Mid(sA, i, 1)+alA
		alB="-"+alB
		
		i=i-1
	Wend
	
	While j>0
		alA="-"+alA
		alB=Mid(sB, j, 1)+alB
	Wend
	
	result1=alA
	result2=alB
End Function

;/*
; * Levenshtein Distan
; *		berechnet die Unähnlichkeit zweier Strings
; */

Function getLevenshteinDistance(s$, t$)
	Local n=Len(s)
	Local m=Len(t)
	
	If n=0
		Return m
	ElseIf m=0
		Return n
	EndIf
	
	Local p[100], plen=n+1
	Local d[100], dLen=n+1
	Local tmp
	
	Local i, j
	Local tj$
	Local cost
	
	For i=0 To n
		p[i:1]=i
	Next
	
	For j=1 To m
		tj=Mid(t, j, 1)
		d[0]=j
		
		For i=1 To n
			If Mid(s, i, 1)=tj
				cost=0
			Else
				cost=1
			EndIf
			
			d[i]=min(min(d[i-1]+1, p[i]+1), p[i-1]+cost)
		Next
		
		For i=0 To n ;array swap
			tmp=p[i]
			p[i]=d[i]
			d[i]=tmp
		Next
	Next
	
	Return p[n]
End Function

;/*
; * Test
; */

Local s1$="AGACTAGTTAC";+"ACAGTACGTAAGATATGATAGATAGCTCAT"
Local s2$="AGCAAGTAG";+"GTACTAGTAATACTGCATCTAGCTA"

Local ar1[MAX_LENGTH]
Local ar2[MAX_LENGTH]

convertStringToArray(s1, ar1)
convertStringToArray(s2, ar2)

Local arr[(MAX_LENGTH+1)*(MAX_LENGTH+1)]

calculateMatrix(ar1, Len(s1), ar2, Len(s2), arr)

getAlignment(arr, ar1, ar2, s1, s2)

Print result1
Print result2

Print "Distanz: "+getLevenshteinDistance(result1, result2)
Print "Normal: "+getLevenshteinDistance(s1, s2)

WaitKey()

Es stellt sich heraus, die Levenshtein Distanz für das aneinander angepasste genau gleich ist, wie für die Strings separat. Ausserdem ist das SeqAl für Gensequenzen optimiert, für andere Suchen müsste man die Matrix anpassen. Darauf könnte man den Computer theoretisch trainieren (evol. Algorithms o.Ä.).
Aber wozu das Ganze eigentlich? Ich wollte einen Algorithmus programmieren, der gezeichnete Eingaben mit einer Datenbank von bekannten Symbolen vergleicht und das ähnlichste Ausspuckt. So etwa in diese Richtung.
Das Problem dabei ist, dass man schon bei einem Bild von 128x128 eine "String"länge von über 16000 hat, Levenshtein ist wie gesagt [i]O(n^2), das sind etwa 300Mio Operationen, und das für jedes Bild der Datenbank. Ein weiteres Problem ist, dass die Zeichen unterschiedlich gross sein können (wirklich ein Problem!) oder an einer anderen Stelle (theoretisch ein Problem). Die Stelle kann man mit einem Offset korrigieren, dazu müsste man aber auch wieder alle möglichen Verschiebungen vetrachten, das geht von -16k zu +16k, und spätestens hier sagt einem BlitzBasic, dass es keine Lust mehr hat.
Ich habe dann angefangen "abzuspecken". Ich mache keinen Levenshtein, ich mache keine Offset-Optimierung, ich suche mir die Anfangspunkte der Bilder und nehme den als Offset, dann vergleiche ich die beiden Arrays über ein XOR und lasse das auswerten, dann gebe ich das beste Ergebnis aus. Das funktioniert aber nur beschränkt. Es kommen viel zu häufig falsche Zeichen raus, und ist überhaupt nicht so einsetzbar, wie ich das wollte :/



Vielleicht kennt jemand einen besseren Algorithmus um Pattern-Recognition in Bildern zu machen. Ich kenne da noch die Hough-Transformation, oder den Hausdorff-Algorithmus, aber die sind eher dazu gedacht FORMEN zu finden, ich bin mir nicht sicher, inwiefern ich die auf mein Problem biegen könnte. Allerdings habe ich mittlerweilen aufgegeben. Das Testprogram lässt sich hier herunterladen, die Steuerung wird im Programm (teilweise) erklärt. Beim trainieren könnt ihr noch zusätzlich eine Zeichenfolge für euer Bild geben (1, 2, 3, +, -, =,...). Wenn ihr dann die Erkennung startet, wird das Zeichen in einen String eingefügt, bei einem = wird dann das Ergebnis durch meinen Mathe-Parser geschickt und ausgegeben.

Eigentlich wollte ich das für die Steuerung benutzen, so ähnlich wie in Trine, wo der Zauberer mittels Maus eine Kiste zeichnet, die dann erscheint. Ich wollte ein Arsenal von magischen Zeichen kreieren, die der Spieler dann zeichnen musste, um einen Spruch zu wirken. Die Idee ist vorerst gestorben, ich werde mir etwas anderes einfallen lassen.

So, das wärs von mir, vielleicht kommt das Programm irgendwann mal auf einen grünen Zweig, who knows.
MfG,
Darth

Und weiter gehts..

Ich hatte eben ein kleineres Gespräch mit einem Studienkollegen. Er meinte ich sei doof, die Bildersuche mittels Stringvergleich anzugehen, ich solle lieber den Hausdorff-Algorithmus benutzen. Ich habe mal auf ihn gehört und es versucht. Dazu muss man zuerst die wichtigen Kanten des Bildes finden, dazu gibt es auch wieder mehrere Methoden, zum Beispiel Laplace, der liefert aber nicht genügend exakte Ergebnisse, deshalb habe ich mir mal den Canny-Algorithmus angesehen, den ich anhand eines Tutorials mit Beispiel in BB nachgebaut habe. Ich glaube es ist mir gelungen :>



Die Frau da auf dem Bildschirm ist meine Freundin - oder irgend ein x-beliebiges Gesicht das ich über Google gefunden habe, ich bin mir da nichtmehr ganz sicher. Der Algorithmus kann Bilder von maximal 256x256 behandeln (wieder wegen den BlitzArrays die ich verwende), und braucht für ein solches etwa um die 150ms, also nicht sonderlich schnell. Allerdings ist mein Ziel ja auch, das nur einmal auszuwerten am Anfang der Transformation (Bild -> Muster). Da der Code auf einem Tutorial basiert und nicht wirklich von mir selber erarbeitet wurde, bin ich mir nicht sicher ob ich ihn posten soll, von daher lass ich es mal bleiben.

So, nun weiter zu Hausdorff, dazu gibt es auf Youtube ein ziemlich gutes Erklärungsvideo. Das Problem ist, dass der Algorithmus O(n^2*m^2) ist (hier: O(n^4)), und damit ziemlich langsam. Allerdings dennoch halbwegs zumutbar. Aber auch der liefert meist komische Ergebnisse auf meine Eingabe. Also ist auch der Versuch gescheitert. Ich bin gerade am Ende meiner Weisheit.

Und noch ein Versuch..

Ich wurde in den Comments auf diesen Thread aufmerksam gemacht. Da wird das Symbol nicht mittels Bildvergleich gesucht, sondern über die Richtung der gezogenen Linie. Es eignet sich für Gestenerkennung zur Steuerung wahrscheinlich besser als mein Ansatz des Bildvergleichs, deshalb habe ich es mal etwas Ähnliches (naja, ziemlich genau gleich ) in BB geschrieben. Das System ist relativ wacklig (eine "gerade" Linie nach rechts oben artet schnell mal in einen Wechsel zwischen Up und Right aus), aber wenn ich das noch stabiler kriege, dann wird das sicher brauchbar.

Also, bis zum nächsten mal,
MfG,
Darth

Der Graph von MonteChristo

Samstag, 1. Mai 2010 von darth

Hallo,

diese und letzte Woche haben wir in einer lustigen Vorlesung ein paar interessante Dinge gehört. Dabei ging es vor allem um Graphen und irgendwelche Theorien dazu. Um es grob zusammenzufassen: Ein paar komische Kauze haben sich jahrelang hingesetzt um herauszufinden, wie man einen Graphen am besten optimiert, oder so, ich bin in der Hälfte eingeschlafen.. Deshalb musste ich mich dann hinsetzen um das Zeug doch noch zu verstehen. Weil die Vorlesung "Algorithmen und Datenstrukturen" heisst, dachte ich, dass ich mir den Krempel mal programmiere um zu sehen wie es funktioniert. Und weil ich nichts besseres zu tun habe, teile ich meine Ergebnisse mit der breiten Öffentlichkeit.

Splines:

Zuerst aber etwas anderes. Vor einigen Tagen fragte jemand im Channel nach einer Funktion für Splines. Falls jemand nicht weiss was eine Spline ist dann hier eine kurze Erklärung: Es sind Kurven, die sich (ähnlich wie Bezierkurven) an einer Reihe von Punkten orientieren, die Splines gehen garantiert durch die gesetzten Kontrollpunkte (ungleich Bezier), sie dienen deshalb zur Interpolation von z.B Bewegungsabläufen und Ähnlichem.
Ich erinnerte mich da an meine heissgeliebte Numerik Vorlesung (diesmal nicht sarkastisch, im Nachhinein war das wohl die nützlichste Vorlesung bisher :/ Meh!) wo wir die lustigen Dinger von Hand berechnen durften. Allerdings hatte der Professor ein einsehen und schrieb eine Übung, wo wir das Prinzip in Matlab umsetzen sollten, nach vorgegebenem Pseudocode. Ich habe diesen wieder ausgegraben und nach BlitzBasic portiert. Das Ergebnis ist hier zu finden:

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

Type Vector2
	Field x#
	Field y#
End Type

Function cVector2.Vector2(x#, y#)
	Local v.Vector2=New Vector2
	
	v\x=x
	v\y=y
	
	Return v
End Function

Const MAX_SPLINE_POINTS=128

Type TSpline
	Field p.Vector2[MAX_SPLINE_POINTS]
	Field count
End Type

Function cTSpline.TSpline()
	Return New TSpline
End Function

Function addPointToSpline(s.TSpline, p.Vector2)
	If s\count>=MAX_SPLINE_POINTS
		Return
	EndIf
	
	s\p[s\count]=p
	s\count=s\count+1
End Function

Function removePointFromSpline(s.TSpline, i)
	If s\count<1
		Return
	EndIf
	
	Delete s\p[i:1]
	
	For j=i+1 To s\count-1
		s\p[j-1]=s\p[j]
	Next
	s\p[s\count-1]=Null
	
	s\count=s\count-1
End Function

Type CubicPolynom
	Field a#
	Field b#
	Field c#
	Field d#
End Type

Function cCubicPolynom.CubicPolynom(a#, b#, c#, d#)
	Local cp.CubicPolynom=New CubicPolynom
	
	cp\a=a
	cp\b=b
	cp\c=c
	cp\d=d
	
	Return cp
End Function

Function valueCP#(cp.CubicPolynom, x#)
	Return (((cp\d*x)+cp\c)*x+cp\b)*x+cp\a
End Function

;// x wird gefüllt
Function fillXCoordinates(s.TSpline, x[MAX_SPLINE_POINTS])
	For i=0 To s\count-1
		x[i]=s\p[i]\x
	Next
End Function

;// y wird gefüllt
Function fillYCoordinates(s.TSpline, y[MAX_SPLINE_POINTS])
	For i=0 To s\count-1
		y[i]=s\p[i]\y
	Next
End Function

;// cp wird gefüllt
Function calcNatSpline(n, x[MAX_SPLINE_POINTS], cp.CubicPolynom[MAX_SPLINE_POINTS])
	Local gamma#[MAX_SPLINE_POINTS]
	Local delta#[MAX_SPLINE_POINTS]
	Local d#[MAX_SPLINE_POINTS]
	
	gamma[0]=0.5
	For i=1 To n-1
		gamma[i]=1./(4-gamma[i-1])
	Next
	gamma[n]=1./(2-gamma[n-1])
	
	delta[0]=3*(x[1]-x[0])*gamma[0]
	For i=1 To n-1
		delta[i]=(3*(x[i+1]-x[i-1])-delta[i-1])*gamma[i]
	Next
	delta[n]=(3*(x[n]-x[n-1])-delta[n-1])*gamma[n]
	
	d[n]=delta[n]
	For i=n-1 To 0 Step -1
		d[i]=delta[i]-gamma[i]*d[i+1]
	Next
	
	For i=0 To n-1
		cp[i]=cCubicPolynom(x[i], d[i], 3*(x[i+1]-x[i])-2*d[i]-d[i+1], 2*(x[i]-x[i+1])+d[i]+d[i+1])
	Next
End Function

Global STEPS=10
Global fSTEPS#=STEPS

Function drawSpline(s.TSpline)
	LockBuffer BackBuffer()
	
	If s\count>1
		Local x[MAX_SPLINE_POINTS]
		Local y[MAX_SPLINE_POINTS]
		
		fillXCoordinates(s, x)
		fillYCoordinates(s, y)
		
		Local cx.CubicPolynom[MAX_SPLINE_POINTS]
		Local cy.CubicPolynom[MAX_SPLINE_POINTS]
		
		calcNatSpline(s\count-1, x, cx)
		calcNatSpline(s\count-1, y, cy)
		
		Local px1, py1, px2, py2
		Local u#
		
		For i=0 To s\count-2
			px1=valueCP(cx[i], 0)
			py1=valueCP(cy[i], 0)
			
			For j=1 To STEPS
				u=j/fSTEPS
				
				px2=valueCP(cx[i], u)
				py2=valueCP(cy[i], u)
				
				Line px1, py1, px2, py2
				
				px1=px2
				py1=py2
			Next
		Next
	EndIf
	
	UnlockBuffer BackBuffer()
	
	;// remove if used
	For i=0 To s\count-1
		Oval s\p[i]\x-2, s\p[i]\y-2, 4, 4
	Next
End Function

Function getPointByMouse.Vector2(s.TSpline)
	Local minDist#=1000000
	Local dist#
	Local pSel.Vector2
	
	For i=0 To s\count-1
		dist=Sqr((MouseX()-s\p[i]\x)^2+(MouseY()-s\p[i]\y)^2)
		
		If dist<minDist
			minDist=dist
			pSel=s\p[i]
		EndIf
	Next
	
	Return pSel
End Function

;/*
; * Test Program
; */

Graphics 640,480,0,2
SetBuffer BackBuffer()

Local s.TSpline=New TSpline
addPointToSpline(s, cVector2(10,10))
addPointToSpline(s, cVector2(50,30))
addPointToSpline(s, cVector2(102,120))
addPointToSpline(s, cVector2(236,236))
addPointToSpline(s, cVector2(300,40))

While Not KeyHit(1)
	Color 255,255,255
	
	drawSpline(s)
	
	Text 10,10,s\count
	
	If MouseDown(1)
		pSel.Vector2=getPointByMouse(s)
		If pSel<>Null
			pSel\x=MouseX()
			pSel\y=MouseY()
		EndIf
	EndIf
	
	If MouseHit(2)
		addPointToSpline(s, cVector2(MouseX(), MouseY()))
	EndIf
	
	fpsCount=fpsCount+1
	If MilliSecs()-fpsTime>999
		fpsCur=fpsCount
		fpsCount=0
		fpsTime=MilliSecs()
	EndIf
	Text 600,460,fpsCur
	
	Flip 0
	Cls
Wend
End

Ein Bild gibt es nicht, es ist nicht ziemlich aussagekräftig, es ist halt einfach eine geschwungene Linie, die durch ein paar Punkte geführt wird. Steuerung ist eigentlich im Code ersichtlich, linke Maustaste drücken verschiebt einen Punkt, rechte Maustaste setzt einen neuen.
Man könnte das Verfahren wohl noch etwas beschleunigen (man spart sich das Füllen der Arrays), allerdings würde das zu doppeltem Code führen, was von schlechter Programmierarbeit zeugt, deshalb mache ich das nicht. Es ist auch so schnell genug .

Binäre Bäume:

Das erste Thema war der allgemeine Binärbaum. Ein Knoten hat zwei Kinder, je eins links und eines rechts. Das kann man benutzen um z.b MorseCodes zu interpretieren (Punkt links, Strich rechts), oder um Zahlen zu sortieren. Ist ein Wert kleiner geht er nach links, ist er grösser, dann nach rechts. Natürlich kann dies zu höchst einseitigen Bäumen führen, wenn man die Wurzel zu klein wählt und alle Zahlen der Grösse nach sortiert einfüllt, dann hat man sowas wie eine LinkedList. Um dies zu verhindern, haben sich ein paar Leute hingesetzt und Bäume entwickelt. So gibt es heute den AVL-Baum, den Rot-Schwarz-Baum, B-Bäume, Tannenbäume, Weihnachtsbäume, Obstbäume usw.
Den Rot-Schwarz-Baum verstehe ich nicht, den muss ich mir nochmal ansehen. Da geht es irgendwie darum, dass man Knoten umfärbt und je nach Färbung verschiebt, aber wie genau man das macht weiss ich nicht. B-Bäume halte ich für absolut bescheuert und sehe nicht ein, wofür man die braucht. Ausserdem werden sie eh generell nur als Übergangsstruktur benutzt, wozu also die Mühe -.- ?
AVL-Bäume fand ich allerdings interessant. Wenn ein Ast zu schwer wird, dann "dreht" man den Baum, das ist ziemlich einfach (es gibt nur 4 Fälle die auftreten können, und 4 Reaktionen darauf) und effizient. Ein Beispiel:



Wofür man so etwas brauchen kann war mir zuerst nicht wirklich klar. Aber als Beispiel könnte ich hier vielleicht [i]Highscores erwähnen. Die Funktion printTree(root) gibt den Baum sortiert aus. Das Einfügen ist ebenfalls ziemlich einfach, so könnte man also ganz gemütlich einen neuen Wert in seinen Highscore Baum eintragen, der automatisch sortiert wird.

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * AVL Tree
; */

Type TreeNode
	Field value
	
	Field cLeft.TreeNode
	Field cRight.TreeNode
End Type

Function newTreeNode.TreeNode(x)
	Local n.TreeNode=New TreeNode
	
	n\value=x
	
	Return n
End Function

Function hasLeft(n.TreeNode)
	Return Not n\cLeft=Null
End Function

Function hasRight(n.TreeNode)
	Return Not n\cRight=Null
End Function

Function isLeaf(n.TreeNode)
	Return hasLeft(n)=False And hasRight(n)=False
End Function

Function insertToTree.TreeNode(n.TreeNode, x)
	If n=Null
		n=newTreeNode(x)
	Else
		If x<n\value
			n\cLeft=insertToTree(n\cLeft, x)
			
			If treeDepth(n\cLeft)-treeDepth(n\cRight)=2
				If x<n\cLeft\value<0
					n=rotateWithLeftChild(n)
				Else
					n=doubleRotateWithLeftChild(n)
				EndIf
			EndIf
		ElseIf x>n\value
			n\cRight=insertToTree(n\cRight, x)
			
			If treeDepth(n\cRight)-treeDepth(n\cLeft)=2
				If x>n\cRight\value
					n=rotateWithRightChild(n)
				Else
					n=doubleRotateWithRightChild(n)
				EndIf
			EndIf
		Else
			;doppelter Wert
			;	hier wird er ignoriert
			;	man könnte ihn theoretisch auch einfügen..
		EndIf
	EndIf
	
	Return n
End Function

Function rotateWithLeftChild.TreeNode(n.TreeNode)
	Local n2.TreeNode=n\cLeft
	
	n\cLeft=n2\cRight
	n2\cRight=n
	
	Return n2
End Function

Function rotateWithRightChild.TreeNode(n.TreeNode)
	Local n2.TreeNode=n\cRight
	
	n\cRight=n2\cLeft
	n2\cLeft=n
	
	Return n2
End Function

Function doubleRotateWithLeftChild.TreeNode(n.TreeNode)
	n\cLeft=rotateWithRightChild(n\cLeft)
	Return rotateWithLeftChild(n)
End Function

Function doubleRotateWithRightChild.TreeNode(n.TreeNode)
	n\cRight=rotateWithLeftChild(n\cRight)
	Return rotateWithRightChild(n)
End Function

Function removeFromTree.TreeNode(root.TreeNode, x)
	;eine sinnvolle Implementation ist nervig
	;	ich entferne den Knoten
	;	und füge nachher all seine Kinder wieder ein
	;
	;	kann mit grosser Wahrscheinlichkeit effizienter gelöst werden
	;	aber das ist mir egal :)
	
	Local rem.TreeNode=findInTree(root, x)
	Local remParent.TreeNode=findParentinTree(root, rem)
	
	If remParent\cLeft=rem
		remParent\cLeft=Null
	EndIf
	
	If remParent\cRight=rem
		remParent\cRight=Null
	EndIf
	
	root=insertBranchToTree(root, rem\cLeft)
	root=insertBranchToTree(root, rem\cRight)
	
	Return root
End Function

Function findInTree.TreeNode(n.TreeNode, x)
	While n<>Null
		If x=n\value
			Return n
		Else
			If x>n\value
				n=n\cRight
			Else
				n=n\cLeft
			EndIf
		EndIf
	Wend
	
	Return Null
End Function

Function findParentinTree.TreeNode(n.TreeNode, c.TreeNode)
	While n<>Null
		If hasLeft(n)
			If c\value=n\cLeft\value
				Return n
			EndIf
		EndIf
		
		If hasRight(n)
			If c\value=n\cRight\value
				Return n
			EndIf
		EndIf
		
		If c\value>n\value
			n=n\cRight
		Else
			n=n\cLeft
		EndIf
	Wend
	
	Return Null
End Function

Function insertBranchToTree.TreeNode(root.TreeNode, n.TreeNode)
	If n=Null
		Return root
	EndIf
	
	insertToTree(root, n\value)
	
	root=insertBranchToTree(root, n\cLeft)
	root=insertBranchToTree(root, n\cRight)
	
	Return root
End Function

Function treeDepth(n.TreeNode, d=0, max=0)
	If n=Null
		If d>max
			Return d
		Else
			Return max
		EndIf
	EndIf
	
	max1=treeDepth(n\cLeft, d+1, max)
	max2=treeDepth(n\cRight, d+1, max)
	
	If max1>max
		max=max1
	EndIf
	If max2>max
		max=max2
	EndIf
	
	Return max
End Function

Function printTree(n.TreeNode)
	If n=Null
		Return
	EndIf
	
	printTree(n\cLeft)
	Print n\value
	printTree(n\cRight)
End Function

Function dispTree(n.TreeNode, x, y)
	If n=Null
		Return
	EndIf
	
	Local maxDepth=treeDepth(n)
	Local b#=5, h#=50
	
	Text x, y, n\value
	
	If hasLeft(n)
		Line x+Len(n\value)*4, y+14, x-b*2^maxDepth+Len(n\cLeft\value)*4, y+h-2
	EndIf
	
	If hasRight(n)
		Line x+Len(n\value)*4, y+14, x+b*2^maxDepth+Len(n\cRight\value)*4, y+h-2
	EndIf
	
	dispTree(n\cLeft, x-b*2^maxDepth, y+h)
	dispTree(n\cRight, x+b*2^maxDepth, y+h)
End Function

;/*
; * Test
; */

Local root.TreeNode
root=insertToTree(root, 5)
root=insertToTree(root, 7)
root=insertToTree(root, 9)
root=insertToTree(root, 6)
root=insertToTree(root, 11)
root=insertToTree(root, 2)
root=insertToTree(root, 1)
root=insertToTree(root, 25)
root=insertToTree(root, 46)
root=insertToTree(root, 52)
root=insertToTree(root, 63)
root=insertToTree(root, 98)

root=removeFromTree(root, 46)

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

printTree(root)

dispTree(root, 400, 50)

Flip 0
WaitKey()

Die Löschfunktion ist ziemlich mühsam, deshalb habe ich es mir "einfach" gemacht. Ich hänge den Ast ab und füge alle Werte (ausser den zu löschenden) wieder ein. Doppelte Werte ignoriere ich in dem Beispiel.

Dijikstra:

Dann kamen Graphen-Netze dran. Gesucht war ein minimal spannender Graph (d.h ein einzelner (kürzester) Weg durch alle Knoten). Dafür gibt es den disch.. dsch.. dschaka.. discha.. [url=http://en.wikipedia.org/wiki/Dijkstra's_algorithm]Dingsda-Algorithmus[/url]. Er gehört zu der Klasse der Greedy-Algorithm, d.h er macht keine Fehler. Ein gemachter Schritt ist absolut, und richtig (also kein Backtracking), soweit ich mich erinnere ist das Laufzeitverhalten mitn^2*log(n) angegeben. Hier das Beispiel, andem es uns erklärt wurde:



Generell geht es so, dass man eine Liste mit Distanzen zu den Knoten mitführt (nicht erreichbare Knoten werden auf unendlich distanziert) und sich dann den nächsten Knoten auswählt, dann wird die Distanzliste aktualisiert. So geht man vor, bis man alle Knoten erreicht hat, oder keine mehr erreichbar sind.
Wofür man das brauchen kann weiss ich nicht genau :/ Vielleicht für ein Waypoint-System, aber auch das ist heikel, weil man eigentlich nur den Startpunkt, nicht aber das Ziel angeben kann. Allerdings könnte man es etwas umschustern, indem man zum Beispiel eine Waypoint-Map baut, die Knoten entsprechend ihrer Erreichbarkeit untereinander vernetzt und den Algorithmus abbricht, sobald der Zielknoten erreicht wurde, das garantiert den Kürzesten Weg durch das Waypoint Wirrwarr.

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * Weighted Graph
; *  Dijkstra Example
; */

Type TVertex
	Field value$
End Type

Function newTVertex.TVertex(value$)
	Local v.TVertex=New TVertex
	
	v\value=value
	
	Return v
End Function
	
Type TEdge
	Field n1.TVertex
	Field n2.TVertex
	
	Field cost
End Type

Function newTEdge.TEdge(n1.TVertex, n2.TVertex, cost)
	Local e.TEdge=New TEdge
	
	e\n1=n1
	e\n2=n2
	
	e\cost=cost
	
	Return e
End Function

Const MAX_NODES=128
Const MAX_EDGES=128

Type TGraph
	Field v.TVertex[MAX_NODES]
	Field vCount
	
	Field e.TEdge[MAX_EDGES]
	Field eCount
End Type

Function addTVertexToGraph(g.TGraph, v.TVertex)
	g\v[g\vCount]=v
	g\vCount=g\vCount+1
End Function

Function addTEdgeToGraph(g.TGraph, e.TEdge)
	g\e[g\eCount]=e
	g\eCount=g\eCount+1
End Function

Type TGraphPathNode
	Field v.TVertex
	Field succ.TGraphPathNode
	Field prev.TGraphPathNode
End Type

Function newTGraphPathNode.TGraphPathNode(v.TVertex)
	Local gpn.TGraphPathNode=New TGraphPathNode
	
	gpn\v=v
	
	gpn\succ=Null
	gpn\prev=Null
	
	Return gpn
End Function

Const INF=1000000
Function dijkstra.TGraphPathNode(g.TGraph, source.TVertex)
	Local dist#[MAX_NODES]
	
	Local Q.TVertex[MAX_NODES]
	Local qCount=0
	
	For i=0 To g\vCount-1
		dist[i:1]=INF+1 ;TO INFINITY, AND BEYOND!
		
		Q[i]=g\v[i]
	Next
	qCount=g\vCount
	
	Local sourceID
	
	For i=0 To g\vCount-1
		If g\v[i]=source
			sourceID=i
			Exit
		EndIf
	Next
	
	dist[sourceID]=0
	
	Local s.TGraphPathNode
	Local pStart.TGraphPathNode
	
	Local u.TVertex, uId
	Local smallest#, alt#
	
	While qCount>0
		
		;suche den nächsten Nachbarn
		smallest=INF+1
		For i=0 To qCount-1
			If dist[i]<smallest
				smallest=dist[i]
				
				u=Q[i]
				uId=i
			EndIf
		Next
		
		;kein Nachbar erreichbar
		;	abbruch, oder zurückliefern der bisherigen Liste
		If smallest>=INF
			;Return Null
			Exit
		EndIf
		
		;entfernt u von der Liste
		For i=uId To qCount-2
			Q[i]=Q[i+1]
			dist[i]=dist[i+1]
		Next
		qCount=qCount-1
		
		;Erneuern der Distanzen/Pfadkosten
		For i=0 To qCount-1
			alt=getEdgeCost(g, u, Q[i])
			If alt>=0
				If alt<dist[i]
					dist[i]=alt
				EndIf
			EndIf
		Next
		
		;Generieren des neuen Pfadknotens
		If s=Null
			s=newTGraphPathNode(u)
			
			pStart=s ;damit ich den pfad nicht "zurückspulen" muss
		Else
			s\succ=newTGraphPathNode(u)
			s\succ\prev=s
			
			s=s\succ
		EndIf
	Wend
	
	Return pStart
End Function

Function getEdgeCost#(g.TGraph, v.TVertex, u.TVertex)
	For i=0 To g\eCount-1
		If (g\e[i]\n1=v And g\e[i]\n2=u) Or (g\e[i]\n1=u And g\e[i]\n2=v)
			Return g\e[i]\cost
		EndIf
	Next
	
	Return -1
End Function

;/*
; * Test program
; */

g.TGraph=New TGraph

v1.TVertex=newTVertex("a")
v2.TVertex=newTVertex("b")
v3.TVertex=newTVertex("c")
v4.TVertex=newTVertex("d")
v5.TVertex=newTVertex("e")
v6.TVertex=newTVertex("f")

addTVertexToGraph(g, v1)
addTVertexToGraph(g, v2)
addTVertexToGraph(g, v3)
addTVertexToGraph(g, v4)
addTVertexToGraph(g, v5)
addTVertexToGraph(g, v6)

addTEdgeToGraph(g, newTEdge(v1, v2, 5))
addTEdgeToGraph(g, newTEdge(v1, v3, 10))
addTEdgeToGraph(g, newTEdge(v2, v3, 4))
addTEdgeToGraph(g, newTEdge(v2, v5, 30))
addTEdgeToGraph(g, newTEdge(v2, v6, 46))
addTEdgeToGraph(g, newTEdge(v3, v4, 20))
addTEdgeToGraph(g, newTEdge(v4, v5, 10))
addTEdgeToGraph(g, newTEdge(v5, v6, 10))

s.TGraphPathNode=dijkstra(g, v1)

While s<>Null
	Print s\v\value
	
	s=s\succ
Wend

WaitKey()

Der Graph besteht aus einer Ansammlung von Vertice (Knoten) und Edges (Kanten), die jeweils ein Gewicht haben (üblicherweis Kosten/Distanz die benötigt wird die Kante zu beschreiten). Die Funktion [i]dijkstra(graph, start) liefert eine Instanz von TGraphPathNode zurück, diese ist in einer LinkedList stets zum nächsten Knoten verbunden (siehe Print-Beispiel). Der value Eintrag ist hier zu Testzwecken ein String, kann allerdings gefüllt werden mit was auch immer man will.
Edit: Mir ist aufgefallen, dass ich mich in der Entfernung eines Vertex aus der Liste vertippt habe, ebenso bei der Abbruchsbedingung. Ist nun korrigiert.

Bump Mapping:

Wenn ihr euch an meinen vorletzten Eintrag zurückerinnern mögt, dann könnt ihr euch vielleicht noch an meine Rendermethode für Dreiecke erinnern. Ich hatte vor, diese zu erweitern und ihr mittels BumpMapping zu pseudo-Tiefe zu verhelfen. Zuerst habe ich die Grössenbeschränkung von 64x64 gekippt, man kann nun variable (quadratische!) Texturen laden, 2^k muss nicht sein, ist aber üblich, maximal Grösse ist jetzt 256x256 (sonst wird das Array viel zu gross). Die Renderung allein sieht schon einiges besser aus (weniger verschwommen), und mittels BumpMap (auch 256x256 maximal) kommt es eigentlich noch besser.



Nun die Ernüchterung: Es ist generell zu langsam. Für 2 Trigs kriege ich 140FPS, das ist ansich nicht schlecht, aber wenn man bedenkt, dass ich das in meine DaDaPhysik einbauen wollte, dann kann ich damit vielleicht etwa 3 Kisten darstellen, bevor die Schnecke ihre Fühler streckt. Ich musste auch meine Interpolationsmethode wieder rausnehmen, weil es damit auf etwa 60FPS sinkt (für 2 Dreiecke), es sähe zwar etwas schöner aus, ist die Rechenleistung aber nicht wirklich wert. Ich muss mir nun Überlegen ob ich da noch irgendwo etwas rausholen kann um das Ganze schnell genug für den Echteinsatz zu machen.
Wer es mal in Aktion sehen möchte, kann sich hier das Paket mitsamt Source herunterladen.
Anm: Die Funktion fillTrig_HC(trig) ist (ziemlich hässlich ich weiss) die gleiche Funktion wie fillTrig(trig), allerdings ist in der HardCode Methode (daher HC, hat nichts mit HolzChopf zu tun), allerdings ist da alles direkt eingefügt und wird (völlig undynamisch und unübersichtlich) nicht in andere Funktionen ausgelagert. Wer sich den Code ansehen will, soll sich also besser die nicht-HC Funktion ansehen.

Edit: Ich wusste nicht genau wohin ich das stecken soll, aber da das mein eigener Worklog ist und ich entscheiden kann was ich damit mache, habe ich es hierhin gepackt. Ich habe einen Ansatz für einen ziemlich flinken Trig-Filler gefunden, den ich mal fix implementiert habe. Das einzige "Problem" dabei ist, dass man die Punkte sortieren muss, aber das wird in der Funktion direkt gemacht (3 einfache If-Schachteln). Code dazu:

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

Function fillTrig(x1#, y1#, x2#, y2#, x3#, y3#)
	Local aX#, aY#, bX#, bY#, cX#, cY#
	
	If y1<=y2 And y1<=y3
		aX=x1
		aY=y1
		
		If y2<y3
			bX=x2
			bY=y2
			
			cX=x3
			cY=y3
		Else
			bX=x3
			bY=y3
			
			cX=x2
			cY=y2
		EndIf
	EndIf
	
	If y2<=y1 And y2<=y3
		aX=x2
		aY=y2
		
		If y1<y3
			bX=x1
			bY=y1
			
			cX=x3
			cY=y3
		Else
			bX=x3
			bY=y3
			
			cX=x1
			cY=y1
		EndIf
	EndIf
	
	If y3<=y1 And y3<=y2
		aX=x3
		aY=y3
		
		If y1<y2
			bX=x1
			bY=y1
			
			cX=x2
			cY=y2
		Else
			bX=x2
			bY=y2
			
			cX=x1
			cY=y1
		EndIf
	EndIf
	
	Local dx1#, dx2#, dx3#
	
	If bY-aY>0
		dx1=(bX-aX)/(bY-aY)
	Else
		dx1=0
	EndIf
	
	If cY-aY>0
		dx2=(cX-aX)/(cY-aY)
	Else
		dx2=0
	EndIf
	
	If cY-bY>0
		dx3=(cX-bX)/(cY-bY)
	Else
		dx3=0
	EndIf
	
	Local sX#, sY#, eX#
	
	sX=aX
	sY=aY
	
	eX=aX
	
	If dx1>dx2
		While sY<=bY
			Line sX, sY, eX, sY
			
			sY=sY+1
			
			sX=sX+dx2
			eX=eX+dx1
		Wend
		
		eX=bX
		
		While sY<=cY
			Line sX, sY, eX, sY
			
			sY=sY+1
			
			sX=sX+dx2
			eX=eX+dx3
		Wend
	Else
		While sY<=bY
			Line sX, sY, eX, sY
			
			sY=sY+1
			
			sX=sX+dx1
			eX=eX+dx2
		Wend
		
		sX=bX
		sY=bY
		
		While sY<=cY
			Line sX, sY, eX, sY
			
			sY=sY+1
			
			sX=sX+dx3
			eX=eX+dx2
		Wend
	EndIf
End Function

Ende

So, das wars mal wieder von meiner Seite, ich hoffe es hatte etwas Nützliches für den einen oder anderen dabei. Sollte es (aus welchem Grund auch immer) irgendwelche Wünsche für kommende Einträge haben werde ich sehen, was ich umsetzen kann.

Dann bis zum nächsten Mal,
MfG,
Darth

Meh!

Donnerstag, 22. April 2010 von darth

Hallo,

nachdem mir ein Kollege auf Trine aufmerksam gemacht hat, sitze ich in einem Motivationsloch. Ich habe mir die Demo (und einige Videos) mal angesehen und muss sagen, das Spiel ist toll. Das Spiel bringt allerdings ein Motivationsloch mit sich, erstens weil ich das Spiel gerne durchspielen würde (das braucht Zeit) und zweitens .. wieso etwas programmieren, das andere schon besser gemacht haben? Ich muss mir nun überlegen, wohin ich mit meiner Physikengine und meiner Spielidee noch will, Trine hat alles was ich einbauen wollte, und mehr, und schöner, und besser.
Ich mag die Leute nicht.
Also dachte ich, ich grab mal weiter in meinen älteren Dateien und bin auf einige lustige Dinge gestossen. Falls ihr euch an meinen letzten Eintrag erinnert, schrieb ich gegen Ende etwas von alten Spielen, die ich gerne vorgestellt hätte, das tue ich nun (auf eigene Gefahr).

Trubadur

Hach, Trubadur. Das einzige Spiel, das ich etwa 4mal geschrieben habe. Einmal als blutiger Anfänger, da ging gar nichts, aber die Spielidee war da. Dann als etwas erfahrener Rookie, diesmal funktionierte das Spiel in den Grundzügen, war aber unhandlich und ziemlich langsam (da schlecht programmiert). Ein weiteres mal in 3D, ein ziemliches Desaster muss ich sagen, die Animationsart war schrecklich und das Spielprinzip liess sich, v.a wegen fehlenden Lichteinstellungen (oder ich kenne die einfach nicht), fast nicht umsetzen. Und dann noch einmal, diesmal in einem ziemlich "Klassen"-änlichen Stil, der das Ausbauen und weitermachen erleichtern sollte. Das Spiel scheiterte eigentlich jedesmal an sowas wie "Story" oder "Script" oder ganz einfach "Leveldesign". Nunja, Hyde war meist da um mir ein oder zwei Levels zu zeichnen, aber es war mir nie genug für ein richtiges Release, also mache ich das hier im Kleinen.



Der Stand ist, soweit ich mich erinnere, bei etwa 3 Leveln im Story Mode (das Intro hab ich entfernt, das war mir zu.. doof :> und das muss was heissen, siehe "Spiderman in Space"), und einem Testlevel von Hyde (danke dafür!).

Zur Bedienung: Im Menü sollten ein paar Knöpfe sein, die müsste man mit der Maus anklicken können. Wenn die Knöpfe NICHT da sind, dann ist es irgend ein Grafikfehler, das ist mir bei einigen Tests vorgekommen (bei anderen Leuten) afaik liegt das irgendwie an den Grafikkarten die Mühe mit gewissen Sprites haben, in dem Fall: Tough Luck!
Wenn ihr im Spiel mit der Maus an den oberen Bereich fahrt, kommt son ausfahr Menü, das ist eigentlich selbsterklärend (ich weiss nichtmehr wie weit Save/Load sind..). Laufen tut man mit Pfeiltasten, Hoch/Runter sind vor und zurück, links und rechts sind Drehen. Mit der Leertaste kann man die Stacheln (schwarze Punkte am Boden) deaktivieren, würdet ihr einfach drüber laufen, sterbt ihr. Dazu muss man aber den richtigen Schalter (grauer Kasten am Boden) finden.

Der Leveleditor ist mit der Maus steuerbar, sollte ziemlich selbsterklärend sein. Ich habe so schwammig in Erinnerung, irgend einen Kniff eingebaut zu haben, mit dem man eigene Level von Spielleveln unterscheiden kann, aber ich habe vergessen wie das ging und ob er aktiviert ist, und falls nicht, wie man es tut Nunja, kommt Zeit geht Erinnerung.

Hier der Download Link (~1MB)

What da Fock?

Öhm, ja. Der Titel kommt eigentlich von Tobi. Ich habe mich mal als "Let's Player" versucht, war ein Desaster, aber Tobi fand meine Aussprache ziemlich lustig, darum hat er davon mal ein Remix (oder sowas in der Art) gemacht, und ich habe dann ein Video mit meinem damaligen Spiel gemacht (hihi, billiger Trick um Views zu kriegen!). Falls ihr "I wanna be the Guy" kennt, spielt das - es ist besser, und es ist eigentlich genau das gleiche. Es ist ein Spiel, das darauf ausgelegt ist, euch zuerst etwa 25mal zu töten, bevor ihr das Ende erreicht.
Die Struktur des Spiels ist ziemlich miserabel, es ist so ziemlich alles hardcoded, was ging. Ich habe auch keinen Überblick mehr, was ich alles für Dateien beilegen müsste, und was nur Hilfsdateien waren, ich habe einfach mal aussortiert und geschaut, dass das Spiel immerhin startet. Falls es also MAVs geben sollte, liegt es wahrscheinlich daran. Zudem kann es sein, dass die Kollision nicht in 100% der Fällen richtig funktioniert, vor allem bewegende Plattformen könnten heikel sein, wenn ich mich richtig entsinne. Das Spiel sollte eigentlich mal eine Geschichte kriegen, die einzelnen Level-Gruppen haben deshalb auch ein übergeordnetes Thema und Endbosse, die theoretisch eine Bedeutung haben, allerdings war ich stets zu faul irgendwelche Scripts zu schreiben.
Ich weiss nicht, ob ich das Spiel überhaupt vorstellen darf, so ziemlich sämtliche Grafiken sind geklaut und unterstehen höchstwahrscheinlich einem Copyright von irgendeiner Seite :/ Falls es ein Problem sein sollte, werde ich das Spiel wieder löschen.



Steuerung ist eigentlich relativ simpel: Mit den Pfeiltasten kann man links und rechts bewegen, und mit der Hoch Taste kann man springen. Man kann einen Doppelsprung machen, wenn man in der Luft nochmal die Hochtaste drückt. Speichern kann man, wenn man in die leeren Rechtecke (auf dem Screen ganz links) springt, das sollte eigentlich in das "state" File schreiben, und euern Fortschritt speichern (keine Garantie darauf :>). Es sind ALLE Level schaffbar, ich habe jedes getestet (wenn auch nicht vor Kurzem *hust*). Aber ich würde mich ernsthaft wundern, wenn es jemand bis nach dem ersten Schirm aushält .

Der Download ist etwas grösser (~4.5MB), weil ziemlich viele Bild Dateien in völlig verschiedenen Formaten enthalten sind und zusätzlich noch einige Musikfiles. Um zu starten, sucht euch die Datei "Start.exe" in dem Gewühl von Dateien.

Evolution

So, nun muss ich eine Überleitung von den Dinosauriern zu Neuzeitlicheren Entwicklungen bringen. What killed the dinosaurs?. Naja, eigentlich liegt der gute Mr. Freeze ja falsch, es war die Evolution (jedenfalls behaupte ich das, um einen Grund zu haben das Nachfolgende als Überleitung zu verwenden).
Ich wollte mal eine (für mich) neue Art der KI ausprobieren. Ich versuchte mich also an evolutionären Algorithmen. Testgelände sollte ein TicTacToe Spiel sein, wie ihr vllt wisst, gibt es 9^2=81 Möglichkeiten für Feldkombinationen, auf die es richtige und falsche Antworten gibt. Natürlich könnte man nun all diese 81 hinschreiben und scripten, wie die KI reagieren soll, aber das wollte ich nicht. Ich habe meinen Spielern zwei Listen gegeben, eine von bekannten Feldpositionen und eine von folgenden Reaktionen. Dann habe ich sie spielen lassen, bei unbekannten Konstellationen wird zufällig gesetzt und das Ergebnis gespeichert. Nach einer gewissen Anzahl an Spielen sortiere ich (erinnert ihr euch an den letzten Eintrag? :> ) nach Erfolg, und die besseren dürfen sich fortpflanzen, die Verlierer sterben. Zusätzlich füge ich noch ein zufälliges Element ein (neuer Spieler).



Das Ergebnis ist relativ ernüchternd. Zum Teil zeigt die KI Anwandlungen von relativer Genialität (oder ich bin einfach nicht geeignet für diese Art von Spiel) und überrumpelt mich total, und dann wiederum kann ich nacheinander drei Steine auf die obere Gerade Setzen und gewinnen. Meh! Lohnt sich meiner Meinung nach nicht wirklich. Eigentlich wollte ich dieses System nutzen, um eine sich steigernde KI in meinem Spiel zu haben (sie kommt nichts-ahnend ins Spiel, und lernt durch den Spieler dazu). Allerdings fehlt mir dafür noch ein objektiveres Wertungssystem und sowas, mal sehn was daraus wird.

Der Code im Anhang. Nach einer Aufwärmphase für die KI kann man selber spielen. Dabei wird bei einem Gewinn sofort das Feld für ein neues Spiel vorbereitet - der Gewinner ist, wer den letzen Zug hatte

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

;/*
; * Spieler Verwaltung
; */

Const MAX_MEM=100

Global pList.TPlayer[100]
Global plCount=0

Type TPlayer
	Field fieldState$[MAX_MEM]
	Field reaction[MAX_MEM]
	
	Field stone$
	
	Field sCount
	
	Field victories
	Field defeats
	Field ties
	
	Field age
End Type

Function cTPlayer.TPlayer(stone$)
	Local p.TPlayer=New TPlayer
	
	p\stone=stone
	
	Return p
End Function

Function addPlayer(p.TPlayer)
	pList[plCount]=p
	plCount=plCount+1
End Function

Function addRndPlayers(anz)
	Local s

	For i=1 To anz
		s=Rand(1,2)
		
		If s=1
			pList[plCount]=cTPlayer("X")
		Else
			pList[plCount]=cTPlayer("O")
		EndIf
		
		plCount=plCount+1
	Next
End Function

Function removePlayer(p.TPlayer)
	For i=0 To plCount-1
		If pList[i]=p
			removePlayerByIndex(i)
			Return
		EndIf
	Next
End Function

Function removePlayerByIndex(i)
	If plCount=0
		Return
	EndIf
	
	Delete pList[i]
	
	For j=i+1 To plCount-1
		pList[j-1]=pList[j]
	Next
	pList[plCount-1]=Null
	
	plCount=plCount-1
End Function

;/*
; * KI Verwaltung
; */

Function playerMove(p.TPlayer)
	Local s$=getFieldState()
	Local i=stateKnown(p, s)
	Local iNeu
	
	If i<>-1
		If tField[p\reaction[i]]="-"
			tField[p\reaction[i]]=p\stone
		Else
			While True
				set=setRandom()
				If tField[set]="-"
					tField[set]=p\stone
					
					Exit
				EndIf
			Wend
		EndIf
	Else
		While True
			set=setRandom()
			
			If tField[set]="-"
				tField[set]=p\stone
				saveState(p, s, set)
				
				Exit
			EndIf
		Wend
	EndIf
End Function

Function setRandom()
	Local poss[9]
	Local pCount=0
	
	For i=0 To 8
		If tField[i]="-"
			poss[pCount]=i
			pCount=pCount+1
		EndIf
	Next
	
	Return poss[Rand(0,pCount-1)]
End Function

Function getFieldState$()
	Local s$=""
	
	For i=0 To 8
		If tField[i]=""
			tField[i]="-"
		EndIf
		
		s=s+tField[i]
	Next
	
	Return s
End Function

Function stateKnown(p.TPlayer, state$)
	For i=0 To p\sCount-1
		If p\fieldState[i]=state
			Return i
		EndIf
	Next
	
	Return -1
End Function

Function saveState(p.TPlayer, state$, reaction)
	If p\sCount>=MAX_MEM
		Return
	EndIf
	
	If stateKnown(p, state)=-1
		p\fieldState[p\sCount]=state
		p\reaction[p\sCount]=reaction
		
		p\sCount=p\sCount+1
	EndIf
End Function


;/*
; * Evolution
; */


Function nextGeneration(games)
	For i=0 To games
		startGame()
		
		While Not checkVictory()
			gameRoutine()
		Wend
	Next
	
	quickSort(pList, 0, plCount-1)
	
	Local oldCount=plCount
	Local halfCount=plCount/2
	
	For i=plCount-1 To plCount-halfCount Step -1
		addPlayer(giveBirth(pList[i], pList[i-1]))
		addPlayer(giveBirth(pList[i], pList[Rand(0,plCount-1)]))
	Next
	
	For i=0 To halfCount-1
		removePlayerByIndex(0)
	Next
	
	removePlayerByIndex(Rand(0, halfCount-1))
	addRndPlayers(1)
	
	If plCount<oldCount
		For i=plCount To oldCount-1
			addRndPlayers(1)
		Next
	ElseIf plCount>oldCount
		While plCount<>oldCount
			removePlayerByIndex(Rand(0, Rand(0, plCount-1)))
		Wend
	EndIf
End Function

Function giveBirth.TPlayer(p1.TPlayer, p2.TPlayer)
	Local count=(p1\sCount+p2\sCount)/2
	Local p.TPlayer
	
	If Rand(0,1)=0
		p=cTPlayer("O")
	Else
		p=cTPlayer("X")
	EndIf
	
	For i=0 To count-1
		If Rand(0,1)=0
			If i<p1\sCount
				saveState(p, p1\fieldState[i], p1\reaction[i])
			Else
				saveState(p, p2\fieldState[i], p2\reaction[i])
			EndIf
		Else
			If i<p2\sCount
				saveState(p, p2\fieldState[i], p2\reaction[i])
			Else
				saveState(p, p1\fieldState[i], p1\reaction[i])
			EndIf
		EndIf
	Next
	
	Return p
End Function

Function quickSort(list.TPlayer[100], le, ri)
	Local l_tmp, r_tmp, piv, pivEl.TPlayer
	
	l_tmp=le
	r_tmp=ri
	piv=list[le]\victories
	pivEl=list[le]
	
	While le<ri
		While list[ri]\victories>=piv And le<ri
			ri=ri-1
		Wend
		If le<>ri
			list[le]=list[ri]
			le=le+1
		EndIf
		While list[le]\victories<=piv And le<ri
			le=le+1
		Wend
		If le<>ri
			list[ri]=list[le]
			ri=ri-1
		EndIf
	Wend
	
	list[le]=pivEl
	piv=le
	le=l_tmp
	ri=r_tmp
	
	If le<piv
		quickSort(list, le, piv-1)
	EndIf
	
	If ri>piv
		quickSort(list, piv+1, ri)
	EndIf
End Function

Function savePlayers()
	Local stream=WriteFile("TTT_AI.txt")
	Local p.TPlayer
	
	quickSort(pList, 0, plCount-1)
	
	For j=0 To plCount-1
		p=pList[j]
		
		If p\sCount>0
			WriteLine stream, "Player "+p\stone
			WriteLine stream, p\sCount
			
			For i=0 To p\sCount-1
				WriteLine stream, p\fieldState[i]+" "+p\reaction[i]
			Next
		EndIf
	Next
End Function

Function loadPlayers()
	Local stream=ReadFile("TTT_AI.txt")
	Local p.TPlayer, s$
	
	While Not Eof(stream)
		s=ReadLine(stream)
		
		If s=Left(s, 6)="Player"
			p=New TPlayer
			
			p\stone=Right(s,1)
			p\sCount=Int(ReadLine(stream))
			
			For i=0 To p\sCount-1
				s=ReadLine(stream)
				
				p\fieldState[i]=Left(s, 9)
				p\reaction[i]=Right(s, 1)
			Next
			
			pList[plCount]=p
			plCount=plCount+1
		EndIf
	Wend
End Function

;/*
; * Spiel Verwaltung
; */

Const FIELD_SIZE=50
Global tField$[9]

Global player1.TPlayer
Global player2.TPlayer
Global victor.TPlayer

Global human=True
Global turn=0

Function startGame()
	For i=0 To 8
		tField[i]="-"
	Next
	
	If human
		If player1=Null
			player1=cTPlayer("O")
		EndIf
	Else
		If plCount=0
			player1=cTPlayer("O")
			
			pList[0]=player1
			plCount=plCount+1
		Else
			player1=pList[Rand(0, plCount-1)]
		EndIf
	EndIf
	
	If plCount=0 Or (plCount=1 And human=False)
		player2=cTPlayer("X")
		
		pList[plCount]=player2
		plCount=plCount+1
	Else
		While True
			player2=pList[Rand(0, plCount-1)]
			
			If player2<>player1
				If player2\stone<>player1\stone
					Exit
				EndIf
			EndIf
		Wend
	EndIf
	
	turn=0
	
	victor=Null
	
	player1\age=player1\age+1
	player2\age=player2\age+1
	
	SeedRnd(MilliSecs())
End Function

Function gameRoutine()
	If checkVictory()=True
		Return
	EndIf
	
	If player1=Null Or player2=Null
		Return
	EndIf
	
	If turn=0
		If human
			If MouseHit(1)
				If setStone(player1\stone, MouseX(), MouseY())
					turn=1-turn
				EndIf
			EndIf
		Else
			playerMove(player1)
			turn=1-turn
		EndIf
	Else
		playerMove(player2)
		turn=1-turn
	EndIf
End Function

Function setStone(stone$, sx, sy)
	Local x=sx/FIELD_SIZE
	Local y=sy/FIELD_SIZE
	
	If tField[x+y*3]="-"
		saveState(player1, getFieldState(), x+y*3)
		
		tField[x+y*3]=stone$
		Return True
	EndIf
	
	Return False
End Function

Function checkVictory()
	If player1=Null Or player2=Null
		Return True
	EndIf
	
	Local vic$
	
	For i=0 To 2
		vic=tField[i*3]
		For x=0 To 2
			If tField[i*3+x]<>vic
				vic="-"
			EndIf
		Next
		
		If vic<>"-"
			Exit
		EndIf
		
		vic=tField[i]
		For y=0 To 2
			If tField[i+y*3]<>vic
				vic="-"
			EndIf
		Next
		
		If vic<>"-"
			Exit
		EndIf
		
		vic="-"
	Next
	
	If tField[0]=tField[4] And tField[4]=tField[8]
		If tField[0]<>"-"
			vic=tField[0]
		EndIf
	EndIf
	
	If tField[2]=tField[4] And tField[4]=tField[6]
		If tField[2]<>"-"
			vic=tField[2]
		EndIf
	EndIf
	
	If vic="O"
		victor=player1
		player1\victories=player1\victories+1
		player2\defeats=player2\defeats+1
		
		Return True
	ElseIf vic="X"
		victor=player2
		player2\victories=player2\victories+1
		player1\defeats=player1\defeats+1
		
		Return True
	EndIf
	
	For i=0 To 8
		If tField[i]="-"
			Return False
		EndIf
	Next
	
	victor=Null
	player1\ties=player1\ties+1
	player2\ties=player2\ties+1
	
	Return True
End Function

Function drawField()
	Local y=0
	Local x=0
	
	For i=0 To 8
		If tField[i]<>"-"
			Text x*FIELD_SIZE, y*FIELD_SIZE, tField[i]
		EndIf
		
		x=x+1
		
		If x Mod 3=0
			y=y+1
			x=0
		EndIf
	Next
	
	For x=1 To 2
		Line x*FIELD_SIZE, 0, x*FIELD_SIZE, FIELD_SIZE*3
	Next
	
	For y=1 To 2
		Line 0, y*FIELD_SIZE, FIELD_SIZE*3, y*FIELD_SIZE
	Next
End Function

;/*
; * Testumgebung
; */

Graphics 640,480,0,2
SetBuffer BackBuffer()

human=False
addRndPlayers(20)

For i=0 To 500
	nextGeneration(10)
Next

quickSort(pList, 0, plCount-1)
human=True

Local timer=CreateTimer(60)
While Not KeyHit(1)
	
	gameRoutine()
	drawField()
	
	If checkVictory()
		startGame()
		
		player2=pList[plCount-1]
		player1=cTPlayer("")
		
		If player2\stone="X"
			player1\stone="O"
		Else
			player1\stone="X"
		EndIf
	EndIf
	
	Flip 0
	WaitTimer(timer)
	Cls
Wend

;savePlayers()

End

Bakterien und so

Naja, eigentlich eher Metaballs, aber wieso ich es Bakterien nenne, kommt in Kürze. Falls ihr euch an meine (mittlerweilen) uralte Wassersimulation erinnert, wisst ihr vielleicht noch, dass ich das (u.a) damals mit Metaballs gerendert habe. Die Methode dazu war von Noobody und das wurmte mich, ich wollte den Krempel selber schreiben. Aber ich hatte keine Zeit und liess es liegen (v.a weil ich irgendwann auf blosse Pixel umgestiegen bin..). Aber ich habe es vor Kurzem wieder aufgenommen und weitergemacht.

Der erste Ansatz war, einen Quadtree zu verwenden, um nicht immer alle Bälle berücksichtigen zu müssen, sondern nur diejenigen, die auch Einfluss haben. Das Ergebnis war - falsch.



Es kommt zu Fehlern an Grenzen. Das liegt daran, dass der zweite Metaball nicht berücksichtigt wird, da er in einem anderen Quadrat liegt, allerdings hat er dennoch Einfluss auf das Feld. Ausserdem ist die Methode nicht wirklich viel schneller, als ohne QT Optimierung (.. 5 Bälle, ob ich jetzt 2 oder 5 durchlaufe macht den Braten auch nicht fetter). Darum wurde diese Idee aufgegeben.
Da ich im Moment nicht weiss, wofür man einen QuadTree brauchen könnte, spare ich es mir, den Code zu posten. Ich hatte ihn darauf ausgelegt, möglichst universell einsetzbar zu sein, man muss halt nur gewisse Type-Namen ändern (von MetaBall zu MyType), und die Überlappfunktion anpassen. Sobald mir was Kluges einfällt, kommt ein Beispiel dazu.

Dann erinnerte ich mich an diesen Eintrag im Codearchiv, wo das Prinzip der Marching Cubes in 3D implementiert wurde (für ein Voxelgitter iirc). Das Gleiche müsste sich eigentlich in 2D auch machen lassen, und siehe da, es gibt den Marching Squares Algorithm. Wer vor einigen Tagen ins Forum schaute, sah vielleicht, dass diese Auswahlregeln nicht ausreichen, es braucht noch die alte Richtung bei den Querfällen.



(Sieht das nicht voll nach Bakterien aus die herumwuseln? Nein? ... Wie auch immer, mein Beitrag, meine Vergleiche!)
Durch diese Methode der Randfindung, lässt sich das Zeichnen ziemlich beschleunigen, da ich zunächst einmal ein Gitter habe (hier: 80x60), was einige Berechnungen spart. Zudem muss ich eigentlich nur die Felder des Randes berechnen (und einige Startpunkte suchen), das ist ansich kein grosser Aufwand.
Was schon etwas langsamer wird, ist das Füllen. Ich kam nicht umhin, einen FloodFill zu integrieren, weil mein ScanLine wieder das alte Problem hatte "wo zeichne ich, und wo nicht", vor allem bei Anfängen von Linien, die horizontal sind und das Feld abschliessen. (Die Funktion ist noch im Code enthalten, könnt euch das Resultat ja mal ansehen).
Der FloodFill benutzt kein ReadPixel, sondern ein Raster, dieses wird beim Zeichnen des Randes mittels des Bresenham-Algorithmus (letzer Eintrag, mann war der nützlich!) gesetzt, und danach wird vom Startpunkt des Randes aus gefüllt. Das ist zwar etwas riskant, funktioniert aber in den meisten Fällen (in gewissen Ausnahmen füllt es das Bild ringsherum :> ).

Code hier (es sind noch einige Debugelemente drin, die man getrost entfernen kann):

BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN]

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

;/*
; * MetaBall
; */

Const threshold#=0.004

Type MetaBall
	Field x#
	Field y#
	
	Field vx#
	Field vy#
End Type

Function drawMetaBalls()
	Dim screenMap(GraphicsWidth(), GraphicsHeight())
	;Dim peakValues(2, GraphicsHeight())
	
	;For y=0 To GraphicsHeight()-1
	;	peakValues(0, y)=GraphicsWidth()
	;Next
	
	Dim fieldData(gridWidth,gridHeight)
	Dim fieldDone(gridWidth,gridHeight)
	Dim fieldRendered(gridWidth,gridHeight)
	
	Local hull.Path
	
	Local MX
	Local MY
	
	Local count=0
	LockBuffer BackBuffer()
	
	For m.metaBall=Each MetaBall
		MX=m\x*gridWidth/GraphicsWidth()+1
		MY=m\y*gridHeight/GraphicsHeight()+1
		
		For yi=MY To 1 Step -1
			If Not fieldDone(MX,yi)
				fieldData(MX,yi)=getDataField(MX, yi)
			EndIf
			
			If yi<MY
				If fieldData(MX, yi)=0
					If fieldData(MX, yi+1)=1 And fieldRendered(MX, yi+1)=False
						hull=identifyPerimeter(MX, yi+1)
						
						If hull=Null
							stopped=True
						Else
							hull\parent=m
							drawPath(hull)
							
							count=count+1
						EndIf
					EndIf
					
					Exit
				EndIf
			EndIf
		Next
	Next
	
	fillHulls()
	
	UnlockBuffer BackBuffer()

	Text 10,10,count
	
	Delete Each Point
	Delete Each Direction
	Delete Each Path
End Function

;// MetaBall

;/*
; * Flood Fill
; */

Type TPixel
	Field x
	Field y
End Type

Function newTPixel.TPixel(x, y)
	Local p.TPixel=New TPixel
	
	p\x=x
	p\y=y
	
	Return p
End Function

Dim screenMap(GraphicsWidth(), GraphicsHeight())
;Dim peakValues(2, GraphicsHeight())

Function sBLine(x0, y0, x1, y1)
	;Local col=ColorRed()*$10000+ColorGreen()*$100+ColorBlue()
	
	Local steep
	Local tmp, dX, dY, err, yStep, y
	
	If Abs(y1-y0)>Abs(x1-x0)
		steep=True
		
		tmp=x0
		x0=y0
		y0=tmp
		
		tmp=x1
		x1=y1
		y1=tmp
	Else
		steep=False
	EndIf
	
	If x0>x1
		tmp=x0
		x0=x1
		x1=tmp
		
		tmp=y0
		y0=y1
		y1=tmp
	EndIf
	
	dX=x1-x0
	dY=Abs(y1-y0)
	err=dX/2
	y=y0
	
	If y0<y1
		yStep=1
	Else
		yStep=-1
	EndIf
	
	If steep
		For x=x0 To x1
			;WritePixelFast y,x,col
			
			screenMap(y, x)=True
			;If y
			;	peakValues(0, x)=y
			;EndIf
			;If y>peakValues(1, x)
			;	peakValues(1, x)=y
			;EndIf
			
			err=err-dY
			
			If err<0
				y=y+yStep
				
				err=err+dX
			EndIf
		Next
	Else
		For x=x0 To x1
			;WritePixelFast x,y,col
			
			screenMap(x, y)=True
			;If x
			;	peakValues(0, y)=x
			;EndIf
			;If x>peakValues(1, y)
			;	peakValues(1, y)=x
			;EndIf
			
			err=err-dY
			
			If err<0
				y=y+yStep
				
				err=err+dX
			EndIf
		Next
	EndIf
End Function

Function fillHull(hull.Path)
	Local factorX#=GraphicsWidth()/gridWidth
	Local factorY#=GraphicsHeight()/gridHeight
	
	Local col=0*$10000+55*$100+255
	Local startX, startY, newX, newY
	Local p.TPixel, n.TPixel
	
	startX=hull\parent\x
	startY=hull\parent\y
	
	p=newTPixel(startX, startY)
	WritePixelFast startX, startY, col
	screenMap(startX, startY)=True
	
	For p=Each TPixel
		For dir=0 To 3
			newX=p\x+(dir=0)-(dir=2)
			newY=p\y+(dir=1)-(dir=3)
			
			If newX>=0 And newY>=0 And newX<GraphicsWidth() And newY<GraphicsHeight()
				If screenMap(newX, newY)=0
					If Not screenMap(newX, newY)
						n=newTPixel(newX, newY)
						
						WritePixelFast newX, newY, col
						screenMap(newX, newY)=True
					EndIf
					;Else
					;	WritePixelFast newX, newY, col
				EndIf
			EndIf
		Next
		
		Delete p
	Next
End Function
	
Function fillHulls()
	Local factorX#=GraphicsWidth()/gridWidth
	Local factorY#=GraphicsHeight()/gridHeight
	
	Local col=0*$10000+55*$100+255
	Local hull.Path
	Local startX, startY, newX, newY
	Local p.TPixel, n.TPixel
	
	For hull=Each Path
		;Hmm, Start ist etwas riskant
		; nach Möglichkeit ist der Punkt ausserhalb des Pfads
		; (oder auf der Linie)
		
		startX=hull\parent\x;hull\originX*factorX+1
		startY=hull\parent\y;hull\originY*factorY+1
		
		p=newTPixel(startX, startY)
		WritePixelFast startX, startY, col
		screenMap(startX, startY)=True
		
		For p=Each TPixel
			For dir=0 To 3
				newX=p\x+(dir=0)-(dir=2)
				newY=p\y+(dir=1)-(dir=3)
				
				If newX>=0 And newY>=0 And newX<GraphicsWidth() And newY<GraphicsHeight()
					If screenMap(newX, newY)=0
						If Not screenMap(newX, newY)
							n=newTPixel(newX, newY)
							
							WritePixelFast newX, newY, col
							screenMap(newX, newY)=True
						EndIf
					;Else
					;	WritePixelFast newX, newY, col
					EndIf
				EndIf
			Next
			
			Delete p
		Next
	Next
End Function

;Function fillHulls_wrong()
;	Local fill, col
;	
;	col=255*$10000+255*$100+0
;	
;	For y=0 To GraphicsHeight()
;		If peakValues(0, y)
;			fill=True
;			
;			While screenMap(peakValues(0, y), y)=True
;				peakValues(0, y)=peakValues(0, y)+1
;			Wend
;			
;			For x=peakValues(0, y) To peakValues(1, y)
;				If screenMap(x, y)
;					While screenMap(x, y)
;						x=x+1
;					Wend
;					
;					fill=1-fill
;				EndIf
;				
;				If fill
;					WritePixelFast x, y, col
;				EndIf
;			Next
;		EndIf
;	Next
;End Function

;// FloodFill

;/*
; * Marching Squares Algorithm
; */

Global gridWidth=80
Global gridHeight=60

Dim fieldData(0,0)
Dim fieldDone(0,0)
Dim fieldRendered(0,0)

Type Point
	Field x#
	Field y#
	
	Field prev.Point
	Field succ.Point
End Type

Function newPoint.Point(x#, y#)
	Local p.Point=New Point
	
	p\x=x
	p\y=y
	
	Return p
End Function

Global North[2]	: North[1]=-1
Global East[2]	: East[0]=1
Global South[2]	: South[1]=1
Global West[2]	: West[0]=-1

Type Direction
	Field dirX
	Field dirY
	
	Field succ.Direction
End Type

Function newDirection.Direction(dir[2])
	d.direction=New Direction
	
	d\dirX=dir[0]
	d\dirY=dir[1]
	
	Return d
End Function

Type Path
	Field originX
	Field originY
	
	Field pList.Point
	Field count
	
	Field parent.MetaBall
End Type

Function newPath.Path(startX, startY, directions.Direction)
	Local p.Path=New Path
	
	p\originX=startX
	p\originY=startY
	
	p\pList=New Point
	p\pList\x=startX
	p\pList\y=startY
	
	fieldRendered(startX,startY)=True
	
	Local pList.Point=p\pList
	
	Repeat
		pList\succ=New Point
		pList\succ\prev=pList
		
		pList\succ\x=pList\x+directions\dirX
		pList\succ\y=pList\y+directions\dirY
		
		pList=pList\succ
		directions=directions\succ
		
		fieldRendered(pList\x,pList\y)=True
		
		p\count=p\count+1
	Until directions=Null
	
	Return p
End Function

;// can be used to find the path around one speciffic connected field
Function identifyPerimeterStart.Path()
	Dim fieldData(gridWidth, gridHeight)
	Dim fieldDone(gridWidth, gridHeight)
	Dim fieldRendered(gridWidth,gridHeight)
	
	For x=0 To gridWidth-1
		For y=0 To gridHeight-1
			fieldData(x,y)=getDataPoint(GraphicsWidth()/gridWidth*x,GraphicsHeight()/gridHeight*y)
		Next
	Next
	
	For x=0 To gridWidth-1
		For y=0 To gridHeight-1
			If fieldData(x,y)<>0
				Return identifyPerimeter(x,y)
			EndIf
		Next
	Next
	
	Return Null
End Function

Function identifyPerimeter.Path(initialX, initialY)
	Local initialValue=getDirection(initialX,initialY, Null)
	If initialValue=-1
		DebugLog "Wrong start Point"
		stopped=True
		Return Null
	EndIf
	
	Local dir.Direction
	
	Local X=initialX
	Local Y=initialY
	
	Local maxIter=1000
	Local iter=0
	
	Local p.Path=New Path
	
	p\originX=initialX
	p\originY=initialY
	
	p\pList=newPoint(initialX, initialY)
	fieldRendered(initialX, initialY)=True
	
	Local pList.Point=p\pList
	
	Repeat
		iter=iter+1
		If iter>maxIter
			;Wenn es hierzu kommt, ist irgendwo ein Fehler passiert
			; ich weiss nicht wie es dazu kommt :/
			; das Ergebnis sind Linien durch das Objekt
			
			stopped=True
			DebugLog "overflow"
			Exit
		EndIf
		
		Select getDirection(X, Y, dir)
			Case 1
				dir=newDirection(North)
			Case 2
				dir=newDirection(East)
			Case 3
				dir=newDirection(South)
			Case 4
				dir=newDirection(West)
			Default
				stopped=True
				DebugLog "wrong direction"
				Return Null
		End Select
		
		X=X+dir\dirX
		Y=Y+dir\dirY
		
		pList\succ=New Point
		pList\succ\prev=pList
		
		pList\succ\x=pList\x+dir\dirX
		pList\succ\y=pList\y+dir\dirY
		
		pList=pList\succ
		
		fieldRendered(pList\x, pList\y)=True
		
		p\count=p\count+1
	Until X=initialX And Y=initialY
	
	Return p
End Function

Function getDirection(x, y, lastDir.Direction)
	Local d1, d2, d3, d4
	
	d1=getDataField(x-1,y-1)
	d2=getDataField(x,y-1)
	d3=getDataField(x-1,y)
	d4=getDataField(x,y)
	
	Local sum=d1+d2+d3+d4
	
	Local N=1 ; NORTH
	Local E=2 ; EAST
	Local S=3 ; SOUTH
	Local W=4 ; WEST
	
	Select sum
		Case 0
			Return E
		Case 1
			If d2
				Return E
			ElseIf d4
				Return S
			ElseIf d1
				Return N
			ElseIf d3
				Return W
			EndIf
		Case 2
			If d2 And d4
				Return S
			ElseIf d1 And d2
				Return E
			ElseIf d1 And d3
				Return N
			ElseIf d3 And d4
				Return W
			ElseIf d1 And d4
				If lastDir=Null
					Return N
				Else
					If lastDir\dirX=1
						Return N
					Else
						Return S
					EndIf
				EndIf
				
				;Return N ;Original Line
			ElseIf d2 And d3
				If lastDir=Null
					Return W
				Else
					If lastDir\dirY=1
						Return W
					Else
						Return E
					EndIf
				EndIf
				
				;Return W ;Original Line
			EndIf
		Case 3
			If Not d2
				Return N
			ElseIf Not d1
				Return W
			ElseIf Not d3
				Return S
			ElseIf Not d4
				Return E
			EndIf
		Default
			Return -1
	End Select
End Function

Function getDataField(x,y)
	If x<=0 Or x>gridWidth Or y<=0 Or y>gridHeight
		Return 0
	Else
		If Not fieldDone(x,y)
			fieldData(x,y)=getDataPoint(GraphicsWidth()/gridWidth*x,GraphicsHeight()/gridHeight*y)
			fieldDone(x,y)=True
		EndIf
		
		Return fieldData(x,y)
	EndIf
End Function

;// this function should be overwritten if used elsewhere
Function getDataPoint(x,y)
	Local strength#=0
	
	For m.metaBall=Each MetaBall
		strength=strength+1./((x-m\x)^2+(y-m\y)^2)
	Next
	
	If strength>threshold
		Return True
	Else
		Return False
	EndIf
End Function

Function normalDrawPath(hull.Path)
	Local factorX#=GraphicsWidth()/gridWidth
	Local factorY#=GraphicsHeight()/gridHeight
	
	Local pIter.Point
	Local pMiddle.Point
	Local pLeft.Point
	Local pRight.Point
	
	pIter=hull\pList
	
	Local x1#,y1#
	Local x2#,y2#
	
	pMiddle=pIter
	pLeft=prevPoint(hull,pMiddle)
	pRight=succPoint(hull,pMiddle)
	
	x1=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
	y1=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25
	
	Repeat ;the points are counter clockwise
		pMiddle=succPoint(hull,pIter)
		pLeft=pIter
		pRight=succPoint(hull,pMiddle)
		
		x2=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
		y2=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25
		
		Line x1*factorX,y1*factorY,x2*factorX,y2*factorY
		
		pIter=pIter\succ
		
		x1=x2
		y1=y2
	Until pIter=Null
End Function

Function drawPath(hull.Path)
	Local factorX#=GraphicsWidth()/gridWidth
	Local factorY#=GraphicsHeight()/gridHeight
	
	Local pIter.Point
	Local pMiddle.Point
	Local pLeft.Point
	Local pRight.Point
	
	pIter=hull\pList
	
	Local x1#,y1#
	Local x2#,y2#
	
	pMiddle=pIter
	pLeft=prevPoint(hull,pMiddle)
	pRight=succPoint(hull,pMiddle)
	
	x1=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
	y1=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25
	
	Repeat ;the points are counter clockwise
		pMiddle=succPoint(hull,pIter)
		pLeft=pIter
		pRight=succPoint(hull,pMiddle)
		
		x2=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
		y2=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25
		
		sBLine x1*factorX,y1*factorY,x2*factorX,y2*factorY
		
		pIter=pIter\succ
		
		x1=x2
		y1=y2
	Until pIter=Null
End Function

Function prevPoint.Point(hull.Path,p.Point)
	Local prev.Point
	Local pIter.Point
	
	prev=p\prev
	
	If prev=Null
		pIter=hull\pList
		
		Repeat
			pIter=pIter\succ
		Until pIter\succ=Null
		
		prev=pIter
	EndIf
	
	Return prev
End Function

Function succPoint.Point(hull.Path,p.Point)
	Local succ.Point
	Local pIter.Point
	
	succ=p\succ
	
	If succ=Null
		succ=hull\pList
	EndIf
	
	Return succ
End Function

Function lRect(x, y, w, h)
	Line x, y, x+w, y
	Line x+w, y, x+w, y+h
	Line x+w, y+h, x, y+h
	Line x, y+h, x, y
End Function

;// Marching Squares Algorithm

;/*
; * Test Program
; */

;SeedRnd(MilliSecs())

For k=1 To 50
	m.metaBall=New MetaBall
	
	m\x=Rnd(200,500)
	m\y=Rnd(200,400)
	
	m\vx=Rnd(-1.5,1.5)
	m\vy=Rnd(-1.5,1.5)
Next

Global stopped=False

timer=CreateTimer(60)
While Not KeyHit(1)
	If MouseHit(2)
		stopped=Not stopped
	EndIf
	
	If stopped
		Color 125,125,125
		Text 50,10,"Stopped"
		
		For xn=0 To gridWidth
			For yn=0 To gridHeight
				fieldData(xn,yn)=getDataField(xn,yn)
				If fieldData(xn,yn)
					Rect xn*10,yn*10,10,10
				EndIf
			Next
		Next
	EndIf
	
	Color 255,255,255
	drawMetaBalls()
	
	For m.metaBall=Each MetaBall
		If Not stopped
			m\x=m\x+m\vx
			m\y=m\y+m\vy
		EndIf
		
		If m\y<100 Or m\y>500
			m\vy=-m\vy
		EndIf
		If m\x<100 Or m\x>700
			m\vx=-m\vx
		EndIf
		
		WritePixel m\x, m\y, 255*$10000+255*$100+255
	Next
	
	fps=fps+1
	If MilliSecs()-fpsTime>999
		fpsCur=fps
		fpsTime=MilliSecs()
		fps=0
	EndIf
	Text 780,580,fpsCur
	
	Flip 0
	Cls
	WaitTimer(timer)
Wend

Edit: Ich habe den Vorgang nochmal etwas beschleunigt, früher wurde der Pfad (theoretisch) zweimal berechnet, das geschieht nun direkt. Die Beschleunigung ist zwar eher gering. Ausserdem habe ich einige Versuchswerte von früheren Tests rausgenommen, die noch drin waren. Und die Zeichenfunktion wurde etwas angepasst, damit er die Punkte nicht immer doppelt berechnet. Neu wird auch im Pfad der Ausgangspunkt gespeichert, das sorgt dafür, dass ich einen Startpunkt für die Füllroutine habe, der garantiert innerhalb des geschlossenen Pfades liegt, es sollte nun also nichtmehr zur Füllung des Bildschirms kommen.

Ende

So, das wars mal wieder von mir. Ich bin sicher, ich habe wieder eine Menge von dem vergessen, was ich eigentlich vorstellen oder erwähnen wollte. Aber dafür habe ich ja Zeit in den nächsten Einträgen. Bis dahin werde ich mir überlegen, was ich mit meinem Spiel mache, wie ich mein Wasser restrukturieren könnte (das hat immernoch arge Probleme mit Wänden -> es diffundiert), und wie ich es mit geringem Aufwand schaffe, interessante grafische Effekte (Feuer u.Ä) zu erzeugen. Man kann sich also zurücklehnen und warten.

Bis zum nächsten Mal,
MfG,
Darth