DaDaPlayground

Kommentare anzeigen Worklog abonnieren
Gehe zu Seite Zurück  1, 2, 3  Weiter

Worklogs DaDaPlayground

Dinosaurier

Dienstag, 13. April 2010 von darth
Hallo,

seien wir ehrlich, es gibt nichts cooleres als Dinosaurier! Ausser vielleicht extreme Dinosaurier, oder Ninjas, oder Piraten - das coolste wäre natürlich ninja-mässige Saurierpiraten \o/ Aber der Grund weshalb ich das Thema zur Sprache bringe ist dies:
Ich hatte letztes Wochenende etwas Langeweile und habe mir mal angesehen, was ich vor Urzeiten in dem Forum gepostet habe. Dabei stiess ich auf einige ältere Codearchiv Einträge von mir, die ich heute grösstenteils für relativ unsauber halte, ich konnte es mir nicht nehmen, einige der Einträge nochmal anzupacken und neuzuschreiben. Einige davon habe ich dann direkt ins Codearchiv hineineditiert (um nicht alte Threads zu pushen..). Nach dieser Tat wollte ich mal sehen, was ich früher so geleistet habe, und ich stiess auf meiner alten HD auf ältere Projekte und Algorithmen, die ich (afaik) nie veröffentlicht habe. Tja... dies hole ich nun nach Smile

PathFinding

In diesem Eintrag *schauder* habe ich damals als relativer und agressiv-arroganter Anfänger gepostet und meine eigene Lösung vorgestellt. Eigentlich stehe ich immernoch hinter dem Eintrag, das Prinzip ist relativ simpel und funktioniert gut. Es ist einfach die Art, wie der Code geschrieben war, die mich störte, es ist ineffizient und unsauber :/ Also habe ich die Idee genommen und den Code neu geschrieben. Ich glaube das Prinzip orientiert sich an einem Spezialfall des A*-Algorithmus. Was mich an der neuen Verison noch stört ist, dass ich zwei Dims verwende, einen für die Map und einen für die Kopie. Eigentlich wollte ich eine Funktion haben, der ich die Map übergeben kann. Aber es war mir zu umständlich (und für den Anwender zu unsinnig) dies über einen 2D->1D BlitzArray zu lösen.
Nachdem der Code neu geschrieben war, musste natürlich noch eine Testumgebung her, auch da musste ich nicht von vorne beginnen, vielleicht erinnert sich noch jemand an den einen Text-BCC. Dafür schrieb ich mal einen Labyrinth Generator (den ich nie einreichte), also habe ich den kurz umgeschrieben und verallgemeinert, und dann den Pfadfinder darauf losgelassen und getestet.

user posted image

Die beiden Algorithmen funktionieren nur für quadratische Maps, weil ich zu faul war MAP_SIZE_X und _Y einzuführen, habe ich einfach MAP_SIZE eingeführt. Zudem hat der Generator noch ein separates "Problem": Bei geraden Map Grössen hat es unten und rechts einen doppelten Rand, ich bin mir nicht sicher woher das kommt. Aber für kleine Labyrinthspiele und Tests ist der Generator einsetzbar. Der Pfadfindungsalgorithmus ist ziemlich universell einsetzbar (solange man die beiden Dims anpasst, Map und MapCopy). Der Code hat ein kleines Beispiel am Ende integriert, die Wegpunkte sind von Hand gesetzt, d.h hier funktioniert es (das Beispiel auf dem Bild), aber es ist nicht sicher, dass ihr das gleiche Labyrinth erhalten werdet (aber ziemlich wahrscheinlich :> ).

BlitzBasic: [AUSKLAPPEN]
;/*
; * Set Up
; */

Const MAP_SIZE_Y=59
Const MAP_SIZE_X=59
Dim map(MAP_SIZE_X, MAP_SIZE_Y)
Dim mapCopy(MAP_SIZE_X, MAP_SIZE_Y)

;/*
; * Labyrinth Generator
; */

Type Neighbor
Field x
Field y

Field px
Field py
End Type

Function cNeighbor.Neighbor(x, y, px, py)
Local n.Neighbor

n=New Neighbor
n\x=x
n\y=y

n\px=px
n\py=py

Return n
End Function

Function createLabyrinth()
For x=0 To MAP_SIZE_X-1
For y=0 To MAP_SIZE_Y-1
map(x, y)=False
Next
Next

Delete Each Neighbor

progressMap(1, 1)
End Function

Function progressMap(sx, sy)
Local n.Neighbor, dX[4], dY[4], iter.Neighbor, alreadySet

For n=Each Neighbor
If n\x=sx And n\y=sy
Delete n
EndIf
Next

dX[0]=0 : dY[0]=-2
dX[1]=0 : dY[1]=2
dX[2]=-2 : dY[2]=0
dX[3]=2 : dY[3]=0

For i=0 To 4
If isAllowed(sx+dX[i:1],sy+dY[i])
If Not map(sx+dX[i],sy+dY[i])
alreadySet=False

For n=Each Neighbor
If n\x=sx+dX[i] And n\y=sy+dY[i]
alreadySet=True
Exit
EndIf
Next

If Not alreadySet
n=cNeighbor(sx+dX[i],sy+dY[i],sx,sy)
EndIf
EndIf
EndIf
Next

For n=Each Neighbor
If Rand(1,10)=1
iter=n
EndIf
Next

If iter=Null
iter=First Neighbor
EndIf

If iter=Null
Return
EndIf

map(iter\x, iter\y)=True
map((iter\x+iter\px)/2, (iter\y+iter\py)/2)=True
map(iter\px, iter\py)=True

progressMap(iter\x, iter\y)
End Function

Function isAllowed(x, y)
If x>=0 And x<MAP_SIZE_X-1 And y>=0 And y<MAP_SIZE_Y-1
Return True
EndIf

Return False
End Function

Function isWall(x, y)
If Not isAllowed(x,y)
Return True
Else
If Not map(x,y)
Return True
EndIf
EndIf

Return False
End Function

Function drawMap(tileSize)
For x=0 To MAP_SIZE_X-1
For y=0 To MAP_SIZE_Y-1
If Not map(x, y)
Rect x*tileSize, y*tileSize, tileSize, tileSize
EndIf
Next
Next
End Function

;/*
; * Path Finder
; */

Type Node
Field x
Field y

Field parent.Node

Field nodeCost
End Type

Type PathNode
Field x
Field y

Field pathId

Field succ.PathNode
End Type

Function cNode.Node(x, y, parent.Node, cost)
Local n.Node=New Node

n\x=x
n\y=y

n\parent=parent

n\nodeCost=cost

Return n
End Function

Function cPathNode.PathNode(x, y, id, succ.PathNode)
Local p.PathNode=New PathNode

p\x=x
p\y=y

p\pathId=id

p\succ=succ

Return p
End Function

Function getPath.PathNode(xStart, yStart, xStop, yStop)
Delete Each Node
Delete Each PathNode

Local iterNode.Node=findPath(xStart, yStart, xStop, yStop)
Local p.PathNode=Null

;Kein Weg gefunden
If iterNode=Null
Return Null
EndIf

While True
p=cPathNode(iterNode\x, iterNode\y, iterNode\nodeCost, p)

If p\x=xStart And p\y=yStart
Exit
EndIf

iterNode=iterNode\parent
Wend

Delete Each Node

Return p
End Function

Function findPath.Node(xStart, yStart, xStop, yStop)
Local nStart.Node=cNode(xStart, yStart, Null, cost)
Local actCost=0, n.Node, nNew.Node, addCount

Local dX[4], dY[4]
dX[0]=-1
dX[1]=1
dY[2]=-1
dY[3]=1

For x=0 To MAP_SIZE_X-1
For y=0 To MAP_SIZE_Y-1
If map(x,y)
If Not (x=xStart And y=yStart)
mapCopy(x, y)=True
EndIf
EndIf
Next
Next

While True
addCount=0

For n=Each Node
If n\nodeCost=actCost
For i=0 To 3
If testStep(n\x+dX[i], n\y+dY[i])
nNew=cNode(n\x+dX[i], n\y+dY[i], n, n\nodeCost+1)
mapCopy(n\x+dX[i], n\y+dY[i])=False

addCount=addCount+1

If nNew\x=xStop And nNew\y=yStop
Return nNew
EndIf
EndIf
Next
EndIf
Next

;Kein Weg gefunden
If addCount=0
Return Null
EndIf

actCost=actCost+1
Wend
End Function

Function testStep(x, y)
If x<0
Return False
EndIf

If x>=MAP_SIZE_X
Return False
EndIf

If y<0
Return False
EndIf

If y>=MAP_SIZE_Y
Return False
EndIf

Return mapCopy(x, y)
End Function

;/*
; * Test Program
; */

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

;// Create the new Labyrinth
createLabyrinth()

;// Draw the map
drawMap(10)

;// Find a Path
Local P.PathNode=getPath(1, 1, 57,57)

;// Draw the Path
Color 255,0,0
While P<>Null
Rect P\x*10, P\y*10, 10,10

P=P\succ
Wend

Flip 0
WaitKey()


Edit: Es hatte einen kleineren Fehler drin (bei der Suchrichtung, Richtung 3 wurde nie initialisiert, dafür Richtung 2 zweimal, fällt nicht wirklich auf wenn man nur "von oben nach unten" Pfade durchsucht, aber sobald er mal hochlaufen musste schlug es fehl). Ausserdem gibts nun Dimension in X und Y Richtung. Allerdings ist mir grad noch n "Fehler" aufgefallen, das Labyrinth ist immer ein Feld zu klein :/ also bei 59/59 hört die letzte Wand bei 58/58 auf. Muss ich mir wohl nochmal kurz ansehn woran das liegt.
Edit: So wies aussieht habe ich mir selbst ein Bein gestellt. Natürlich geht das nur bis 58/58, die Size Variable gibt die Grösse an, der Array geht also von 0 bis Size-1. Auch dass bei geraden Zahlen eine doppelte Abschlusswand entsteht ist logisch, ich mache nur 1 Block Wände und Gänge, das geht nicht auf. So, damit ist nun (hoffentlich) alles geklärt und ich kann den Code ruhigen Gewissens bestehen lassen.

Zeichnen

Ebenfalls aus dem Codearchiv kommt dieses Stück. Ich hatte damals einen furchtbar ineffizienten und aufwändigen Linienzeichner programmiert, den ich im Nachhinein verbessern wollte. Also habe ich mich (v.a weil das Beispiel auf BlitzBase.de nichtmehr da ist) hinter einen kurzen [url=http://en.wikipedia.org/wiki/Bresenham's_line_algorithm]Bresenham Algorithmus[/url] gesetzt und implementiert. Der Algorithmus funktioniert nur über Integer und benötigt keine einzelne FloatingPoint Operation. Ausserdem ist er auf Geschwindigkeit optimiert und nicht auf Codekürze, deshalb ist die eine Schleife auch doppelt da, damit ich die If-Abfrage nicht in jedem Schleifendurchlauf habe.
So, jetzt zum Punkt: Der Algorithmus ist sinnlos. In Lockbuffer-Modus ist die BB Linie etwas schneller (0.007Ms VS 0.008Ms pro Linie). Ausserdem hat die normale Linie nicht das Problem, dass es Fehler gibt wenn man ausserhalb des Bildschirms zu zeichnen versucht.

BlitzBasic: [AUSKLAPPEN]
Function BLine(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

err=err-dY

If err<0
y=y+yStep

err=err+dX
EndIf
Next
Else
For x=x0 To x1
WritePixelFast x,y,col

err=err-dY

If err<0
y=y+yStep

err=err+dX
EndIf
Next
EndIf
End Function


Nach dieser Erfahrung (eigentlich vorher...) wollte ich etwas ähnliches, aber doch anderes machen. Ich habe eine kleine Methode geschrieben, die eine Textur auf Dreiecke rendert. Wozu ich das brauche weiss ich noch nicht, ich habe eigentlich nicht vor einen Rasterizer zu schreiben, das wurde (imo) schon zu oft gemacht (und wahrscheinlich besser und ausführlicher :> ). Nach anfänglichen Problemen bei der Findung der UV-Koordinaten hat mir dann dieser Artikel geholfen. Da ich weiss auf welcher Linie ich bin, kann ich einfach die UV-Koordinaten deren Stützpunkte nehmen und dazwischen linear interpolieren, eigentlich logisch.
Das "Problem" bei meiner Methode ist, dass ich die Textur zuerst speichere, und weil BB keine dynamischen Arrays hat (Dim ausgenommen) habe ich die Texturgrösse auf 64x64 gesetzt, das führt zu etwas pixligen Ergebnissen. Bei grösseren Texturen sähe es etwas sauberer aus, aber das ist Nebensache.

user posted image

Der Code dazu ist eigentlich ziemlich einfach, ein kleines Bisschen Vektorgeometrie und Proportionalität und man ist eigentlich fertig. Bei korrekter Verwendung sollte es eigentlich nicht zu Array-Fehlern kommen, aber da ich sie nicht abfange, kann es durchaus passieren - z.b. wenn eine UV-Koordinate gesetzt wird, die nicht im Intervall [0,1) ist. Vielleicht sollte ich da mit Modulo eine Widerholung einführen, aber das brauche (ich) im Moment noch nicht, deshalb ists nicht gemacht.
Ausserdem bediene ich mich mal wieder einer völlig neuen Struktur. Da BB nicht so etwas wie Klassen hat, bin ich schnell dazu verführt, etwas so kleines wie eine Vektorklasse halt mal kurz neu zu schreiben und dem neuen Ding anzupassen, darum arbeite ich hier mit dem Point Type, sollte ich vielleicht noch ändern. Allerdings kommt das Prinzip auch so zur Geltung. (PS: Die Dreiecks Renderung ist ziemlich nahe an meiner Polygon Renderung von einem früheren Eintrag).

BlitzBasic: [AUSKLAPPEN]
Type Point
Field x#
Field y#

Field u#
Field v#
End Type

Type Trig
Field p1.Point
Field p2.Point
Field p3.Point

Field p.Point[3]
Field count

Field minX#
Field minY#
Field maxX#
Field maxY#

Field red
Field green
Field blue

Field tex.Texture
End Type

Function cTrig.Trig()
Local t.Trig=New Trig

t\minX=1000000
t\minY=1000000
t\maxX=-1000000
t\maxY=-1000000

t\red=255
t\green=255
t\blue=255

Return t
End Function

Function cPoint.Point(x#, y#)
Local p.Point=New Point

p\x=x
p\y=y

Return p
End Function

Function setUV(p.Point, u#, v#)
p\u=u
p\v=v
End Function

Function addPoint(t.Trig, p.Point)
t\p[t\count]=p

If t\count=0
t\p1=p
ElseIf t\count=1
t\p2=p
ElseIf t\count=2
t\p3=p
EndIf

If p\x<t\minX
t\minX=p\x
EndIf
If p\x>t\maxX
t\maxX=p\x
EndIf
If p\y<t\minY
t\minY=p\y
EndIf
If p\y>t\maxY
t\maxY=p\y
EndIf

t\count=t\count+1
End Function

Function setColor(t.Trig, r, g, b)
t\red=r
t\green=g
t\blue=b
End Function

Function fillTrig(t.Trig)
Color t\red, t\green, t\blue

Local sx#[3], sy#[3], dx#[3], dy#[3], u0#[3], v0#[3], du#[3], dv#[3]

j=2
For i=0 To 2
sx[i]=t\p[i]\x
sy[i]=t\p[i]\y

dx[i]=t\p[j]\x-t\p[i]\x
dy[i]=t\p[j]\y-t\p[i]\y

u0[i]=t\p[i]\u
v0[i]=t\p[i]\v

du[i]=t\p[j]\u-t\p[i]\u
dv[i]=t\p[j]\v-t\p[i]\v

j=i
Next

Local yStart, yStop

yStart=t\minY
If yStart<0
yStart=0
EndIf

yStop=t\maxY
If yStop>GraphicsHeight()-1
yStop=GraphicsHeight()-1
EndIf

Local tSmall#, tBig#, tCut#, i1=-1, i2=-1
Local k#, uStart#, vStart#, dUv#, dVv#, l#, s

For y=yStart To yStop
tSmall=1000000

For i=0 To 2
tCut=trigFillLineCut(t\minX, y, 1, 0, sx[i], sy[i], dx[i], dy[i])

If tCut>=0
If tCut<tSmall
tBig=tSmall
i2=i1

tSmall=tCut
i1=i
Else
tBig=tCut
i2=i
EndIf
EndIf
Next

If i1<>-1 And i2<>-1
If t\tex=Null
Line t\minX+tSmall, y, t\minX+tBig, y
Else
k=(y-sy[i1])/dy[i1]

uStart=u0[i1]+k*du[i1]
vStart=v0[i1]+k*dv[i1]

k=(y-sy[i2])/dy[i2]

dUv=u0[i2]+k*du[i2]-uStart
dVv=v0[i2]+k*dv[i2]-vStart

l=tBig-tSmall

dUv=dUv/l
dVv=dVv/l

If l>0
s=0
For x=t\minX+tSmall To t\minX+tBig
WritePixelFast x,y,getRGB(t\tex, uStart+dUv*s, vStart+dVv*s)

s=s+1
Next
EndIf
EndIf
EndIf
Next
End Function

Function trigFillLineCut#(ax#, ay#, dx#, dy#=0, px#, py#, vx#, vy#)
Local t#, k#

;A+t*D = P+k*V
;t=-(ax*vy-ay*vx-px*vy+py*vx)/(dx*vy-dy*vx)
;k=-(ax*dy-ay*dx+dx*py-dy*px)/(dx*vy-dy*vx)
t=-(ax*vy-ay*vx-px*vy+py*vx)/(dx*vy)
k=-(-ay*dx+dx*py)/(dx*vy)

If k>=0 And k<=1 And t>=0
Return t
EndIf

Return -1
End Function

Function outlineTrig(t.Trig)
Color t\red, t\green, t\blue

j=2
For i=0 To 2
Line t\p[i]\x, t\p[i]\y, t\p[j]\x, t\p[j]\y
j=i
Next
End Function

Type Texture
Field rgb[64*64]
End Type

Function cTexture.Texture(path$)
Local img=LoadImage(path)

If img=0
Return Null
EndIf

If ImageWidth(img)<>64 Or ImageHeight(img)<>64
FreeImage img
Return Null
EndIf

Local t.Texture=New Texture

LockBuffer ImageBuffer(img)
For y=0 To 63
For x=0 To 63
t\rgb[y*64+x]=ReadPixelFast(x, y, ImageBuffer(img))
Next
Next
UnlockBuffer ImageBuffer(img)

FreeImage img
Return t
End Function

Function getRGB(t.Texture, x#, y#)
; x,y in [0,1)

ix=x*63
iy=y*63

If ix<0
ix=0
EndIf
If iy<0
iy=0
EndIf
If ix>63
ix=63
EndIf
If iy>63
iy=63
EndIf

Return t\rgb[iy*64+ix]
End Function


Sortierung

Auch dies ist ein älteres Thema, das ich allerdings nie im Forum veröffentlicht habe. Für einen Vortrag am Gymnasium musste ich im Fach Informatik die Sortierung vorstellen. Da mir die reine Theorie zu blöd war (das merkte man am Vortrag :/ ich hab voll versagt) beschloss ich, einige davon zu implementieren in einem kleinen Darstellungsprogramm. Da ich damals mit GoSub arbeitete, habe ich die Algorithmen nochmal neu geschrieben und in Funktionen verpackt. Zuerst einmal den Code, dann eine Beschreibung dazu:

BlitzBasic: [AUSKLAPPEN]
;Selection Sort
Function selectionSort(list[100], anz)
Local tmp, max

For i=anz-1 To 1 Step -1
max=0
For j=1 To i
If list[j]>list[max]
max=j
EndIf
Next

tmp=list[max]
list[max]=list[i]
list[i]=tmp
Next
End Function

;Insertian Sort
Function insertionSort(list[100], anz)
Local tmp

For i=1 To anz-1
j=i
tmp=list[i]

While j>0 And list[j-1]>tmp
list[j]=list[j-1]
j=j-1
Wend

list[j]=tmp
Next
End Function

;Bubble Sort
Function bubbleSort(list[100], anz)
Local j=0, chg, tmp

Repeat
chg=True

j=j+1

For i=0 To anz-1-j
If list[i]>list[i+1]
tmp=list[i]
list[i]=list[i+1]
list[i+1]=tmp

chg=False
EndIf
Next
Until chg
End Function

;Quick Sort
Function quickSort(list[100], anz)
quick(list, 0, anz-1)
End Function

Function quick(list[100], lo, hi)
Local i=lo, j=hi
Local q=list[(lo+hi)/2]

While i<=j
While list[i]<q
i=i+1
Wend

While q<list[j]
j=j-1
Wend

If i<=j
tmp=list[i]
list[i]=list[j]
list[j]=tmp

i=i+1
j=j-1
EndIf
Wend

If lo<j
quick(list, lo, j)
EndIf

If i<hi
quick(list, i, hi)
EndIf
End Function

;Heap Sort
Function heapSort(list[100], anz)
Local tmp

anz=anz-1

For i=(anz/2) To 0 Step -1
siftDown(list, i, anz)
Next

For i=anz To 1 Step -1
tmp=list[0]
list[0]=list[i]
list[i]=tmp

siftDown(list, 0, i-1)
Next
End Function

Function siftDown(list[100], root, bottom)
Local done=0, tmp, maxChild

While root*2<=bottom And done=0
If root*2=bottom Or list[root*2]>list[root*2+1] Then
maxChild=root*2
Else
maxChild=root*2+1
EndIf
If list[root]<list[maxChild] Then
tmp=list[root]
list[root]=list[maxChild]
list[maxChild]=tmp

root=maxChild
Else
done=1
EndIf
Wend
End Function

;Merge Sort
Function mergeSort(list[100], anz)
Local tmpArray[100]

mergeS(list, tmpArray, 0, anz-1)
End Function

Function mergeS(list[100], tmpArray[100], le, ri)
Local center

If le<ri
center=(le+ri)/2

mergeS(list, tmpArray, le, center)
mergeS(list, tmpArray, center+1, ri)
merge(list, tmpArray, le, center+1, ri)
EndIf
End Function

Function merge(list[100], tmpArray[100], leftPos, rightPos, rightEnd)
Local leftEnd=rightPos-1
Local tmpPos=leftPos
Local numElements=rightEnd-leftPos+1

While leftPos<=leftEnd And rightPos<=rightEnd
If list[leftPos]<=list[rightPos]
tmpArray[tmpPos]=list[leftPos]

tmpPos=tmpPos+1
leftPos=leftPos+1
Else
tmpArray[tmpPos]=list[rightPos]

tmpPos=tmpPos+1
rightPos=rightPos+1
EndIf
Wend

While leftPos<=leftEnd
tmpArray[tmpPos]=list[leftPos]

tmpPos=tmpPos+1
leftPos=leftPos+1
Wend

While rightPos<=rightEnd
tmpArray[tmpPos]=list[rightPos]

tmpPos=tmpPos+1
rightPos=rightPos+1
Wend

For i=0 To numElements-1
list[rightEnd]=tmpArray[rightEnd]

rightEnd=rightEnd-1
Next
End Function


SelectionSort ist ein quadratischer Algorithmus, den man eigentlich vermeiden sollte. Genauso mit BubbleSort, es gibt eigentlich keine Fälle, in welchen diese Algorithmen gut geeignet sind.
InsertianSort ist ebenfalls quadratisch, allerdings meinte unser Info Tutor, dass es Fälle gibt, in welchen dies die schnellste Alternative ist. Dies sei so, bei ziemlich kurzen Listen (~ 10 Elemente), ich habe das nie getestet, aber ich glaube dem Herrn mal, der wird uns schon nicht anlügen.
QuickSort und HeapSort laufen beide (afaik) mit O(n*log(n)), das ist eigentlich das Optimum, das man für Sortierungen erreichen kann. In diese Liste gehört eigentlich noch ein MergeSort, aber den habe ich nichtmehr gefunden, und ich wollte ihn nicht nochmal schreiben, weil genügend andere Alternativen vorhanden sind.
Noch eine kurze Einführung zur Verwendung der Sortierer: Die Algorithmen arbeiten zwar mit BB eigenen BlitzArrays, ich habe es allerdings so programmiert, dass sie wie "normale" Arrays behandelt werden. Das heisst, sie beginnen bei [i]0 und enden bei Anzahl-1.

user posted image

Edit: Ich habe einen besseren (allgemeiner verwendbaren) QuickSort gefunden und den implementiert (der Alte hatte eine Vergleichsoperation drin, die so nur mit Zahlen funktioniert hat, der jetzige könnte auch mit Types arbeiten). Ausserdem habe ich noch einen MergeSort hinzugefügt (O(n*log(n)), braucht aber einen zusätzlichen SpeicherArray).

Ende

Hmm, eigentlich wollte ich noch meine alten Spiele vorstellen, die zwar in den Grundzügen fertig sind, aber nie einen Status der Vollendung erreichten. Allerdings ist der Eintrag schon ziemlich lange, daher spare ich mir das für einen späteren Zeitpunkt auf.

Zur DaDaPhysik-Engine kann ich noch kurz erwähnen, dass ich versucht habe, die Sinus/Cosinus Funktionen durch geeignete Taylor-Entwicklungen zu ersetzen um etwas Zeit zu sparen. Allerdings musste ich dann feststellen, dass sich meine Objekte aufgrund der kleinen Ungenauigkeiten mit der Zeit verziehen. Da es ein RigidBody-System ist, sollte das eigentlich NICHT passieren, weil ich theoretisch die Verschiebung nie direkt auf die Punkte anwende. Der Code ist mittlerweilen relativ lange und ich habe nichtmehr den kompletten Überblick, wo ich was verändere, deshalb muss ich mich da nochmal kurz durchsuchen, wo ich was eigentlich mache Very Happy Aber wenn ich das dann gemacht habe, werde ich mich wohl wieder melden.
Anm: Komischerweise lohnt es sich überhaupt nicht, die Wurzel durch eine Taylorreihe zu ersetzen, ein Wurzelaufruf ist genauso schnell wie ein leerer Funktionsaufruf ._. das ist ziemlich sonderbar.

So, das wars für heute, doch heute ist nicht alle Tage, ich komm wieder keine Frage.
MfG,
Darth

A history of FAIL

Samstag, 3. April 2010 von darth
Hallo,

dies wird ein Worklogeintrag einer etwas anderen Art. Ich werde heute nicht wirklich Fortschritte präsentieren, sondern eher meinen Leidensweg beschreiben, den ich beschreiten musste, bis ich den Fortschritt erreicht habe. Deshalb (und weil ich wegen dem 1. April so ziemlich meinen ganzen Buffer an Miniprojekten verbraten habe) wird dieser Eintrag nicht so vielseitig wie die anderen, sondern ist wirklich nur auf ein Thema fokussiert. Wen überhaupt nicht interessiert wie ich hier etwa 3 Seiten lang rumheule, der kann einfach zum Ende springen, dort wird dann wahrscheinlich das Ergebnis der letzten Tage stehen.
Soviel zur Einleitung. Das Thema dieses Eintrags ist die SplitterPhysik. Wie ich in etlichen vorigen WL-Einträgen angekündigt habe, beschäftige ich mich seit einiger Zeit mit Polygon-Splitting auf verschiedene Arten, dies wollte ich nun in meine RigidBodyRoutine einbauen, wie das so von sich ging, könnt ihr jetzt hier nachlesen:

(Kurz noch etwas: Die Polygon Decomposition Routine ist funktionsfähig eingebaut. Konkave Objekte werden automatisch (und korrekt) in konvexe Subpolygone unterteilt. Es ist zwar die theoretisch optimale Methode, aber man könnte es noch optimieren wenn man z.b Überschneidugen zulässt, aber das ist mir zu mühsam.)

Zuerst nocheinmal zur Erinnerung, wie weit ich bisher war. Ich habe zuerst eine Pseudo-Voronoi Zerlegung eines beliebigen Polygons geschrieben (1), dieses Prinzip habe ich dann für mehrere Punkte ausgebaut (2) und die vielen Splitterpolygone (kleine Teilstücke, die eigentlich nicht existieren dürften) wieder zu grösseren verschmolzen. Danach ging ich daran, die Punkte automatisch zu setzen (3), mittels eines Gitters das ich in das Polygon legte und dan je nach Einschlag verschob, zu grosse Verschiebung und der Punkt wurde zu einem Splitterpunkt, anhand dessen zerlegt wurde.

user posted image

Das Prinzip funktionierte trocken (also in einem Testprogramm) ziemlich gut. Wunderbar sogar. Also dachte ich, ich könnte das einfach übernehmen. Das erste Problem war, dass ich die Grössenunterschiede nicht berücksichtigt hatte. Was ich in den Tests für grosse Polygone als Grenzwerte für Verschiebungen genommen hatte, funktionierte nicht länger für kleinere Objekte, ich hatte derartig viele Punkte übrig, dass das Polygon völlig zerstört wurde. Das zweite Problem war.. ich hab keine Ahnung, jedenfalls war das Ergebnis einer direkten Einsetzung nach einiger Zeit immer wieder dieses hier:

user posted image

Ein kommentarloser Absturz. Ich hatte keine Ahnung woher er kam, und keine Möglichkeit herauszufinden woher er kommt. Ich versuchte es im Chat, bat einige Leute das Programm zu testen, und dann kam irgendwo ein MAV, irgendwo der gleiche kommentarlose Absturz usw. Irgendwann kamen wir zum Schluss, dass es ein Stack oder Heap Overflow sein könnte. Gut, damit lässt sich was anfangen. Ich habe also nochmal den Code durchgesehen und festgestellt, dass es potentielle Endlosschleifen gibt (man geht die Liste aller Polygone durch und erstellt während dem durchgehen neue, die nicht zwangsläufig gelöscht werden -> es gibt immer mehr Polygone, die Schleife wird nie verlassen). Diese waren schnell beseitigt, ein paar zusätzliche "Delete this" und "Delete that" rein, und alles war geritzt.
Das bestehende Problem war, dass sich die Methode zur automatischen Punktsetzung überhaupt nicht bewährt hat. Also dachte ich mir, dass ich einfach mal statische Punkte in der Nähe des Körperzentrums setzen könnte. Gedacht, getan, ich feierte erste Erfolge.

user posted image

Es sah zwar etwas undynamisch und konstruiert aus, aber es funktionierte. Dadurch ermutigt, arbeitete ich an weiteren Versuchen zur Setzung von Punkten. Ideen kamen auf und mussten verworfen werden. Ich versuchte es meist mit dem Coulomb Gesetz, das man eigentlich für Ladungen braucht, aber Spannung (haha, Wortwitz!) ist ja fast das selbe, glaub ich. Jedenfalls führte das zwar in den Testprogrammen zu annehmlichen Ergebnissen. Allerdings funktionierten sie einfach NIE im tatsächlichen Programm. Also versuchte ich mich mal an einer nicht-physikalischen Lösung, sondern an einer eher praktisch orientierten.

user posted image

Man nehme den Aufschlagspunkt, gehe in Aufschlagsrichtung durch das Polygon, bis man das Ende erreicht. Dann setzt man entlang dieser Gerade eine anzahl Punkte (hier 2). Vom Endpunkt aus geht man einmal nach links, einmal nach rechts, und macht da dasselbe. So kommt man auf 6 Punkte, die theoretisch entsprechend verschiedener Spannungslinien im Objekt gesetzt wurden. Die Idee fand ich so gut, dass ich sie direkt umsetzen wollte, und dann der erneute Dämpfer.

user posted image

SON OF A.. Ok. Geht nicht, ich hab wieder keine Ahnung wieso, aber ich gebe auch den Versuch auf. Zurück zu den vier statisch gesetzten Punkten. Wieder keine Probleme. Der Fehler tritt also je nach Punkteverteilung auf. Zum Teil funktioniert es, zum Teil stürzt es ab. Ich konnte einfach keinerlei Regelmässigkeit entdecken. Von daher dachte ich mir, dass ich es einfach mal völlig zufällig machen könnte. Ich gab es auf irgendwas berechnen zu wollen und setzte einfach wild irgendwelche Punkte. Das Ergebnis war ziemlich spektakulär, deshalb habe ich mit einem komischen Programm ein GIF daraus gemacht. (ANM: falls jemand ein gutes 'BMP Set -> GIF' Programm kennt, das Gratis verfügbar und einfach zu bedienen ist, wäre ich froh wenn er mir soeines in den Comments nennen könnte, danke.)

user posted image

Das Problem dabei war, dass die Stücke zum Teil derart klein wurden, dass sie aufgrund von Genauigkeitsfehlern in den Rechnungen nichtmehr richtig kollidierten. Das wäre ein Problem, das sich eigentlich umgehen liesse, indem man die Methodik ändert, das ist zwar nur eine Theoretische Rechnung meinerseits, aber es sollte eigentlich funktionieren. Neeein, das gravierendere Problem war, dass es wieder zu sporadischen Abstürzen kam.
Das war dann irgendwann um 2Uhr der Zeitpunkt an dem ich mir sagte: Ach, scheiss drauf. Wenn das Programm nicht will, werde ich es nicht dazu zwingen. Ich ging also zurück zu der einzigen Methode die bisher funktionierte. Ich baute sie um, dass sie sich an der Grösse des Objekts orientiert (die vorige machte einfach ein 20x20 Rechteck). Dies war schnell umgestellt, und die Tests führten erstaunlicherweise zu dem hier:

user posted image

Aus lauter Frust habe ich dann angefangen zu vereinfachen. Punkte die nicht im Polygon liegen werden gelöscht, wenn die Idioten sich nicht an die Regeln halten, sollen sie wenigstens nicht das Programm stören. Polygone werden nicht länger zusammengeschweisst, da gab es zuviele Probleme. Ich liefere nicht länger alle Polygone zurück (obwohl, eigentlich schon, ich verpacke sie vorher nur), sondern eine Liste neuer Polygone, die dann verarbeitet wird. Zu kleine Polygone werden einfach gelöscht, damit es keine späteren Probleme mit ihnen gibt. Derart gekürzt funktionierte das Programm endlich fehlerlos. (Ich bin mir nicht mehr ganz sicher ob es in dieser Version noch gewisse Kollisionsprobleme gab, aber ich hoffe es war eine andere.)
Und hier das abschliessende Ergebnis:

user posted image

Das Ergebnis dieser vergangenen Tage (und vorallem letzter Nacht) kann man sich >HIER< herunterladen. Mit der Maus kann man neue zufällige Objekte erstellen.
Sollte das Programm irgendwo fehlerhaft sein oder gar abstürzen, dann behaltet das bitte einfach für euch, sonst fange ich an zu weinen..

Ich hoffe, dass ich beim nächsten Mal wieder einen fröhlicheren und vielseitigeren Eintrag bieten kann, aber heute müsst ihr euch wohl oder übel mit meinem seitenlangen geheule begnügen. Ich hoffe der eine oder andere fand den Leidensweg dieser Erweiterung informativ. Falls jemandem ein guter Weg einfallen sollte, wie man die Punkte setzen könnte, dann kann er das in den Comments posten, wenn es mir realistisch erscheint, werde ich es mal versuchen, das System ist eigentlich relativ dynamisch, ich müsste nur eine Funktion auf die neue Methode anpassen. Ansonsten sehe ich das Programm mittlerweilen als funktionsfähig an und es sollte so weit sein, dass ich anfangen kann, darauf mein Spiel aufzubauen.
Dies hapert momentan noch daran, dass ich keine Spielfigur habe und auch noch nicht weiss, nach welchem Prinzip ich die bauen soll, aber ich habe bis Dienstag noch etwas frei und kann daran arbeiten, jetzt wo das Splitterzeug funktioniert.

Und nun genug geweint, ein Krieger kennt weder Schmerz noch Verzweiflung! Ich wünsche einen schönes Wochenende und frohe Ostern,
MfG,
Darth

PS: So Noobody, jetzt siehst du das Ding in Aktion, wo bleiben meine 2 Blitze? :>

Edit:
So, nachdem Noobody es gewagt hat sich zu beschweren (oooh er wird büssen >:O ) habe ich den Schwellenwert für Splittergrössen heruntergesetzt, jetzt zersplittern die Objekte mehr. Ausserdem ist mir noch ein kleiner Fehler aufgefallen, bei der Splitterung ignorierte ich die Drehung der Objekte, das ist jetzt korrigiert.
Neue Version hier.

Edit:
Ich habe keine Lust einen weiteren Eintrag zu machen, aber ich habe noch etwas erweitert. Ich habe dem Renderer eine Rendermethode gegeben, die eine Textur in das Objekt rendert. Es ist ziemlich einfach gehalten, d.h ich gebe dem Objekt einen Startpunkt und eine Grösse mit, und anhand dieser Daten werden dann die UV-Koordinaten ausgewertet. Naja, ansich kein wirklich grosses Ding (und es braucht noch etwas um dies zu automatisieren, im Moment muss man alles von Hand setzen). Beim Splittern hatte ich früher zufällige Farben für die Einzelstücke genommen, das habe ich umgestellt, meiner Meinung nach sieht es besser aus, wenn ein Körper in gleichfarbige Stücke zerfällt. Mit der Textur war es ein klein wenig komplizierter, man muss dort den Aufhängpunkt der Textur verändern, aber auch das ist mit einer kleinen Verschiebungsrechnung zu machen.
Ich suche zwar noch immer ein Freewareprogramm für GIFs, aber ich habe mal eine weitere Trialversion geladen um den (vorläufigen? :>) Abschluss dieses Eintrags zu erzeugen. Weil die Animation etwa 1.3MB gross ist, will ich die nicht direkt als Bild hier drin verlinken, wer will kann es sich ja ansehen.

Klick mich

Teehee! Und Gn8,
MfG,
Darth

Omgomgomgomg [April, April]

Donnerstag, 1. April 2010 von darth
Edit: Dieser Eintrag stellte eine Reaktion auf ein neues Rankingsystem des BBPs dar, das als Aprilscherz eingeführt worden war. Natürlich habe ich es sofort durchschaut und mich darüber lustig gemacht, ich bin natürlich niemals so kompetitiv *hust*.

-----> Ursprünglicher Beitrag <-----

Hallo,

und OMFG!
Ich habe auf der Rangliste gesehn, dass ich nichtmal unter den besten 100 bin! Das muss sich ändern, ich muss aktiver sein! Allerdings fand ich im Forum gerade keine unbeantworteten Threads, ich bitte also alle Neulinge und Anfänger (im Fachchargon auch "Noobs" genannt) viel zu fragen, damit ich viel beantworten und in der Bewertung steigen kann. Ebenfalls möchte ich alle bitten, meinen Account mit 5 Sternen zu bewerten :O

Um euch einen Grund zu geben sowas zu tun, möchte ich natürlich auch einen qualitativ hochwertigen Worklogeintrag präsentieren! Da seit dem letzten Eintrag nicht viel Zeit vergangen ist, habe ich natürlich nicht derart viele Neuerungen, aber ich habe letzte Nacht bis 4 Uhr an etwas gearbeitet, das ich gerne vorstellen möchte, auch habe ich noch etwas Buffer von älteren Erzeugnissen, ihr werdet also nicht leer ausgehen! Und nun zur Sache:

-----

Perlin Noise:

Nach einem kleinen Tutorial im Internet habe ich einen PerlinNoise-Generator gebastelt. Ziel desse war es, für Texturen herzuhalten, und gegebenenfalls Wolken zu produzieren. Ersteres ist kein grosses Ding, das pappt man einfach drauf, oder drüber. Man könnte es theoretisch auch als Bumpmap verwenden, allerdings habe ich damit fast bis garkeine Erfahrung, also lass ich davon mal die Finger.
Den Code werde ich gleich posten, er hatte anfangs einen kleinen Fehler, den ich mit Hilfe von Noobody korrigieren konnte (der Kerl ist etwa auf Platz 5 :O votet den runter! Der kann nix!), hatte etwas mit verkappter Rundung zu tun die mir nicht auffiel.

BlitzBasic: [AUSKLAPPEN]
Function perlinNoise2D#(x#, y#)
Local n, nn

n=x+y*57
n=(n Shl 13) Xor n

nn=(n*(n*n*15731 + 789221 )*n + 1376312589 ) And $7fffffff

Return 1-(nn*0.000000000931322574615478515625)
End Function

Function smoothNoise#(x#, y#)
Local Corners#, Sides#, Center#

Corners=(perlinNoise2D(x-1,y-1)+perlinNoise2D(x+1,y-1)+perlinNoise2D(x-1,y+1)+perlinNoise2D(x+1,y+1))*0.0625
Sides=(perlinNoise2D(x-1,y)+perlinNoise2D(x+1,y)+perlinNoise2D(x,y-1)+perlinNoise2D(x,y+1))*0.125
Center=perlinNoise2D(x,y)*0.25

Return Corners+Sides+Center
End Function

Function linInterpolate#(a#, b#, x#)
Return a*(1-x)+b*x
End Function

Function cosInterpolate#(a#, b#, x#)
Local f#

f=(1-Cos(x*180))*0.5
Return a*(1-f)+b*f
End Function

Function interpolatedNoise#(x#, y#)
Local FloorX, FloorY, s#, t#, u#, v#, int1#, int2#

FloorX=Int(x-0.5)
FloorY=Int(y-0.5)

s=smoothNoise(FloorX, FloorY)
t=smoothNoise(FloorX+1, FloorY)
u=smoothNoise(FloorX,FloorY+1)
v=smoothNoise(FloorX+1,FloorY+1)

int1=cosInterpolate(s,t,x-FloorX)
int2=cosInterpolate(u,v,x-FloorX)

Return cosInterpolate(int1,int2,y-FloorY)
End Function

Function generateNoiseImg(w, h)
Local P#, Octaves, Fade#, Frequency#, Amplitude#, Getnoise#, Col, Image, Dx#, Dy#

P=0.6
Octaves=8
Fade=0.03 ;experimentierwert

SeedRnd(MilliSecs())
Dx=Rnd(0.0,100.0)
Dy=Rnd(0.0,100.0)

Image=CreateImage(w,h)
SetBuffer ImageBuffer(Image)
LockBuffer ImageBuffer(Image)

For y=0 To h-1
For x=0 To w-1
Getnoise=0

For a=0 To Octaves-1
Frequency=Fade*(1 Shl a);*2^a
Amplitude=P^a

Getnoise=Getnoise+interpolatedNoise(x*Frequency+Dx, y*Frequency+Dy)*Amplitude
Next

Col=Getnoise*128+128
If Col>255
Col=255
EndIf
If Col<0
Col=0
EndIf

WritePixelFast x,y,Col*$10000+Col*$100+Col
Next
Next

UnlockBuffer ImageBuffer(Image)
SetBuffer BackBuffer()

Return Image
End Function


Wer sich an meinen letzten Beitrag erinnert, der wird sich wohl die Bezierkurven wieder ins Gedächtnis rufen können. Wie ich dort geschrieben habe, sollte dies den Grundstock (Wortwitz, ist ja 1. April, haha!) für Pflanzen legen, da ich bisher an Bäumen gescheitert bin dachte ich mir, ich mache solche farnartigen Topfpflanzen. Die Dreiecke hatte ich in weiser Voraussicht ja schon gesetzt, ich musste nur noch ein Mesh daraus kreieren, was kein Problem darstellte (suche Punkte, setzte Punkte, mache Dreieck, done). Das Ergebnis ist eine zufallsbasierte, relativ einfach manipulierbare Topfpflanze, die man hier bestaunen kann (Anm: Der Topf ist von Google geklaut):

user posted image

Diese Topfpflanzen wollte ich eigentlich erst in einem späteren Worklog in Bezug auf etwas anderes vorstellen, aber das neue Rankingsystem hat dem einen Strich durch die Rechnung gemacht. Von daher kommen sie jetzt halt etwas früher, und später nochmal, doppelt genäht hält auch nur halb, oder so. Den Code dazu könnte ich zwar posten, wäre aber hoch uninteressant, weil er eigentlich nichts anderes macht als zufällige Bezierkurven in eine bestimmte Richtung zu erzeugen, ausserdem habe ich viel zu viele Types verwendet um das System zu bündeln, und dafür schäme ich mich.

-----

Polygon Decomposition:

Für die DaDaPhysik habe ich vor einiger Zeit einmal nebst einem SubtractingEars Algorithmus zur Zerlegung in Dreiecke auch einen Decomposiser Decomponizer Decom.. Zerstückler geschrieben, der konkave Polygon in Konvexe unterteilen soll. Das Prinzip war hoch experimentell und hat (im Nachhinein bedacht) ziemlich gute Ergebnisse geliefert. Natürlich wurde es nie einem wirklichen Stress-Test unterzogen sondern nur an eher einfachen Figuren wie Sternen getestet. Nun allerdings kam ich über Umwege (Polygonsplitting und wieder zusammenbauing) dazu, das der Algorithmus eigentlich in Sonderfällen auch nicht-konvexe Polygone zurückliefert. Er zerteilt also ein konkaves Polygon, in andere konkave Teile, und das ist relativ nutzlos ._. Das Ziel wäre eigentlich sowas hier:

user posted image
(Anm: Original)

Also suchte ich nach einigen Methoden, dies zu ändern. Ich fand eine theoretische Anleitung zu einem Algorithmus, der so kompliziert war, dass ihn scheinbar noch nie jemand implementiert hat. Also dachte ich, f**k it, ich such was anderes.
Dann fand ich eine Seite, wo zwei Algorithmen vorgestellt wurden, der eine eher kurz, mit Laufzeit O(n^4) und einer ziemlich lang, dafür aber Laufzeit O(n*log(n)). Natürlich nahm ich den kurzen. Ich ziehe immer den kürzeren :'( Nach einigem herumfideln und verstehen was die da eigentlich versuchen habe ich es dann hingekriegt. Nun kann man Polygone korrekt zerlegen lassen! Eingebaut in die Physik ist es noch nicht, dass kommt heute oder morgen, ich habe ja Kurz-Urlaub im Moment und etwas Freizeit zur Verfügung.
Da BB alle Types automatisch in eine LinkedList haut, habe ich kurzerhand einen neuen Type gemacht, indem ich PolyListen speichern kann, diesen benutze ich, um die zerlegten Polygone zurückzugeben (um sie von anderen für anderes verwendeten Polygonen unterscheiden zu können).

BlitzBasic: [AUSKLAPPEN]
Function ptArea#(P1.Vector, P2.Vector, P3.Vector)
Return (((P2\X-P1\X)*(P3\Y-P1\Y))-((P3\X-P1\X)*(P2\Y-P1\Y)))
End Function

Function ptLeft(P1.Vector, P2.Vector, P3.Vector)
Return ptArea(P1, P2, P3)>0
End Function

Function ptLeftOn(P1.Vector, P2.Vector, P3.Vector)
Return ptArea(P1, P2, P3)>=0
End Function

Function ptRight(P1.Vector, P2.Vector, P3.Vector)
Return ptArea(P1, P2, P3)<0
End Function

Function ptRightOn(P1.Vector, P2.Vector, P3.Vector)
Return ptArea(P1, P2, P3)<=0
End Function

Function ptSqDist#(P1.Vector, P2.Vector)
Return Sqr((P1\X-P2\X)^2+(P1\Y-P2\Y)^2)
End Function

Function ptLineInt.Vector(P11.Vector, P12.Vector, P21.Vector, P22.Vector)
Local i.Vector, Nx1#, Ny1#, D1#, Nx2#, Ny2#, D2#, Det#

Nx1=P12\Y-P11\Y
Ny1=P11\X-P12\X
D1=Nx1*P11\X+Ny1*P11\Y

Nx2=P22\Y-P21\Y
Ny2=P21\X-P22\X
D2=Nx2*P21\X+Ny2*P21\Y

Det=Nx1*Ny2-Nx2*Ny1

If Abs(Det)>0.0001
i=cVector((Ny2*D1-Ny1*D2)/Det, (Nx1*D2-Nx2*D1)/Det)
EndIf

Return i
End Function

Function isReflex(P.Polygon, i)
Return ptRight(P\P[(i-1+P\count) Mod P\count], P\P[i], P\P[(i+1) Mod P\count])
End Function

Function canSee(P.Polygon, a, b)
Local Pt.Vector, dist#, PtX#, PtY#

If ptLeftOn(P\P[(a+1) Mod P\count], P\P[a], P\P[b]) And ptRightOn(P\P[(a-1+P\count) Mod P\count], P\P[a], P\P[b])
Return False
EndIf

dist=ptSqDist(P\P[a], P\P[b])
For i=0 To P\count-1
If Not ((i+1) Mod P\count=a Or i=a)
If ptLeftOn(P\P[a], P\P[b], P\P[(i+1) Mod P\count]) And ptRightOn(P\P[a], P\P[b], P\P[i])
Pt=ptLineInt(P\P[a], P\P[b], P\P[i], P\P[(i+1) Mod P\count])

If Pt=Null
Return False
EndIf

If ptSqDist(P\P[a], Pt)<dist
Delete Pt

Return False
EndIf

Delete Pt
EndIf
EndIf
Next

Return True
End Function

Function polyCopy.Polygon(P.Polygon, i, j)
Local Tmp, P2.Polygon

P2=New Polygon

If i<j
For c=i To j
P2\P[P2\count]=P\P[c]
P2\count=P2\count+1
Next
Else
For c=i To P\count-1
P2\P[P2\count]=P\P[c]
P2\count=P2\count+1
Next
For c=0 To j
P2\P[P2\count]=P\P[c]
P2\count=P2\count+1
Next
EndIf

Return P2
End Function

Type Edge
Field P1.Vector
Field P2.Vector
End Type

Function cEdge.Edge(P1.Vector, P2.Vector)
Local E.Edge=New Edge

E\P1=P1
E\P2=P2

Return E
End Function

Type EdgeList
Field e.Edge[32]
Field count
End Type

Function polyDecompList.EdgeList(P.Polygon)
Local Tmp1.EdgeList, Tmp2.EdgeList, Min.EdgeList, nDiags, TmpPoly.Polygon

Min=New EdgeList
nDiags=32

For i=0 To P\count-1
If isReflex(P, i)
For j=0 To P\count-1
If canSee(P, i, j)
TmpPoly=polyCopy(P, i, j)
Tmp1=polyDecompList(TmpPoly)
Delete TmpPoly

TmpPoly=polyCopy(P, j, i)
Tmp2=polyDecompList(TmpPoly)
Delete TmpPoly

For c=0 To Tmp2\count-1
Tmp1\e[Tmp1\count]=Tmp2\e[c]
Tmp1\count=Tmp1\count+1
Next
Delete Tmp2

If Tmp1\count<nDiags
If Min<>Null
For c=0 To Min\count-1
Delete Min\e[c]
Next
Delete Min
EndIf

Min=Tmp1
nDiags=Tmp1\count

Min\e[Min\count]=cEdge(P\P[i], P\P[j])
Min\count=Min\count+1
Else
For c=0 To Tmp1\count-1
Delete Tmp1\e[c]
Next
Delete Tmp1
EndIf
EndIf
Next
EndIf
Next

Return Min
End Function

Function getIndex(P.Polygon, V.Vector)
For i=0 To P\count-1
If P\P[i]=V
Return i
EndIf
Next

Return -1
End Function

Type PolyList
Field e.Polygon[32]
Field count
End Type

Function removePolyFromList(PL.PolyList, i)
If PL\count=0
Return ;error!
EndIf

Delete PL\e[i]

For j=i+1 To PL\count-1
PL\e[j-1]=PL\e[j]
Next
PL\e[PL\count-1]=Null

PL\count=PL\count-1
End Function

Function polyDecomp.PolyList(P.Polygon)
Local E.EdgeList, P1.Polygon, P2.Polygon, PL.PolyList, SaveCopy.Polygon

E=polyDecompList(P)
PL=New PolyList

;//das Polygon ist schon convex
If E\count=0
PL\e[0]=P
PL\count=1

Delete E

Return PL
EndIf

;//das Polygon zerteilen
PL\e[0]=P
PL\count=1

SaveCopy=New Polygon
For c=0 To P\count-1
SaveCopy\P[c]=P\P[c]
Next
SaveCopy\count=P\count

For i=0 To E\count-1
For j=0 To PL\count-1
idx1=getIndex(PL\e[j], E\e[i]\P1)
idx2=getIndex(PL\e[j], E\e[i]\P2)

If idx1<>-1 And idx2<>-1
P1=polyCopy(PL\e[j], idx1, idx2)

PL\e[PL\count]=P1
PL\count=PL\count+1

P2=polyCopy(PL\e[j], idx2, idx1)

PL\e[PL\count]=P2
PL\count=PL\count+1

removePolyFromList(PL, j)

Exit
EndIf
Next
Next

;// die Polygone trennen (haben zT gemeinsame Punkte)
For i=0 To PL\count-1
For j=0 To PL\e[i]\count-1
PL\e[i]\P[j]=cVector(PL\e[i]\P[j]\X, PL\e[i]\P[j]\Y)
Next
Next

;/*
; * CleanUp
; */

For j=0 To E\count
Delete E\e[j]
Next
Delete E

For c=0 To SaveCopy\count-1
Delete SaveCopy\P[c]
Next
Delete SaveCopy

;/*
; * returning the List of new Polygons
; */

Return PL
End Function


Der Code räumt eigentlich gleich hinter sich selber auf, am Schluss sollte man nicht mehr Punkte haben als vorher, auch die Edges und EdgeLists werden wieder entsorgt. Einzig der Rückgabewert (PolyList) bleibt bestehen, und natürlich hat man mehr Polygone, weil das Original (das auch gelöscht wird) ja zerteilt wurde.
[Edit:] Jaja, das kommt davon wenn man hetzt. Der Code hatte noch ein paar Fehler. Namentlich wurde stets das selbe Polygon zerlegt, das heisst am Schluss hatte man einfach das alte Polygon in die zit Stufen zerlegt. Ausserdem habe ich vergessen den einen Counter hochzusetzen, was dazu führte, dass immer nur zwei Teile entstanden. Fehler korrigiert, Code updated, meh!

-----

Polygon splitting:

Darüber sprach ich ja schon in früheren Worklogeinträgen. VoronoiZerlegung eines Polygons, Clipping, Splitting,.. Aber dazu musste man es immer von Hand angehen und sagen, wo man Punkte oder Teilungen haben möchte. Ich bin für DaDaPhysics gerade dabei, dies zu automatisieren. Meine Idee war, dass ich quer durch das Polygon ein Gitter lege, das ich dann aufgrund der eintreffenden Kraft manipuliere und die Knoten verschiebe. Dies führt dann natürlich dazu, dass einige Verbindungen überstrapaziert werden. Die Verbindungsstücke, die noch im Rahmen ihrer alten Länge sind, werden gelöscht, die übrigen werden in Voronoi Punkte umgewandelt (ja, das könnte man wohl noch optimieren, direkt mit VP arbeiten) und dann wird das Polygon entsprechend zerteilt!

user posted image

Weil es ziemlich komische Ergebnisse gab, wenn ich die Dreiecke einfach irgendwie zusammengefügt habe, musste ich das ändern. Durch einen Artikel wusste ich, dass bei einer VoronoiZerlegung nur konvexe Polygone entstehen, habe ich einen Test eingeführt, der nur Verschmelzungen erlaubt, wenn das Ergebnis noch konvex ist. Dies, und die Tatsache, dass mein "ist das Polygon ein Nachbar des anderen"-Test ziemlich wacklig ist (manchmal sagt er "nein", wenn man doch klar sieht dass sie aneinander liegen) führt dazu, dass noch einige Reststücke herumliegen, die noch verschmolzen werden sollten, aber auch das kriege ich noch in den Griff. Irgendwann. Vielleicht. Mit viel Glück.
(Den Code dazu gebe ich in einem späteren Update für die Physik mal heraus, wenns wen wirklich brennend interessiert, kann er mir ne PN schreiben, vielleicht antworte ich sogar.)

Was hier jetzt noch fehlt ist die Umwandlung dieser Polygone in Physik-Bodies, das mache ich dann zusammen mit der konvex-Zerlegung von weiter oben in einem Schwupps. Da die Ergebnisse ja konvex sind, muss ich die nicht noch erst prüfen, also muss ich theoretisch nur die Punkte von einer Struktur in die nächste schieben. Könnte man in BB Arrays zuweisen, wäre das ein Einzeiler (oder Einzeller, haha!).

-----

So, ich hoffe dieser Eintrag bringt mich nun unter die Top100. Hier nochmal der Aufruf mein Profil mit ein paar 5-Blitzern zu versehen! Wenn ich genug Blitze kriege, kann ich mir davon vielleicht BMax kaufen, und noch viel mehr coole Dinge für euch zaubern!

Bis dahin wünsche ich euch einen schönen Tag,
MfG,
Darth

What the Eck?

Mittwoch, 24. März 2010 von darth
Hallo,

ich habe mal wieder ein kunterbuntes Allerlei an Funktionen in der Hinterhand, die ich gerne mit der breiten Öffentlichkeit teilen würde. Einige sind nützlich, andere sind wahnsinnig und die letzten halte ich einfach für lustig (Reihenfolge beliebig gewählt). Ohne grosse Umschweife nun zu dem was ich anzubieten habe:

Bezierkurven

Der Sinn einer Bezier Kurve liegt eigentlich darin, eine eher natürlich wirkende Kurve durch eine Anzahl von Kontrollpunkten zu legen. Ich glaube, der Herr Bezier hat die ursprünglich mal entwickelt um Autokarosserien zu beschreiben. Ich habe mir diese Routine geschrieben, weil ich eigentlich prozedural erzeugte Bäume wachsen lassen wollte, das hat (bisher) allerdings nicht funktioniert, weil mir einfach kein kluger Weg eingefallen ist, die Kontrollpunkte zu setzen, meine "Bäume" sahen eher nach zufälligen Stachelhaufen aus. Eine generelle Bezierkurve sieht durch mein Programm erstellt zum Beispiel so aus:

user posted image

Wie man sehen kann, wird nicht nur die reine Bezierkurve berechnet, es wird ein Polygon mit kontinuierlich schrumpfender Breite darum gelegt, das (zur späteren Verwendung im 3D Bereich) direkt noch in Dreiecke zerlegt wird. Das sollten eigentlich Stämme und Blätter der Bäume werden. Naja, seis drum, wird wohl irgendwann werden.

Der Code der das ganze Spektakel generiert findet ihr hier:

BlitzBasic: [AUSKLAPPEN]
Type Point
Field X#
Field Y#
End Type

Function newPoint.Point(x#, y#)
Local P.Point=New Point

P\X=x
P\Y=y

Return P
End Function

Function setPoint(P.Point, x#, y#)
P\X=x
P\Y=y
End Function

Function pointDist(P1.Point, P2.Point)
Return Sqr((P1\X-P2\X)*(P1\X-P2\X)+(P1\Y-P2\Y)*(P1\Y-P2\Y))
End Function

Type Bezier
Field controlPoints.Point[64]
Field iControlCount

Field curvePoints.Point[128]
Field iCurveCount

Field poly.BezPoly
End Type

Function newBezier.Bezier(NumberOfControls, Segments)
Local B.Bezier=New Bezier

B\iControlCount=NumberOfControls
B\iCurveCount=Segments+1

For i=0 To B\iCurveCount-1
B\curvePoints[i]=newPoint(0,0)
Next

Return B
End Function

Function subDivideCurve(B.Bezier, P1.Point, P2.Point, t#)
If P1\X>P2\X
P1\X=P1\X-Abs(P1\X-P2\X)*t
Else
P1\X=P1\X+Abs(P1\X-P2\X)*t
EndIf

If P1\Y>P2\Y
P1\Y=P1\Y-Abs(P1\Y-P2\Y)*t
Else
P1\Y=P1\Y+Abs(P1\Y-P2\Y)*t
EndIf
End Function

Function computeBezier(B.Bezier)
Local tmp.Point[64], t#, Depth

If B\poly<>Null
destroyBezPoly(B\poly)
EndIf

For i=0 To B\iControlCount-1
tmp[i]=newPoint(0,0)
Next

For i=0 To B\iCurveCount-1
t=Float(i)/(B\iCurveCount-1)

For j=0 To B\iControlCount-1
setPoint(tmp[j], B\controlPoints[j]\X, B\controlPoints[j]\Y)
Next

Depth=B\iControlCount

While Depth>1
For j=0 To Depth-2
subDivideCurve(B, tmp[j], tmp[j+1], t)
Next

Depth=Depth-1
Wend

setPoint(B\curvePoints[i], tmp[0]\X, tmp[0]\Y)
Next

For i=0 To B\iControlCount-1
Delete tmp[i] ;memleak control
Next

computeBezPoly(B, 25)
End Function

Function drawBezierCurve(B.Bezier)
For i=0 To B\iCurveCount-2
Line B\curvePoints[i]\X,B\curvePoints[i]\Y,B\curvePoints[i+1]\X,B\curvePoints[i+1]\Y
Next
End Function

Function drawControlPoints(B.Bezier, r=3)
For i=0 To B\iControlCount-1
Oval B\controlPoints[i]\X-r,B\controlPoints[i]\Y-r,2*r,2*r
Next
End Function

Type BezPoly
Field P.Point[256]
Field iPCount

Field T.BezTrig[256]
Field iTCount
End Type

Function destroyBezPoly(B.BezPoly)
For i=0 To B\iPCount-1
Delete B\P[i]
Next

For i=0 To B\iTCount-1
Delete B\T[i]
Next

Delete B
End Function

Function computeBezPoly(B.Bezier, d#)
Local Dd#, dX#, dY#, nX#, nY#, nL#, BP.BezPoly, T.BezTrig

BP=New BezPoly
BP\iPCount=B\iCurveCount*2-1
BP\iTCount=BP\iPCount-2

Dd=d/(B\iCurveCount-1)

For i=0 To B\iCurveCount-2
dX=B\curvePoints[i+1]\X-B\curvePoints[i]\X
dY=B\curvePoints[i+1]\Y-B\curvePoints[i]\Y

nL=Sqr(dX*dX+dY*dY)

nX=dY/nL
nY=-dX/nL

BP\P[i]=newPoint(B\curvePoints[i]\X+nX*d, B\curvePoints[i]\Y+nY*d)
BP\P[BP\iPCount-i-1]=newPoint(B\curvePoints[i]\X-nX*d, B\curvePoints[i]\Y-nY*d)

If i>0
T=New BezTrig
BP\T[(i-1)*2]=T

T\P1=BP\P[i-1]
T\P2=BP\P[i]
T\P3=BP\P[BP\iPCount-i]

T=New BezTrig
BP\T[(i-1)*2+1]=T

T\P1=BP\P[i]
T\P2=BP\P[BP\iPCount-i-1]
T\P3=BP\P[BP\iPCount-i]
EndIf

d=d-Dd
Next

BP\P[B\iCurveCount-1]=newPoint(B\curvePoints[B\iCurveCount-1]\X, B\curvePoints[B\iCurveCount-1]\Y)

T=New BezTrig
BP\T[BP\iTCount-1]=T

T\P1=BP\P[B\iCurveCount-2]
T\P2=BP\P[B\iCurveCount-1]
T\P3=BP\P[B\iCurveCount]

B\poly=BP
End Function

Function drawBezPoly(B.Bezier)
LockBuffer BackBuffer()

j=B\poly\iPCount-1
For i=0 To B\poly\iPCount-1
Line B\poly\P[i]\X,B\poly\P[i]\Y,B\poly\P[j]\X,B\poly\P[j]\Y

j=i
Next

UnlockBuffer BackBuffer()
End Function

Function drawBezTrig(B.Bezier)
LockBuffer BackBuffer()

Local T.BezTrig

For i=0 To B\poly\iTCount-1
T=B\poly\T[i]

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
Next

UnlockBuffer BackBuffer()
End Function

Type BezTrig
Field P1.Point
Field P2.Point
Field P3.Point
End Type


So im Nachhinein nerve ich mich, dass ich wieder eine neue Polygon Struktur geschrieben habe, und diesen "Point"-Type eingeführt habe -.- ich hätte es mit Vektoren und meiner alten Poly Struktur machen sollen, nun werd ich den Mist irgendwann wohl umschreiben müssen.
Als kleiner Anhang noch ein Beispiel, wie die Bezier aufgebaut werden und zu verwenden sind:

BlitzBasic: [AUSKLAPPEN]
Graphics 800,600,0,2
SetBuffer BackBuffer()

Local B.Bezier=newBezier(6, 50)
B\controlPoints[0]=newPoint(102,287)
B\controlPoints[1]=newPoint(177,225)
B\controlPoints[2]=newPoint(252,293)
B\controlPoints[3]=newPoint(321,216)
B\controlPoints[4]=newPoint(396,296)
B\controlPoints[5]=newPoint(439,171)

Local PMove.Point, minDist#

While Not KeyHit(1)
B=First Bezier

computeBezier(B)

Color 0,255,0
;drawBezierCurve(B)
drawControlPoints(B, 3)

Color 255,255,255
drawBezTrig(B)

Color 255,0,0
drawBezPoly(B)

minDist=100000
For i=0 To B\iControlCount-1
dist#=Sqr((B\controlPoints[i]\X-MouseX())^2+(B\controlPoints[i]\Y-MouseY())^2)
If dist<minDist
minDist=dist
PMove=B\controlPoints[i]
EndIf
Next
If PMove<>Null
Oval PMove\X-5,PMove\Y-5,10,10,0
EndIf
If MouseDown(1) And PMove<>Null
PMove\X=MouseX()
PMove\Y=MouseY()
EndIf

If MouseHit(2)
B\controlPoints[B\iControlCount]=newPoint(MouseX(), MouseY())
B\iControlCount=B\iControlCount+1

B\iCurveCount=B\iCurveCount+2
B\curvePoints[B\iCurveCount-2]=newPoint(0,0)
B\curvePoints[B\iCurveCount-1]=newPoint(0,0)
EndIf

fpsCount=fpsCount+1
If MilliSecs()-fpsTime>999
fpsCur=fpsCount
fpsCount=0
fpsTime=MilliSecs()
EndIf
Text 10,10,fpsCur

Flip 0
Cls
Wend
End


Polygone

Ich habe angefangen, alles zu sammeln was ich bisher mit Polygonen gemacht habe. Es kam eine relativ hübsche Sammlung zusammen, die ich euch nicht vorenthalten möchte. Zuerst aber ein paar Anmerkungen zum Unfang und Dingen in dieser Richtung:

* Mathematische Funktionen: min / max
Öhm, ja.. die sind unheimlich aufwändig und selbsterklärend.

* Polygonstruktur:
Es gibt einen Type Vektor und einen Type Polygon. Polygone besetehen aus Vektoren, die Punkte müssen ihm Uhrzeigersinn angegeben werden (für nachfolgende Funktionen). Maximale Punktzahl (relativ willkürlich): 64.
Die Funktionen die mit "c" beginnen sind "Constructors" und die mit "d" sind "Destructors", dient ein wenig dazu, den Speicher zu schützen, damit der nicht überläuft und vereinfacht gewisse andere Handhabungen.

* Manipulationen:
Man kann Punkte hinzufügen, Punkte wegnehmen und Punkte finden. Relativ selbsterklärend.

* Rendermethoden:
Bisher habe ich nur 2D Render geschrieben (obwohl irgendwo wohl auch noch eine 3D Version rumfliegt von einer alten Physik Implementation). Generell ist zu sagen, dass ein Clipping das Polygon zerstört, daher wird ein Klon davon angelegt, bevor es gerendert wird (und der Klon dann fachgerecht entsorgt).
Es gibt eine Methode um das Polygon zu füllen, und eine um nur die Umrisse zu zeichnen, man kann natürlich auch beides verwenden.
Lockbuffer wird empfohlen (ist nicht stdmässig drin), weil es das Zeichnen von Linien doch ziemlich beschleunigt.

* Weitere Manipulationen
Gewisse Methoden sind selbsterklärend, andere nicht.
ClipPolyAtLine zerschneidet ein Polygon an einer gegebenen Linie, die Richtung der Normalen ist entegen der Richtung des Verlustes.
PseudoVoronoi (3) macht eine ungefähre Voronoi Zerlegung eines Polygons anhand von gewissen "VPoints" die man setzen kann. Das Zusammenfassen der Einzelteile zu einem Ganzen ist reine Glückssache, es kommen also keine schön konvexen Stücke raus, wie es eigentlich sollte. (Anm: Es wird empfohlen, mergePolygon nicht selbst zu verwenden, da es nur für Sonderfälle gedacht ist und das zweite Polygon löscht.)
AddOnPolygon (1) fügt ein Polygon an ein anderes an. Dazu muss mindestens eine Teilkante gemeinsam sein.
CutOutPolygon (2) schneidet ein Polygon aus einem anderen aus.

Beispiele hierzu:

user posted image

Die grauen (meist hinter dem anderen verborgenen) Polygone sind die Ursprünge, die Weissen sind die Resultate. Diese Methoden wurden entwickelt, um ein Objekt splittern zu lassen, allerdings bin ich mir auch hier noch nicht bewusst, wie ich die Punkte setzen soll. Ich wollte so etwas machen, wo man auf einen Klotz schiesst und dann ein Teil herausbricht und splittert (darum das CutOut), das AddOn ist einfach entstanden, weil es CutOut in umgekehrter Reihenfolge ist :> ging sozusagen in einem Wisch.
Kleine Anmerkung: Die Dinger sind eigentlich ausführlich getestet, aber es kann immer wieder vorkommen, dass ein Sonderfall nicht funktioniert. Sollte jemand einen finden, wäre ich froh wenn er mir das mitteilt.

Code im Anhang:

BlitzBasic: [AUSKLAPPEN]
;/*
; * Utilities
; */

Function max#(A#,B#)
If A>B
Return A
Else
Return B
EndIf
End Function

Function min#(A#,B#)
If A<B
Return A
Else
Return B
EndIf
End Function

;/*
; * Polygon
; */

Type Vector
Field X#
Field Y#

Field U#
Field V#

Field used
End Type

Function cVector.Vector(x#,y#)
v.Vector=New Vector

v\x=x
v\y=y

Return v
End Function

Type Polygon
Field P.Vector[64]
Field count

Field VFlag

Field R
Field G
Field B
End Type

Function cPolygon.Polygon(count)
Local P.Polygon=New Polygon

P\count=count

;Achtung: Die Vektoren müssen selber geladen werden!

P\VFlag=True

P\R=255
P\G=255
P\B=255

Return P
End Function

Function dPolygon(P.Polygon)
For i=0 To P\count-1
Delete P\P[i]
Next

Delete P
End Function

;/*
; * Vertex Manipulation
; */

Function insertPointToPoly(P.Polygon, V.Vector, i)
If P\count=64
Return ;error!
EndIf

For j=P\count-1 To i Step -1
P\P[j+1]=P\P[j]
Next
P\P[i]=V

P\count=P\count+1
End Function

Function removePointFromPoly(P.Polygon, i)
If P\count=0
Return ;error!
EndIf

For j=i+1 To P\count-1
P\P[j-1]=P\P[j]
Next
P\P[P\count-1]=Null

P\count=P\count-1
End Function

Function getIndex(P.Polygon, V.Vector)
For i=0 To P\count-1
If P\P[i]=V
Return i
EndIf
Next

Return -1
End Function

Function predVertex.Vector(P.Polygon ,vIndex)
While True
vIndex=vIndex-1
If vIndex<0
vIndex=P\count-1
EndIf

If Not P\P[vIndex]\used
Return P\P[vIndex]
EndIf
Wend
End Function

Function predIndex(P.Polygon, vIndex)
While True
vIndex=vIndex-1
If vIndex<0
vIndex=P\count-1
EndIf

If Not P\P[vIndex]\used
Return vIndex
EndIf
Wend
End Function

Function succVertex.Vector(P.Polygon, vIndex)
While True
vIndex=vIndex+1
If vIndex>P\count-1
vIndex=0
EndIf

If Not P\P[vIndex]\used
Return P\P[vIndex]
EndIf
Wend
End Function

Function succIndex(P.Polygon, vIndex)
While True
vIndex=vIndex+1
If vIndex>P\count-1
vIndex=0
EndIf

If Not P\P[vIndex]\used
Return vIndex
EndIf
Wend
End Function

Function vertexCount(P.Polygon)
Local count=0

For i=0 To P\count-1
If Not P\P[i]\used
count=count+1
EndIf
Next

Return count
End Function

;/*
; * Rendering Methods
; */

Function renderPolygon(P.Polygon)
Local Tmp.Polygon=New Polygon

For i=0 To P\count
Tmp\P[i]=cVector(P\P[i]\X, P\P[i]\Y)
Next
Tmp\count=P\count

clipPolyAtScreen(Tmp)
fillPoly(Tmp, P\R, P\G, P\B)

dPolygon(Tmp)
End Function

Function clipPolyAtScreen(P.Polygon)
Local Width, Vnew.Vector, PX#, PY#, DX#, DY#, k#, PnewY

Width=GraphicsWidth()

j=P\count-1
For i=0 To P\count-1
If Not (P\P[i]\X<0 And P\P[j]\X<0)
PX=P\P[i]\X
PY=P\P[i]\Y

DX=P\P[j]\X-PX
DY=P\P[j]\Y-PY

k=-PX/DX
If k>0 And k<1
PnewY=PY+k*DY

Vnew=cVector(1,PnewY)

insertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf

k=(Width-PX)/DX
If k>0 And k<1
PnewY=PY+k*DY

Vnew=cVector(Width-1,PnewY)

insertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf
EndIf

j=i
Next

For i=0 To P\count-1
If P\P[i]\X<0 Or P\P[i]\X>Width
removePointFromPoly(P, i)
i=i-1
EndIf
Next
End Function

Type LList
Field X

Field Succ.LList
End Type

Function fillPoly(P.Polygon, R, G, B)
Local MinX#, MinY#, MaxX#, MaxY#, SX#, SY#, DX#, PX#, PY#, VX#, VY#, k#, CX#, Fill
Local LStart.LList, LIter.LList, Tmp.LList

Color R,G,B

MinX=GraphicsWidth()
MinY=GraphicsHeight()
MaxX=0
MaxY=0

For i=0 To P\count-1
If P\P[i]\X<MinX
MinX=P\P[i]\X
EndIf
If P\P[i]\X>MaxX
MaxX=P\P[i]\X
EndIf

If P\P[i]\Y<MinY
MinY=P\P[i]\Y
EndIf
If P\P[i]\Y>MaxY
MaxY=P\P[i]\Y
EndIf
Next

MaxY=min(GraphicsHeight()-1,MaxY)
MinY=max(0,MinY)

For SY=Int(MinY-0.5) To (MaxY+0.5)
Delete Each LList
Fill=0

SX=MinX

DX=MaxX-MinX

j=P\count-1
For i=0 To P\count-1
PX=P\P[i]\X
PY=P\P[i]\Y+0.1

VX=P\P[j]\X-P\P[i]\X
VY=P\P[j]\Y-P\P[i]\Y

If VY<>0
k=(SY-PY)/VY
If k>=0 And k<=1
CX=PX+k*VX

k=(CX-SX)/DX
If k>=0 And k<=1
CX=Int(CX)

If LStart=Null
LStart=New LList
LStart\X=CX
Else
If CX<LStart\X
Tmp=LStart

LStart=New LList
LStart\X=CX
LStart\Succ=Tmp
Else
LIter=LStart
While LIter<>Null
If Int(CX)=LIter\X
Tmp=LIter\Succ

LIter\Succ=New LList
LIter\Succ\X=CX
LIter\Succ\Succ=Tmp

Exit
Else
If CX>LIter\X
If LIter\Succ<>Null
If CX<LIter\Succ\X
Tmp=LIter\Succ

LIter\Succ=New LList
LIter\Succ\X=CX
LIter\Succ\Succ=Tmp

Exit
EndIf
Else
LIter\Succ=New LList
LIter\Succ\X=CX

Exit
EndIf
EndIf
EndIf

LIter=LIter\Succ
Wend
EndIf
EndIf
EndIf
EndIf
EndIf

j=i
Next

LIter=LStart
If LIter<>Null
While LIter\Succ<>Null
Line LIter\X,SY,LIter\Succ\X,SY
LIter=LIter\Succ\Succ

If LIter=Null
Exit
EndIf
Wend
EndIf
Next

Delete Each LList
End Function

Function outlinePoly(P.Polygon, R, G, B)
Color R,G,B

j=P\count-1
For k=0 To P\count-1
Line P\P[k]\X,P\P[k]\Y,P\P[j]\X,P\P[j]\Y

j=k
Next
End Function

;/*
; * Polygon Manipulation
; */

;// point in Polygon test

Function pointInPoly(X#, Y#, P.Polygon)
Local in, X1#, Y1#, X2#, Y2#

in = False
For i=0 To P\count-1
If i Then j=i-1 Else j=P\count-1
X1#=P\P[i]\X
Y1#=P\P[i]\Y
X2#=P\P[j]\X
Y2#=P\P[j]\Y
If ((((Y1<=Y) And (Y<Y2)) Or ((Y2<=Y) And (Y<Y1))) And (X<(((X2-X1)*(Y-Y1))/(Y2-Y1))+X1))
in = Not in
EndIf
Next

Return in
End Function

;// Divide a Polygon into Triangles

Type PTrig
Field V1.Vector
Field V2.Vector
Field V3.Vector

Field used
End Type

Function splitToTrigs(P.Polygon, iVertex=0)
Local Triangle.PTrig

Local Vertex.Vector=P\P[iVertex]
Local Pred.Vector=predVertex(P, iVertex)
Local Succ.Vector=succVertex(P, iVertex)

If lineInPoly(P, Pred, Succ, Vertex) Or vertexCount(P)=3
Triangle=New PTrig
Triangle\V1=Vertex
Triangle\V2=Pred
Triangle\V3=Succ

Vertex\used=True
EndIf

If vertexCount(P)>=3
splitToTrigs(P, getIndex(P, Succ))
EndIf
End Function

Function lineInPoly(P.Polygon, V1.Vector, V2.Vector, MidVertex.Vector)
Local angle#, Succ.Vector, Vx#, Vy#, C#, Sign

angle#=(360+ATan2(V1\Y-MidVertex\Y,V1\X-MidVertex\X)-ATan2(V2\Y-MidVertex\Y,V2\X-MidVertex\X)) Mod 360

If angle>180
Return False
EndIf

For i=0 To P\count-1
Succ.Vector=succVertex(P, i)

If P\P[i]<>V1 And P\P[i]<>V2 And Succ<>V1 And Succ<>V2
If lineCollision(V1\X,V1\Y,V2\X-V1\X,V2\Y-V1\Y,P\P[i]\X,P\P[i]\Y,Succ\X-P\P[i]\X,Succ\Y-P\P[i]\Y)
Return False
EndIf
EndIf
Next

Vx#=V1\Y-V2\Y
Vy#=V2\X-V1\X

C#=-V1\X*Vx-V1\Y*Vy

Sign=0
For i=0 To P\count-1
If P\P[i]<>V1 And P\P[i]<>V2
If Sign
If Sign<>Sgn(P\P[i]\X*Vx+P\P[i]\Y*Vy+C)
Exit
EndIf
Else
Sign=Sgn(P\P[i]\X*Vx+P\P[i]\Y*Vy+C)
EndIf
EndIf
Next

Return True
End Function

Function lineCollision(X1#,Y1#,VX1#,VY1#,X2#,Y2#,VX2#,VY2#)
If VX1=0 Then VX1=0.001
If VY1=0 Then VY1=0.001
If VX2=0 Then VX2=0.001
If VY2=0 Then VY2=0.001

IntersectionX#=-(X1*VX2*VY1-(X2*VY2+(Y1-Y2)*VX2)*VX1)/(VX1*VY2-VX2*VY1)
IntersectionT#=(IntersectionX-X1)/VX1

If IntersectionT>=0 And IntersectionT<=1
IntersectionT=(IntersectionX-X2)/VX2

If IntersectionT>=0 And IntersectionT<=1
Return True
EndIf
EndIf
End Function

;// splits a Polygon into two pieces
;// in the middle of two given points

Type VPoint
Field X#
Field Y#
End Type

Function cVPoint.VPoint(x#, y#)
Local V.VPoint=New VPoint

V\X=x
V\Y=y

Return V
End Function

Function splitPolygon(P.Polygon, P1.VPoint, P2.VPoint)
Local Tmp.Polygon, NX#, NY#, PX#, PY#

Tmp=New Polygon
For i=0 To P\count-1
Tmp\P[i]=cVector(P\P[i]\X, P\P[i]\Y)
Next
Tmp\count=P\count
Tmp\VFlag=True

PX=(P1\X+P2\X)/2
PY=(P1\Y+P2\Y)/2

NX=P2\Y-P1\Y
NY=P1\X-P2\X

clipPolyAtLine(Tmp, PX, PY, NX, NY)

Tmp=New Polygon
For i=0 To P\count-1
Tmp\P[i]=cVector(P\P[i]\X, P\P[i]\Y)
Next
Tmp\count=P\count
Tmp\VFlag=True

NX=-NX
NY=-NY

clipPolyAtLine(Tmp, PX, PY, NX, NY)

dPolygon(P)
End Function

Function clipPolyAtLine(P.Polygon, PX1#, PY1#, PDx#, PDy#)
Local Width, Vnew.Vector, PX#, PY#, DX#, DY#, k#, t#, NX#, NY#, ND#, L#, HNF#

j=P\count-1
For i=0 To P\count-1
PX=P\P[i]\X
PY=P\P[i]\Y

DX=P\P[j]\X-PX
DY=P\P[j]\Y-PY

;P+k*D = P1+t*PD

;t=(DX*(PY-PY1)-DY*(PX-PX1))/(DX*PDy-DY*PDx)
k=(PDx*(PY-PY1)-PDy*(PX-PX1))/(DX*PDy-DY*PDx)

If k>0 And k<1
Vnew=cVector(PX+k*DX, PY+k*DY)

insertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf

j=i
Next

NX=PDy
NY=-PDx

L=Sqr(NX*NX+NY*NY)
NX=NX/L
NY=NY/L

ND=-PX1*NX-PY1*NY

For i=0 To P\count-1
HNF=NX*P\P[i]\X+NY*P\P[i]\Y+ND

If HNF<-0.1
removePointFromPoly(P, i)
i=i-1
EndIf
Next
End Function

;// makes a (pseudo) Voronoi split of the Polygon

Function pseudoVoronoi(P.Polygon)
Local PIter.Polygon, vP1.VPoint, vP2.VPoint, MX#, MY#, NX#, NY#, pP1.Polygon, pP2.Polygon, vPCount
For PIter=Each Polygon
PIter\VFlag=False
Next

vPCount=0
For vP1=Each VPoint
vPCount=vPCount+1

If vPCount>2
Exit
EndIf
Next
If vPCount<2
Return
EndIf

P\VFlag=True

For vP1=Each VPoint
vP2=After vP1
While vP2<>Null
MX=(vP1\X+vP2\X)/2
MY=(vP1\Y+vP2\Y)/2

NX=vP2\Y-vP1\Y
NY=vP1\X-vP2\X

For PIter=Each Polygon
If PIter\VFlag=True
If pointInPoly(vP1\X, vP1\Y, PIter)
pP1=PIter
EndIf
If pointInPoly(vP2\X,vP2\Y, PIter)
pP2=PIter
EndIf
EndIf
Next

If pP1=pP2
If pP1<>Null
splitPolygon(pP1, vP1, vP2)
EndIf
Else
If pP1<>Null
splitPolygon(pP1, vP1, vP2)
EndIf
If pP2<>Null
splitPolygon(pP2, vP1, vP2)
EndIf
EndIf

vP2=After vP2
Wend
Next

For PIter=Each Polygon
simplyfyPoly(PIter)

If PIter\count<3
Delete PIter
EndIf
Next

While True
If collectPolys()=False
Exit
EndIf
Wend
End Function

Function collectPolys()
Local Merged=False, PIter1.Polygon, PIter2.Polygon

For PIter1=Each Polygon
If isMainPoly(PIter1)
For PIter2=Each Polygon
If PIter1<>PIter2
If Not isMainPoly(PIter2)
If isNeighbor(PIter1, PIter2)
;/*
; * Die Auswahlregeln sind mir zu blöd :>
; * ich werde sie daher ignorieren \o/
; * vielleicht werden sie irgendwann ersetzt...
; */

If Merged=False
Merged=mergePolygon(PIter1, PIter2)
Else
mergePolygon(PIter1, PIter2)
EndIf
EndIf
EndIf
EndIf
Next
EndIf
Next

Return Merged
End Function

Function isNeighbor(P1.Polygon, P2.Polygon)
If P1=Null Or P2=Null
Return False
EndIf

Local count=0, j0=-1, i0=-1

For i=0 To P1\count-1
For j=0 To P2\count-1
If Abs(P1\P[i]\X-P2\P[j]\X)<1 And Abs(P1\P[i]\Y-P2\P[j]\Y)<1
If count=0
j0=j
i0=i
EndIf

count=count+1

If count=2
If (Abs(i0-i)=1 Or (i0=0 And i=P1\count-1) Or (i0=P1\count-1 And i=0)) And (Abs(j0-j)=1 Or (j0=0 And j=P2\count-1) Or (j0=P2\count-1 And j=0))
Return True
Else
Return False
EndIf
EndIf
EndIf
Next
Next

Return False
End Function

Function isMainPoly(P.Polygon)
Local vP.VPoint

For vP=Each VPoint
If pointInPoly(vP\X, vP\Y, P)
Return True
EndIf
Next

Return False
End Function

Function mergePolygon(P1.Polygon, P2.Polygon)
Local iE1, jE1, iE2, jE2, count

For i=0 To P1\count-1
For j=0 To P2\count-1
If Abs(P1\P[i]\X-P2\P[j]\X)<2 And Abs(P1\P[i]\Y-P2\P[j]\Y)<2
If count=0
iE1=i
jE1=j
ElseIf count=1
iE2=i
jE2=j
EndIf

count=count+1
EndIf
Next
Next

If count<>2
Return False
EndIf

If iE1=0 And iE2=P1\count-1
iE1=iE2
jE1=jE2
EndIf

i=iE1
For j=jE1 To jE1+P2\count-1
iT=j Mod P2\count

insertPointToPoly(P1, P2\P[iT], i)
i=i+1
Next

simplyfyPoly(P1)
Delete P2

Return True
End Function

Function simplyfyPoly(P.Polygon)
Local Dx1#, Dy1#, Dl1#, Dx2#, Dy2#, Dl2#

For i=0 To P\count-1
For j=0 To P\count-1
If i<>j
If Abs(P\P[i]\X-P\P[j]\X)<0.5 And Abs(P\P[i]\Y-P\P[j]\Y)<0.5
removePointFromPoly(P, j)
j=j-1
EndIf
EndIf
Next
Next

For i1=0 To P\count-1
i2=(i1+1) Mod P\count
i3=(i1+2) Mod P\count

Dx1#=P\P[i1]\X-P\P[i3]\X
Dy1#=P\P[i1]\Y-P\P[i3]\Y
Dl1#=Sqr(Dx1*Dx1+Dy1*Dy1)
Dx1=Dx1/Dl1
Dy1=Dy1/Dl1

Dx2#=P\P[i1]\X-P\P[i2]\X
Dy2#=P\P[i1]\Y-P\P[i2]\Y
Dl2#=Sqr(Dx2*Dx2+Dy2*Dy2)
Dx2=Dx2/Dl2
Dy2=Dy2/Dl2

If Abs(Dx1-Dx2)<0.05 And Abs(Dy1-Dy2)<0.05
removePointFromPoly(P, i2)

i1=i1-1
EndIf
Next
End Function

;// adds a Polygon to another one

Type LPair
Field i1
Field i2

Field j1
Field j2
End Type

Function addOnPolygon(P1.Polygon, P2.Polygon, delType=True)
Local L.LPair, iStart, jStart, iEnd, jEnd

Delete Each LPair

For i=0 To P1\count-1
L=Null
i2=(i+1) Mod P1\count

For j=0 To P2\count-1
If isOnLine(P2\P[j], P1\P[i]\X, P1\P[i]\Y, P1\P[i2]\X-P1\P[i]\X, P1\P[i2]\Y-P1\P[i]\Y)
If L=Null
L=New LPair

L\i1=i
L\i2=i2

L\j1=j
Else
L\j2=j
EndIf
EndIf
Next
Next

L=First LPair
iStart=L\i1
iEnd=L\i2

LStart.LPair=L
LEnd.LPair=L

While True
found=False

For L=Each LPair
If L\i1=iEnd
iEnd=L\i2
LEnd=L

found=True
EndIf
Next

If Not found
Exit
EndIf
Wend

While True
found=False

For L=Each LPair
If L\i2=iStart
iStart=L\i1
LStart=L

found=True
EndIf
Next

If Not found
Exit
EndIf
Wend

t0#=Sqr((P1\P[iStart]\X-P2\P[LStart\j1]\X)^2+(P1\P[iStart]\Y-P2\P[LStart\j1]\Y)^2)
t1#=Sqr((P1\P[iStart]\X-P2\P[LStart\j2]\X)^2+(P1\P[iStart]\Y-P2\P[LStart\j2]\Y)^2)

If t0<t1
jStart=LStart\j1
Else
jStart=LStart\j2
EndIf

t0#=Sqr((P1\P[iEnd]\X-P2\P[LEnd\j1]\X)^2+(P1\P[iEnd]\Y-P2\P[LEnd\j1]\Y)^2)
t1#=Sqr((P1\P[iEnd]\X-P2\P[LEnd\j2]\X)^2+(P1\P[iEnd]\Y-P2\P[LEnd\j2]\Y)^2)

If t0<t1
jEnd=LEnd\j1
Else
jEnd=LEnd\j2
EndIf

i=iStart+1
j=jStart
While j<>jEnd
insertPointToPoly(P1, P2\P[j], i)

i=i+1
j=(j+1) Mod P2\count
Wend
insertPointToPoly(P1, P2\P[jEnd], i)

Delete Each LPair

simplyfyPoly(P1)
If delType
Delete P2
EndIf
End Function

;// cuts a Polygon out of another one

Function cutOutPolygon(P1.Polygon, P2.Polygon, delType=True)
Local L.LPair, iStart, jStart, iEnd, jEnd

Delete Each LPair

For i=0 To P1\count-1
L=Null
i2=(i+1) Mod P1\count

For j=0 To P2\count-1
If isOnLine(P2\P[j], P1\P[i]\X, P1\P[i]\Y, P1\P[i2]\X-P1\P[i]\X, P1\P[i2]\Y-P1\P[i]\Y)
If L=Null
L=New LPair

L\i1=i
L\i2=i2

L\j1=j
Else
L\j2=j
EndIf
EndIf
Next
Next

L=First LPair
iStart=L\i1
iEnd=L\i2

LStart.LPair=L
LEnd.LPair=L

While True
found=False

For L=Each LPair
If L\i1=iEnd
iEnd=L\i2
LEnd=L

found=True
EndIf
Next

If Not found
Exit
EndIf
Wend

While True
found=False

For L=Each LPair
If L\i2=iStart
iStart=L\i1
LStart=L

found=True
EndIf
Next

If Not found
Exit
EndIf
Wend

t0#=Sqr((P1\P[iStart]\X-P2\P[LStart\j1]\X)^2+(P1\P[iStart]\Y-P2\P[LStart\j1]\Y)^2)
t1#=Sqr((P1\P[iStart]\X-P2\P[LStart\j2]\X)^2+(P1\P[iStart]\Y-P2\P[LStart\j2]\Y)^2)

If t0<t1
jStart=LStart\j1
Else
jStart=LStart\j2
EndIf

t0#=Sqr((P1\P[iEnd]\X-P2\P[LEnd\j1]\X)^2+(P1\P[iEnd]\Y-P2\P[LEnd\j1]\Y)^2)
t1#=Sqr((P1\P[iEnd]\X-P2\P[LEnd\j2]\X)^2+(P1\P[iEnd]\Y-P2\P[LEnd\j2]\Y)^2)

If t0<t1
jEnd=LEnd\j1
Else
jEnd=LEnd\j2
EndIf

i=(iStart+1) Mod P1\count
While i<>iEnd
removePointFromPoly(P1, i)

i=(i+1) Mod P1\count
Wend

i=(iStart+1) Mod P1\count
j=jStart
While j<>jEnd
insertPointToPoly(P1, P2\P[j], i)

i=i+1
j=(j-1+P2\count) Mod P2\count
Wend
insertPointToPoly(P1, P2\P[jEnd], i)

Delete Each LPair

simplyfyPoly(P1)
If delType
Delete P2
EndIf
End Function

Function isOnLine(V.Vector, X#, Y#, Dx#, Dy#)
Local t1#, t2#

If Abs(Dx)<0.01
If Abs(V\X-X)<0.5
t1=(V\Y-Y)/Dy

If t1>=0 And t1<=1
Return True
EndIf
EndIf
ElseIf Abs(Dy)<0.01
If Abs(V\Y-Y)<0.5
t1=(V\X-X)/Dx

If t1>=0 And t1<=1
Return True
EndIf
EndIf
Else
t1=(V\X-X)/Dx
t2=(V\Y-Y)/Dy

If Abs(t1-t2)<0.5
If t1>=0 And t1<=1
Return True
EndIf
EndIf
EndIf

Return False
End Function


Edit: Ich hatte vergessen die Versuchsfunktion rauszunehmen. Das führte dazu, dass bei einer Voronoi Zerlegung eine Endlosschleife auftreten konnte -> Programmabsturz. Allerdings habe ich mittlerweilen festgestellt, dass es zu falschen polyMerges kommen kann, ich muss das nochmal angucken, Update wird wohl hier erfolgen.

Physik

Im letzten Eintrag habe ich geschrieben, dass ich an der BB Version der Physik nicht weiterarbeiten würde, weil ich Probleme mit der Organisation kriegen würde. Mir ist dann eine völlig absurde Idee eingefallen, und all meine Kollegen halten mir auch vor, dass ich das keinesfalls so machen soll. Sie fragen mich stets, warum ich nicht alles in Java mache, die verstehen halt keine Nostalgie *sniff*.
BlitzBasic ist nicht das schnellste Pferd im Stall wenn es ums Rechnen geht. Deshalb habe ich beschlossen, die Physikberechnungen in Java zu machen. Mit Java kann ich aber leider keine DLLs erstellen (und C++ halte ich noch immer für eine schreckliche Sprache), von daher sah ich nur eine Alternative: Ich schicke die Daten über einen UDP Stream von Java nach BB, welches sich nur noch um die Darstellung kümmert.
Inwiefern ich daraus ein Spiel erstellen soll, weiss ich noch nicht, aber wenn ich mir das richtig überlegt habe, muss ich eigentlich nur die Commands von BB nach Java schicken, und die Resultate zurück, aber so weit bin ich noch nicht.
Wen die genaue Funktion interessiert kann mich fragen (oder etwas warten, wenns ausgereift ist kommts sowieso mal hier rein).

Der Download Link ist etwas weiter links. Mit der linken Maustaste kann man neue Objekte zaubern. Die Darstellung ist eine Mischung aus 2D (farbige Klötze) und 3D (fallende Kisten).

user posted image

Das Programm startet die Jar-Datei automatisch, ich habe es nicht hinbekommen das Javafenster zu verstecken, die WinAPI-Funktion liefert mir für findWindow immer nur 0 zurück, ich muss das nochmal genauer studieren. Zur Sicherheit und Bequemlichkeit habe ich einen PingTimer eingebaut, wenn sich BB zu lange nicht meldet (1.5sek) dann schaltet das Java Programm aus, wenn die Leitung verstopft ist und BB keine Pakete von Java erhält, schaltet es mit einem Runtimeerror aus.

For shits and giggles

Als letztes möchte ich noch das bisher sinnloseste Programm vorstellen, das ich bisher geschrieben habe. Sinnlos deshalb, weil ich mir beim besten Willen einfach keinen Anwendungszweck dafür vorstellen kann. Es handelt sich dabei um ein Programm, das aus einer Zahl wie "135" einen String "Einhundertfünfunddreissig" macht. Es geht bis 100mio, danach wurde es mir zu unsinnig. Wieso ich das gemacht habe weiss ich nichtmehr, aber ich hatte Spass daran und es zeigt, wie kompliziert unser deutsches Zahlensystem eigentlich aufgebaut ist, überall irgendwelche blöden sonderfälle.

Code im Anhang:

BlitzBasic: [AUSKLAPPEN]
Function toString$(zahl$)
If Len(zahl)=1
Select zahl
Case "0"
Return "null"
Case "1"
Return "ein"
Case "2"
Return "zwei"
Case "3"
Return "drei"
Case "4"
Return "vier"
Case "5"
Return "fünf"
Case "6"
Return "sechs"
Case "7"
Return "sieben"
Case "8"
Return "acht"
Case "9"
Return "neun"
End Select
Else
If Len(zahl)=2
Select zahl
Case "10"
Return "zehn"
Case "11"
Return "elf"
Case "12"
Return "zwölf"
Case "13"
Return "dreizehn"
Case "14"
Return "vierzehn"
Case "15"
Return "fünfzehn"
Case "16"
Return "sechzehn"
Case "17"
Return "siebzehn"
Case "18"
Return "achtzehn"
Case "19"
Return "neunzehn"
Default
Select Left(zahl,1)
Case "0"
Return toString(Right(zahl,1))
Case "2"
If Right(zahl,1)="0"
Return "zwanzig"
Else
Return toString(Right(zahl,1))+"undzwanzig"
EndIf
Case "3"
If Right(zahl,1)="0"
Return "dreissig"
Else
Return toString(Right(zahl,1))+"unddreissig"
EndIf
Case "4"
If Right(zahl,1)="0"
Return "vierzig"
Else
Return toString(Right(zahl,1))+"undvierzig"
EndIf
Case "5"
If Right(zahl,1)="0"
Return "fünfzig"
Else
Return toString(Right(zahl,1))+"undfünfzig"
EndIf
Case "6"
If Right(zahl,1)="0"
Return "sechzig"
Else
Return toString(Right(zahl,1))+"undsechzig"
EndIf
Case "7"
If Right(zahl,1)="0"
Return "siebzig"
Else
Return toString(Right(zahl,1))+"undsiebzig"
EndIf
Case "8"
If Right(zahl,1)="0"
Return "achzig"
Else
Return toString(Right(zahl,1))+"undachzig"
EndIf
Case "9"
If Right(zahl,1)="0"
Return "neunzig"
Else
Return toString(Right(zahl,1))+"undneunzig"
EndIf
End Select
End Select
Else
Select Len(zahl)
Case 3
Return toString(Left(zahl,1))+"hundert"+toString(Right(zahl,2))
Case 4
Return toString(Left(zahl,1))+"tausend"+toString(Right(zahl,3))
Case 5
Return toString(Left(zahl,2))+"tausend"+toString(Right(zahl,3))
Case 6
Return toString(Left(zahl,3))+"tausend"+toString(Right(zahl,3))
Case 7
Select Left(zahl,1)
Case "1"
Return "einemillion"+toString(Right(zahl,6))
Default
Return toString(Left(zahl,1))+"millionen"+toString(Right(zahl,6))
End Select
Case 8
Return toString(Left(zahl,2))+"millionen"+toString(Right(zahl,6))
Case 9
Return toString(Left(zahl,3))+"millionen"+toString(Right(zahl,6))
Default
Return "zahl zu lange!"
End Select
EndIf
EndIf
End Function


Das wars vorerst einmal, ich melde mich wieder zurück, wenn ich etwas Sinnvolles zu zeigen habe. Bis dahin wünsche ich frohe Ostern.

MfG,
Darth

Kunterbuntes Allerlei

Sonntag, 28. Februar 2010 von darth
Hallo,

ich bin aus den Ferien zurück und habe Geschenke mitgebracht. Naja, nicht wirklich. Aber ich habe ein wenig gearbeitet, es ist erstaunlich wie produktiv man nach einem Tag Skifahrens ist, wenn man kein Internet zur Verfügung hat um sich abzulenken.

TMatrix:

Bei der Arbeit habe ich gleich einige Fehler gefunden und korrigiert, die grössten Änderungen sind in der TMatrix Klasse geschehen, hier die Punkte:

* CG Verfahren dividiert durch norm(b), bei einem homogenen GlgSystem (also b=0) gibt das NaN Werte, das fiel mir erst sehr spät auf. Ausserdem ist die Lösung dann trivial, x=0. Korrigiert.

* CG Verfahren hatte zwei unnötige Funktionen (tMSpecialMult und tMSpecialDiv), die ich jetzt durch tMGetValue äquivalent ersetzt habe. Halte ich für eleganter. Geändert.

* CholStd teilt Werte durch kk, ist dieser gleich 0, gibt es NaN Werte, kam selten vor, aber gibt es, die Zerlegung wird hier einfach als ungültig erklärt. Korrigiert.

* Die TMatrix Funktionen waren alle ausgelagert in Funktionen, die direkt den Array bearbeiten, alles ging also über zwei Ecken, das ist eine zuviel, also habe ich die abgeschafft. Geändert

* Der Gauss Algorithmus ist (inkl. LU Zerlegung) nun in die TMatrix Methodik integriert.

Die TMatrix Klasse (also das BB Äquivalent dazu, sprich alle Funktionen und Types) kann hier heruntergeladen werden. Die Datei steht zur freien Verwendung zur Verfügung, eine kleine Randnotiz bei solcher wäre nett, ist aber nicht nötig. Allgemein wird keine Haftung bei der Verwendung übernommen.

Inverse Kinematik:

So, desweiteren habe ich ein wenig herumgespielt mit dem IKSolver und musste feststellen, dass ich damit ziemlich schnell an Grenzen stosse. Ein Versuch war, ein paar Beine automatisch laufen zu lassen, aber das scheiterte kläglich. Als nächstes wollte ich sehen, wie es funktioniert wenn man nur einen Teil der Bewegung automatisiert, das Greifen nach einem Gegenstand zum Beispiel. Es entstand der Climber Versuch. Aber auch der scheiterte. ... Ich geb das vorläufig mal auf. Ich muss wohl einen Mix zwischen Animationsscript und automatischem IK versuchen.

user posted image

Ich habe mir überlegt die beiden Beispiele hier als Code oder Executable reinzustellen, aber ich habe mich dagegen entschieden, es bringt nicht viel, und verschwendet Platz auf meinen Worklog. Also müsst ihr mir wohl glauben, dass es nicht funktioniert, ich enthalte euch das willentlich vor! :>

Numerische Routinen:

Nach diesen Fehlschlägen, wollte ich etwas machen, von dem ich weiss, dass es funktioniert. Also habe ich mein Numerik Script (ehrlich, das Fach ist genial!) und die Übungen genommen und die Dinge nachgeschrieben. Einige davon habe ich hier schon einmal vorgestellt. Herausgekommen ist diese Sammlung von Funktionen. Die Verwendung ist meist so, dass man die Funktionen einsetzen muss, um sie verwenden zu können. Hier ein Beispiel:

Code: [AUSKLAPPEN]
Function IntF#(x#)
   Return x^3+x^2+x+1
End Function

print Integrate(0,1)


Dieses Beispiel integriert die Funktion x^3+x^2+x+1 im Intervall (0,1). Die anderen Funktionen funktionieren im Prinzip gleich. Mir ist bewusst, dass dies ziemlich umständlich gelöst ist, aber BlitzBasic bietet leider keine Funktionspointer die man da übergeben könnte :/ So beschränken sich die Integration, Ableitung und Nullstellensuche auf lediglich eine Funktion, wenn man sie auf mehrere anwenden möchte, muss man sie mehrmals schreiben, relativ dämlich, ich weiss. Was allerdings universell anwendbar ist, ist die Interpolation. Parameter sind eine Liste von Punkten (x und y Werte) und dazu noch die Anzahl (weil BB keine dynamischen Arrays als Funktionsparameter unterstützt) und den Punkt, den man interpoliert haben möchte, und der Wert wird geliefert (X -> Y). Wenn man das über die ganze Bildschirmbreite macht, kriegt man einen Graphen, wie hier:

user posted image

Turtle:

Aus reinem Interesse habe ich angefangen, eine "BlitzBasic Turtle" zu schreiben. Bei unserem Schulsystem war es der Brauch, dass man, nimmt man den Informatikkurs, Java lernt, und zwar mit der Turtle Klasse. Damit kann man ziemlich viel lustigen Unsinn zeichnen. Ich habe mal damit angefangen und eine gewisse Grundstruktur geschrieben. Ergebnis ist hier zu finden. Die verschiedenen Fraktale die ich bereits geschrieben habe, sind u.a Kochkurve, Drachenkurve,.. usw. Hier eine Zusammenstellung der verschiedenen (momentanen) Möglichkeiten:

user posted image

Eigentlich war es das Ziel, die Turtle mit einem Script zu verbinden. Allerdings hat sich das als viel umständlicher herausgestellt als ich dachte, darum habe ich das aufgegeben. Das grösste Problem ist, Funktionen einzubinden, ich habe momentan absolut keinen Ansatz wie ich das machen soll. Aber hei, ich war nicht untätig in dieser Hinsicht. Ich habe aus einer meiner älteren Scriptsprachen Versuche den Stringparser ausgegraben und erneuert, verbessert, korrigiert. Das Ergebnis teile ich gerne mit der Bevölkerung, siehe hier:

BlitzBasic: [AUSKLAPPEN]
;**********
;
; Syntax-Erklärung:
; -----------------
;
; Term$ = "1+2+3+4"
; normale Rechnungen gehen wie gewohnt
;
; Term$ = "1+2*3+4"
; Punkt vor Strich, rechnet sich also '1+(2*3)+4'
;
; Term$ = "1+-2"
; Vorzeichen funktionieren, wird zu '1-2'
;
; Term$ = "a+2"
; Variabeln sind möglich, werden aus dem varStack geholt,
; sollten zur Sicherheit nur mit newVar() erstellt werden
;
; Typ-Erklärung:
; 1 = Integer
; 2 = Float
; 3 = String (hier nicht verwendet -> fehler)
;
; Term$ = "a[3]+3"
; Arrays sind möglich, werden aus dem varStack geholt,
; sollten zur Sicherheit nur mit newVar() erstellt werden
;
; Anm: Arrays sind beliebig erweiterbar, allerdings müssen alle Einträge von Hand erstellt werden
; es gibt keine 'newArray()' Funktion. Einfach 'newVar("a[0]",..)' etc aufrufen.
;
; Typ entspricht dem normalen Variabeltypen
;
; Term$ = "sin[30]"
; Gewisse Grundfunktionen (sin, cos, sqr) sind integriert,
; momentan nicht erweiterbar
;
; Achtung: keine Runden Klammern!
; Typ wird zu Float-Rechnung geändert
;
;**********

Global varStack.TVar[10]
Global stackIndex=0

Type TVar
Field Name$
Field Wert$
Field Typ

Field Succ.TVar
End Type

Function newVar.TVar(Name$, Wert$, Typ)
Local V.TVar, Pos1, Pos2, VNew.TVar

V=findVar(Name)
If V<>Null
DebugLog "Variable already in use"
Return
EndIf

If Instr(Name$,"[")
Pos1=Instr(Name$,"[")
Pos2=Instr(Name$,"]")
Name$=Left(Name$,Pos1-1)+"{"+jSubString(Name$,Pos1,Pos2)+"}"+jSubString(Name$,Pos2,Len(Name$)+1)
EndIf

VNew=New TVar
VNew\Name$=Name$
VNew\Wert$=Wert$
VNew\Typ=Typ

V=varStack[stackIndex]
If V=Null
varStack[stackIndex]=VNew
Else
While V\Succ<>Null
V=V\Succ
Wend
V\Succ=VNew
EndIf
End Function

Function findVar.TVar(Name$)
Local Pos1, Pos2, V.TVar

If Instr(Name$,"[") And Instr(Name,"]")
Pos1=Instr(Name,"[")
Pos2=Instr(Name,"]")
Name=Left(Name,Pos1-1)+"{"+parse(jSubString(Name,Pos1,Pos2))+"}"+jSubString(Name,Pos2,Len(Name)+1)
EndIf

V=varStack[stackIndex]
While V<>Null
If Lower(V\Name)=Lower(Name)
Return V
EndIf

V=V\Succ
Wend

Return Null
End Function

Function parse$(Term$)
Local mS$[7], Char$, Char2$, Char3$, StartB, StopB, cOpen, FoundPos, StartF, StopF

mS[0]="+"
mS[1]="-"
mS[2]="*"
mS[3]="/"
mS[4]="["
mS[5]="]"
mS[6]="("
mS[7]=")"

;punkt vor strich
; ersetze multiplikationen durch klammer terme
For i=1 To Len(Term)
Char=Mid(Term,i,1)

If Char="*" Or Char="/"
StartB=-1

For j=i-1 To 1 Step -1
Char2=Mid(Term,j,1)

For k=0 To 7
If Char2=mS[k]
StartB=j
EndIf
Next

If StartB>=0
Exit
EndIf
Next

If StartB<0
StartB=0
EndIf

If Mid(Term,StartB+1,1)="*" Or Mid(Term,StartB+1,1)="/"
FoundPos=False

Repeat
StartB=StartB-1
Char2=Mid(Term,StartB,1)

For k=0 To 3
If Char2=mS[k]
FoundPos=True
cOpen=0

For i2=StartB To i
Char3=Mid(Term,i2,1)
If Char3="(" Or Char3="["
cOpen=cOpen+1
EndIf
If Char3=")" Or Char3="]"
cOpen=cOpen-1
EndIf
Next

If cOpen<>0
FoundPos=False
EndIf
EndIf
Next
Until StartB<2 Or FoundPos=True
EndIf

If StartB<2
StartB=0
EndIf

StopB=-1

For j=i+1 To Len(Term)
Char2=Mid(Term,j,1)

If Char2="-" And j=i+1
j=j+1
Char2=Mid(Term,j,1)
EndIf

For k=0 To 7
If Char2=mS[k]
StopB=j
EndIf
Next

If StopB>=0
Exit
EndIf
Next

If StopB<0
StopB=Len(Term)+1
EndIf

If Mid(Term,StopB-1,1)="*" Or Mid(Term,StopB-1,1)="/" Or Mid(Term,StopB,1)="["
FoundPos=False

Repeat
StopB=StopB+1
Char2=Mid(Term,StopB,1)

For k=0 To 3
If Char2=mS[k]
FoundPos=True
cOpen=0

For i2=i To StopB
Char3=Mid(Term,i2,1)

If Char3="(" Or Char3="["
cOpen=cOpen+1
EndIf

If Char3=")" Or Char3="]"
cOpen=cOpen-1
EndIf
Next

If cOpen<>0
FoundPos=False
EndIf
EndIf
Next
Until StopB>Len(Term) Or FoundPos=True
EndIf

If StopB>Len(Term)+1
StopB=Len(Term)+1
EndIf

Term=Left(Term,StartB)+"("+jSubString(Term,StartB,StopB)+")"+jSubString(Term,StopB-1,Len(Term)+1)

If StartB<i
i=i+1
EndIf
EndIf
Next

;klammer vor rest
; ersetze klammerterme durch die resultate
For i=1 To Len(Term)
Char=Mid(Term,i,1)

If Char="("
StartB=i
EndIf

If Char=")"
StopB=i
Term=Left(Term,StartB-1)+calculate(jSubString(Term,StartB,StopB))+jSubString(Term,StopB,Len(Term)+1)
i=0
EndIf

If Char="["
StartF=i
EndIf

If Char="]"
StopF=i
Term=Left(Term,StartF-1)+"{"+calculate(jSubString(Term,StartF,StopF))+"}"+jSubString(Term,StopF,Len(Term)+1)
i=0
EndIf
Next

Return calculate(Term)
End Function

Function calculate$(Term$)
Local mS$[3], Pos, Char$, Char2$, iTyp, cTyp, Typ, FirstOperation, Resultat$, Rechts$, V.TVar

mS[0]="+"
mS[1]="-"
mS[2]="*"
mS[3]="/"

Term="0+"+Term+"+"

For i=1 To Len(Term)-1
If Mid(Term,i,1)="+" And Mid(Term,i+1,1)="-"
Term=Left(Term,i-1)+"-"+jSubString(Term,i+1,Len(Term)+1)
EndIf

If Mid(Term,i,1)="-" And Mid(Term,i+1,1)="-"
Term$=Left(Term,i-1)+"+"+jSubString(Term,i+1,Len(Term)+1)
EndIf

If Mid(Term,i,1)="+" And Mid(Term,i+1,1)="+"
Term$=Left(Term,i-1)+"+"+jSubString(Term,i+1,Len(Term)+1)
EndIf

If Mid(Term,i,1)="*" Or Mid(Term,i,1)="/"
If Mid(Term,i+1,1)="-"
Pos=0

For i2=i-1 To 1 Step -1
Char2=Mid(Term,i2,1)

For k=0 To 3
If Char2=mS[k]
Pos=i2
EndIf
Next

If Pos>0
Exit
EndIf
Next

Term=Left(Term,Pos)+"-"+jSubString(Term,Pos,i+1)+jSubString(Term,i+1,Len(Term)+1)
i=0
EndIf
EndIf
Next

iTyp=1

FirstOperation=0
cTyp=-1

For i=1 To Len(Term)
Char=Mid(Term,i,1)
Typ=-1

For k=0 To 3
If Char=mS[k]
If Not (Mid(Term,i-1,1)="{" And Mid(Term,i,1)="-")
Typ=k
FirstOperation=1
EndIf
EndIf
Next

If Typ=-1
If FirstOperation=0
Resultat=Resultat+Char
Else
Rechts=Rechts+Char
EndIf
Else
If cTyp>=0
If Instr(Rechts,".")
dez=Int(Mid(Rechts,Instr(Rechts,".")+1,Len(Rechts)))
If dez<>0
iTyp=0
EndIf
EndIf

;funktionen wären eine tolle ergänzung

If Len(Rechts)>4
If Lower(Left(Rechts,4))="sin{"
Rechts$=Sin(Float(jSubString(Rechts,Instr(Rechts,"{"),Instr(Rechts,"}"))))
iTyp=0
EndIf
EndIf

If Len(Rechts)>4
If Lower(Left(Rechts,4))="cos{"
Rechts=Cos(Float(jSubString(Rechts,Instr(Rechts,"{"),Instr(Rechts,"}"))))
iTyp=0
EndIf
EndIf

If Len(Rechts)>4
If Lower(Left(Rechts,4))="sqr{"
Rechts=Sqr(Float(jSubString(Rechts,Instr(Rechts,"{"),Instr(Rechts,"}"))))
iTyp=0
EndIf
EndIf

Select cTyp
Case 0
Resultat=Float(Resultat)+getValue(Rechts)
Case 1
Resultat=Float(Resultat)-getValue(Rechts)
Case 2
Resultat=Float(Resultat)*getValue(Rechts)
Case 3
Resultat=Float(Resultat)/getValue(Rechts)
End Select

V=findVar(Rechts)
If V<>Null
If V\Typ=2
iTyp=0
EndIf
EndIf

Rechts=""
EndIf

cTyp=Typ
EndIf
Next

If iTyp=1
Return Int(Resultat)
EndIf

Return Resultat
End Function

Function getValue#(Term$)
Local V.TVar

Term=Lower(Term)

For i=48 To 57
If Left(Term,1)=Chr(i)
Return Float(Term)
EndIf
Next
If Left(Term,1)="-"
Return Float(Term)
EndIf

V=findVar(Term)
If V<>Null
Select V\Typ
Case 1
Return Int(V\Wert)
Case 2
Return Float(V\Wert)
Default
DebugLog "Cannot calculate"
Return 0
End Select
EndIf

DebugLog "Variable not found: "+Term
Return 0
End Function

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

AppTitle "String Parser"

Print "Normal Calculations:"
Print " parse("+Chr(34)+"-3+-4*-3"+Chr(34)+")"
Print " = "+parse("-3+-4*-3")
Print

Print "Function Calculations:"
Print " parse("+Chr(34)+"-sin[3*4+1]*3"+Chr(34)+")"
Print " = "+parse("-Sin[3*4+1]*3")
Print

newVar("a", 3, 1)
newVar("b", 14, 1)
Print "Variable Calculations:"
Print " newVar("+Chr(34)+"a"+Chr(34)+", 3, 1)"
Print " newVar("+Chr(34)+"b"+Chr(34)+", 14, 1)"
Print " parse("+Chr(34)+"a*3+b"+Chr(34)+")"
Print " = "+parse("a*3+b")
Print

Print "Combination of all:"
Print " parse("+Chr(34)+"-sin[a+b*-3]*5--6*9"+Chr(34)+")"
Print " = "+parse("-sin[a+b*-3]*5--6*9")

WaitKey()


Wie immer ist der Code zur freien Verwendung freigegeben, und wie üblich übernehme ich keine Haftung für was auch immer damit angestellt wird. Die Korrektheit ist von mir überprüft, aber nicht im Generellen gewährleistet - nur eine faire Warnung. Eine Erwähnung der Codeherkunft wäre freundlich, ist aber nicht zwingend. Falls jemand Fehler findet bin ich imer gerne bereit, darüber zu reden und werde versuchen sie zu korrigieren. Wer eine schöne Veränderung einbaut kann mir das sagen, dann werde ich sehen, dass ich das hier einbauen kann.
Und zum Abschluss des Themas noch ein kleines Bild einiger Versuche zum Test der Korrektheit der Methodik. Siehe hier:

user posted image

DaDaPhysics:

Zum schluss kann ich erwähnen, dass ich die DaDaPhysik wohl vorläufig auf dem momentanen Stand belasse. Ich habe sie in Java etwas erweitert, um verschiedene Verbindungsmethoden (Federn und Nieten momentan), und da funktioniert es so schön, dass ich die neuen Objekte von der alten Body Klasse ableiten kann, und dann in den gleichen Verwaltungsarray aufnehmen kann (inkl Methoden überschreibung). Bevor ich in BB das weiterziehe, brauche ich eine Möglichkeit soetwas ähnliches zu machen. Ich suche eine bessere Methode als 5 verschiedene ArrayListen mitzuschleppen, das gefällt mir einfach nicht. Und weil das momentan nicht wirklich geht, ist auch die BB-Version des Spiels vorläufig auf Eis gelegt, ich entwickle momentan lieber in Java.
Weiterer Fortschritt diesbezüglich wird aber wohl nicht hier zu finden sein, ich will die Gutmütigkeit der Forenmoderation nicht überreizen indem ich hier weiter von Java schwärme. Es ist ja schliesslich ein BlitzBasic Forum.

So, ich glaube der Eintrag ist lange genug, ich höre hier mal auf.
MfG,
Darth

Numerik ist super

Samstag, 13. Februar 2010 von darth
Hallo,

wer mit meinem letzten Eintrag nichts anfangen konnte, kann jetzt theoretisch aufhören zu lesen (oder zum Ende springen und dort weiterlesen, your call). In diesem Worklog werde ich noch einmal gewisse numerische Methoden behandeln, die ich im Verlaufe meines Studiums aufgeschnappt habe und nun mit meiner überraschend flexiblen Matrixklasse in BB gelöst habe.

Reboot, TMatrix
Ich poste nicht nochmal den Code, aber ich habe gewisse Methodennamen geändert und einige hinzugefügt. Das Ergebnis ist downloadbar, und zwar hier.

Cholesky Zerlegung
Die Cholesky Zerlegung zerlegt eine Matrix A in zwei Matrizen L und L', so dass gilt: L*L' = A, wobei L' die Transponierte von L ist. Das funktioniert nur für Matrizen, die symmetrisch und positiv definit (kurz SPD) sind. Allerdings gibt es möglichkeiten, die Zerlegung zu modifizieren, so dass man jegliche Matrizen zerlegen kann, allerdings werden diese Verändert und das Ergebnis ist der Art A+R = L*L', wobei R ein Vielfaches der Identitätsmatrix ist.
Wozu das Prozedere? Die modifizierte Cholesky Zerlegung wird dafür gebraucht, beliebige Matrizen in möglichst ähnliche SPD Matrizen zu verwandeln. Ich mache das, damit ich bei meiner CG Iteration keine Probleme bekomme (obwohl das, wie sich im Anschluss herausgestellt hat überflüssig ist..)

Hier vorerst zwei Beispiele. Das erste ist eine SPD Matrix, die Zerlegung funktioniert und R ist die Nullmatrix, das heisst L*L'=A. Das zweite ist eine beliebige Matrix und R ist etwa 12*I, ziemlich ungenau, allerdings konzentriert sich der "Schaden" auf die Diagonale und verteilt sich nicht auf die gesamte Matrix.

user posted image

Den Code dazu kann man sich hier herunterladen. Im Anhang nun noch das linke Beispiel, um aufzuzeigen, wie der Code einzusetzen ist.

BlitzBasic: [AUSKLAPPEN]
Include "CholMod.bb"

A.TMatrix=tMCreateMatrix(4,4)
tMSetValue(A, 10, 1,1) : tMSetValue(A, 5, 1,2) : tMSetValue(A, 0, 1,3) : tMSetValue(A, 5, 1,4)
tMSetValue(A, 5, 2,1) : tMSetValue(A, 7, 2,2) : tMSetValue(A, 4, 2,3) : tMSetValue(A, 6, 2,4)
tMSetValue(A, 0, 3,1) : tMSetValue(A, 4, 3,2) : tMSetValue(A, 11, 3,3) : tMSetValue(A, 8, 3,4)
tMSetValue(A, 5, 4,1) : tMSetValue(A, 6, 4,2) : tMSetValue(A, 8, 4,3) : tMSetValue(A, 42, 4,4)

Print "A="
tMPrint A
Print ""

Print "L="
L.TMatrix=CholMod(A)
tMPrint L
Print ""

Print "L*L'="
test.TMatrix=tMMultiply(L, tMTranspose(L))
tMPrint test
Print ""

Print "A-L*L'="
test2.TMatrix=tMSubtract(A, test)
tMPrint test2


Das Beispiel erinnert mich daran, dass ich noch einen Parser für Matrizen schreiben wollte, irgendetwas das Strukturen wie ' A=[1,2,3;4,5,6;7,8,9] ' automatisch in eine TMatrix umwandelt (natürlich über Strings, nicht so "nackt" möglich). Oh well, kommt für ein andermal und wird wohl nur eine kurze Erwähnung geben und ein stillschweigendes Update der TMatrix Klasse auf dem Server.
Und nun zum Grund, weshalb ich die Choleskyzerlegung überhaupt implementiert habe.

CG Verfaren
Das CG Verfahren habe ich im letzten Worklog schon vorgestellt, deshalb mache ich das hier nicht nochmal.
Bei diesem Verfahren ergaben sich einige Implementierungsprobleme. BlitzBasic hatte die Tendenz, das ganze System zu verbarrikadieren, so dass nur noch ein Ziehen des Stromsteckers (oder Drücken des PowerKnopfs) geholfen hat. Ich kam lange nicht dahinter woran es lag, bis mir einfiel, dass BB keinen GC hat, und die Iteration je nach gesetzter maximaler Iterationszahl ziemlich lange laufen kann (und ich hatte die auf etwa 10000), was etliche TMatrix Instanzen bedeutet, und das überlastet den Speicher. Darum habe ich irgendwann beschlossen, in jeder Iteration den GC laufen zu lassen, das macht das Verfahren langsamer, aber stabiler (und ich habe keine Lust all 5min den Computer neu zu starten!). Wem das nicht gefällt, kann einfach den Teil von ';cleanup' bis 'Next' löschen.

Code dazu gibt es hier (diesmal kein Beispiel dazu):

BlitzBasic: [AUSKLAPPEN]
Include "TMatrix.bb"

; TMatrix CG, liefert die Lösung x aus dem GlgSys A*x=b,
; A muss SPD sein
;
; A: TMatrix, Matrix des GlgSys
; b: TMatrix, Ergebnis des GlgSys
; x0: TMatrix, Startwert der Iteration, stdmässig auf 0 gesetzt
; tol: Float, Toleranz zum Abbruch der Iteration
; IterMax: Int, maximale Anzahl an Iterationen
Function CG.TMatrix(A.TMatrix, b.TMatrix, x0.TMatrix, tol#=0.01, IterMax=100)
Local x.TMatrix, r.TMatrix, p.TMatrix, relres#, TMP.TMatrix, alpha.TMatrix, rOld.TMatrix, beta.TMatrix, normB#, L.TMatrix

If x0=Null
x0=tMCreateMatrix(A\n,1)
EndIf

;Könnte man dazwischenschalten
; um sicherzustellen, dass A SPD

;Include "CholMod.bb"
;
;L=CholMod(A)
;A=tMMultiply(L, tMTranspose(L))

x=x0
normB=norm(b)
r=tMSubtract(b,tMMultiply(A,x))
p=tMClone(r)
relres=norm(r)/normB

For k=1 To IterMax
If relres<tol
Exit
EndIf

TMP=tMMultiply(A,p)

alpha=tMSpecialDiv( tMMultiply(tMTranspose(r),r) , tMMultiply(tMTranspose(p),TMP) )

x=tMAdd(x,tMSpecialMult(alpha,p))

rOld=tMClone(r)
r=tMSubtract(r,tMSpecialMult(alpha,TMP))

beta=tMSpecialDiv( tMMultiply(tMTranspose(r),r) , tMMultiply(tMTranspose(rOld),rOld) )
p=tMAdd(r,tMSpecialMult(beta,p))

relres=norm(r)/normB

;cleanup
tmpAFlag=A\flag
tmpBFlag=b\flag

A\flag=True
b\flag=True
x\flag=True
r\flag=True
p\flag=True

tMGC()

A\flag=tmpAFlag
b\flag=tmpBFlag
x\flag=False
r\flag=False
p\flag=False
Next

Return x
End Function

; Float norm, liefert die Norm eines Vektors x
;
; x: TMatrix, der Vektor
Function norm#(x.TMatrix)
Local sum#

;für vektoren, x=R^{n,1}
For i=1 To x\n
sum=sum+Abs(tMGetValue(x, i,1))
Next

Return Sqr(sum)
End Function

; TMatrix tMSpecialDiv, dividiert zwei 1x1 Matrizen
;
; A,B: TMatrix, Dividend und Divisor, beides 1x1 Matrizen
Function tMSpecialDiv.TMatrix(A.TMatrix, B.TMatrix)
Local R.TMatrix=New TMatrix

R\n=1
R\m=1

;funktioniert nur falls A=R^{1,1} und B=R^{1,1}
tMSetValue(R, A\e[0] / B\e[0], 1,1)

Return R
End Function

; TMatrix tMSpecialMult, multipliziert eine 1x1 Matrix mit einer nxm Matrix
;
; a: TMatrix, eine 1x1 Matrix, ein Skalar
; B: TMatrix, eine beliebige Matrix, wird mit a skaliert
Function tMSpecialMult.TMatrix(a.TMatrix, B.TMatrix)
Local R.TMatrix=New TMatrix

R\n=B\n
R\m=B\m

;für a ein "float"
For i=1 To B\n
For j=1 To B\m
tMSetValue(R, a\e[0] * B\e[GetI(i,j,B\n,B\m)], i,j)
Next
Next

Return R
End Function


Und num zum Grund, warum ich das CG Verfahren implementiert habe.

IK Solver
Ich habe es geschafft. Ein (relativ, mehr dazu gleich) stabiler Lösungsalgorithmus für invers kinematische Probleme. Die Erklärung dazu liegt ein paar Worklogeinträge zurück, in Eintrag Nummer 5. Damals habe ich die Stellungen mit wildem Probieren gelöst, was zu Hicksern im Programm führte, weil die Lösung mal länger, mal kürzer brauchte. Mit der neuen eher analytischen Methode geschieht das nichtmehr, die Zeiten pendeln zwischen 0 und 2 Millisekunden, und das ist doch ziemlich brauchbar meine ich.
So, der Algorithmus ist nicht ohne Schwächen. Anfangs hatte ich das Problem, dass sich der Löser immer aufgehängt hat (Grund: CG), weil ich 1000 Iterationen da und 10000 Iterationen im CG hatte, und die "Break"-Bedingung ziemlich flapsig war. Das heisst ich hatte am Schluss etwa 23 Millionen TMatrizen, ein totes System und viel Frust. Also habe ich auch hier angefangen, den GC mitzuschleppen. Dies schlägt sich nicht wirklich in der Lösungszeit nieder, von daher kann man das wohl so belassen.
Das zweite Problem ist ziemlich sonderbar, zum Teil kommt es vor, dass der Arm eine Endstellung einnimmt, die überhaupt nichts mit der Lösung zu tun hat, klickt man dann nochmal auf den gleichen Punkt, wird die Stellung korrigiert, wenn man dann nochmal dorthin klickt, macht er wieder etwas völlig absurdes. Ich vermute, dass dies an der Anfangskonstellation liegt und sich der Algorithmus dann irgendwie "verirrt", aber ich bin dem Phänomen noch nicht auf die Spur gekommen.

Der Code dazu ist hier. Ein Bild dazu mache ich diesmal nicht, weil es einfach wieder ein Arm in einer lustigen Stellung wäre. Obwohl, wieso eigentlich nicht, ist bisher arg viel Text ohne irgendwas, das den Lesefluss unterbrechen würde, das muss geändert werden!
PS: Rechtsklick macht neue Segmente, Linksklick setzt einen Endpunkt und startet den Lösungsalgo.

user posted image

Und nun zu etwas ganz anderem. (BladeRunner, bitte aufhören zu lesen *hust*).

Ganz etwas anderes
Mir ist bewusst, dass dies ein BlitzBasic Forum ist, aber auch hier gibt es eine Kategorie die sich "Smalltalk" und "Andere Programme und Tools" nennt, also darf ich tas *trotz*.
Wie man vielleicht weiss, arbeite ich an einem Spiel, das die titelgebende Physikroutine benutzt (oder benutzen soll), auch die IK-Routine soll verwendung finden, vor allem bei der Steuerung der Figuren, wie genau das gehen wird, muss ich noch genauer überlegen, es stehen bisher nur grobe Konzepte. Wie dem auch sei, ich habe in letzter Zeit etwas mit Java experimentiert (GridBagLayout ist ehrlich gesagt ziemlich mies! Das könnte ein Zweijähriger in 5 Minuten besser machen. Aber Faulheit hat seinen Preis.) und einen Leveleditor geschrieben, mit dem ich zukünftig gedenke, Level für mein Spielchen zu basteln (und darum darf ich das hier hoffentlich reinstellen, falls nicht -> HL im Chat und dieses Kapitel verschwindet spurlos). Der Editor ist noch ziemlich experimentell, ich habe bisher ein paar Objektmöglichkeiten drin, die dann auch von der (nicht existierenden) Spiele Verwaltungsmaschine verstanden werden sollen, so wie explodierende Fässer (man erinnere sich an die PseudoVoronoi-Zerlegung vom vorletzten Worklog), Kisten die man verschieben kann um höher klettern zu können, natürlich Wände und andere unbewegliche Hindernisse.
Wer will kann damit herumexperimentieren und mir per PN oder Comments hier ein Level senden, allerdings ist es (noch) nicht empfehlenswert, da ich selber noch nicht genau weiss, wie ich das Spiel aufbauen will und von daher zuerst viele Levelideen verwerfen werde, bis ich einen Stil finde, der mir gefällt. Das Ganze soll prinzipiell auf den ersten Versuchen von Angry Barbarian Knights aufbauen.

Download hier. Und ein dazugehöriger Screenshot:

user posted image

Ebenfalls eine kleine weitere (Java)Neuerung in der Physik ist, dass nun probeweise "Springs" (also Federn) eingebaut sind. Allerdings spielen die noch verrückt, wenn ich versuche, die Winkelgeschwindigkeit zu ändern, von daher spicken die Objekte bisher einfach ungedreht an der Feder herum, weil sie sonst wie ein Propeller kreiseln bis sie sich übergeben. Davon gibts noch keine Downloads oder Screens, denn dies ist das

Ende!
MfG,
Darth

Matrizen und mehr

Freitag, 29. Januar 2010 von darth
Hallo,

Vor ein paar Einträgen habe ich über eine Methode zur Berechnung eines kinematischen Roboterarmes geschrieben. Dort habe ich auf das Problem hingewiesen, dass ich es nicht analytisch lösen konnte, da ich Probleme mit dem Lösen des Gleichungssystems hatte (singuläre Matrizen und solche Unannehmlichkeiten).
Diesen Fehler konnte ich mittlerweilen lösen, indem ich auch das Gleichungssystem für den Iterationsschritt nicht rein analytisch sondern ebenfalls numerisch löse. Dazu verwendet ich das CG-Verfahren. Das ändert den Algorithmus gering ab, zu

Code: [AUSKLAPPEN]
for k=1:inf
        J = JacobiMatrix von f
        b = J'*(-f);
        A = J'*J;
       
        dPhi = CG(A,b); %<<< CG statt LU
        Phi = Phi+dPhi;
       
        if ||f||<TOL
            break
        end
end


So, das erwähnte CG-Verfahren ist vom Prinzip her auch keine grosse Hexerei. Es ist eine Iteration zur Lösung von linearen Gleichungssystemen. Die Matrix A muss dabei SPD sein, dann ist das Problem A*x=b äquivalent zur Minimierungsaufgabe f(x)=1/2 * x^T*A*x - x^T*b. Dieses Verfahren ist ziemlich verbreitet und relativ einfach zu implementieren. Zur Problematik des Ganzen komme ich gleich, hier erstmal der Pseudocode dazu:

Code: [AUSKLAPPEN]
% Gleichungssystem: A*x = b

x = x0;     %Startwert
r=b-A*x;  %Residuum
p=r;         %Suchrichtung
relres=||r|| / ||b||; %relatives Residuum

while relres>TOL
        Tmp = A*p;

        alpha = (r' * r) / (p' * Tmp) %Schrittweite
        x = x+alpha*p;                   %Iterationsschritt

       rOld = r;
       r = r-alpha*Tmp; %neues Residuum

       beta = (r' * r) / (rOld' * rOld); %Faktor für Suchrichtung
       p = r+beta*p;                         %neue Suchrichtung

       relres = ||r|| / ||b||;
end


Die Kombination dieser beiden Verfahren funktioniert umstandslos und liefert in angenehm kurzer Zeit relativ gute Ergebnisse. Es gibt allerdings relativ sonderbare Endstellungen, wenn das Ziel nicht erreichbar ist, das sollte man vielleicht abfangen und eine lineare Streckung zum Ziel hin versuchen. Aber für Ziele die im Umkreis der Armlänge liegen gibt es wunderbar genaue Ergebnisse, hier ein Beispiel dazu.

user posted image

So, damit das Ganze nicht nur blanke Theorie bleibt, sondern auch noch einen Bezug zu BlitzBasic erhält sei hier folgendes erwähnt: Diese Methodik ist zwar schön und gut, aber eine unglaubliche Pein zur Umsetzung in BB, das liegt daran, dass stets mit Matrizen gerechnet wird. BB hat da ziemliche Probleme damit und auch die Arrayverwaltung ist meiner Meinung nach nicht optimal und nicht wirklich für dieses Vorhaben geeignet. Also musste ich mir etwas eigenes schreiben.
Ich habe mich deshalb heute Abend hingesetzt und eine Matrixklasse geschrieben, diese hat einen Type TMatrix, der in einem Feld einen eindimensionalen 1D-Array hat, mittels einer Umrechnung von 2D->1D kann man diesen als Matrix verwenden. Zur einfacheren Verwendung habe ich Setter und Getter geschrieben. Die Matrixklasse hier:

BlitzBasic: [AUSKLAPPEN]
;--- Erklärung ---

; +-----> j
; |
; | R^{n x m}
; |
; v i
;
; A_{i,j}

;---**********---

;--- Matrizenverwaltung ---

; Int GetI, liefert den Index des Matrixeintrags im 1D-Matrixarray zurück
;
; i,j: Int, Indizes des Matrizeneintrags, beginnend bei 1/1
; n,m: Int, Dimensionen der Matrix
Function GetI(i, j, n, m)
Return (i-1)*m+(j-1)
End Function

; Void SetValue, setzt einen Wert in die Matrix A, an Stelle i,j
;
; A: Float[], der 1D-Matrixarray (wird verändert)
; W: Float, der zu setzende Wert
; i,j: Int, Indizes des Matrizeneintrags, beginnend bei 1/1
; n,m: Int, Dimensionen der Matrix
Function SetValue(A#[1000], W#, i, j, n, m)
A[GetI(i,j,n,m)]=W
End Function

;---**********---

;--- Rechnungsmethoden ---

; Void MM_Multiply, multipliziert die Matrizen A und B, R=A*B
;
; R: Float[], das Resultat der Matrix (wird verändert)
; A: Float[], linke Seite der Multiplikation
; n1,m1: Int, Dimensionen von A
; B: Float[], rechte Seite der Multiplikation
; n2,m2: Int, Dimensionen von B
Function MM_Multiply(R#[1000], A#[1000], n1,m1, B#[1000], n2,m2)
If m1<>n2
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

Local n3, m3

n3=n1
m3=m2

For i=1 To n3
For j=1 To m3
For k=1 To m1
R[GetI(i,j,n3,m3)]=R[GetI(i,j,n3,m3)]+A[GetI(i,k,n1,m1)]*B[GetI(k,j,n2,m2)]
Next
Next
Next
End Function

; Void MM_Add, addiert die Matrizen A und B, R=A+B
;
; R: Float[], das Resultat der Matrix (wird verändert)
; A: Float[], linke Seite der Multiplikation
; n1,m1: Int, Dimensionen von A
; B: Float[], rechte Seite der Multiplikation
; n2,m2: Int, Dimensionen von B
Function MM_Add(R#[1000], A#[1000], n1,m1, B#[1000], n2,m2)
If n1<>n2
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

If m1<>m2
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

For i=1 To n1
For j=1 To m1
R[GetI(i,j,n1,m1)]=A[GetI(i,j,n1,m1)]+B[GetI(i,j,n2,m2)]
Next
Next
End Function

; Void MM_Subtract, subtrahiert die Matrix B von A, R=A-B
;
; R: Float[], das Resultat der Matrix (wird verändert)
; A: Float[], linke Seite der Multiplikation
; n1,m1: Int, Dimensionen von A
; B: Float[], rechte Seite der Multiplikation
; n2,m2: Int, Dimensionen von B
Function MM_Subtract(R#[1000], A#[1000], n1,m1, B#[1000], n2,m2)
If n1<>n2
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

If m1<>m2
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

For i=1 To n1
For j=1 To m1
R[GetI(i,j,n1,m1)]=A[GetI(i,j,n1,m1)]-B[GetI(i,j,n2,m2)]
Next
Next
End Function

; Void M_Transpose, transponiert Matrix A, R=A^T
;
; R: Float[], die Transponierte
; A: Float[], die zu Transponierende
; n1,m1: Int, Dimensionen von A
Function M_Transpose(R#[1000], A#[1000], n1,m1)
Local m2, n2

n2=m1
m2=n1

For i=1 To n1
For j=1 To m1
R[GetI(j,i,n2,m2)]=A[GetI(i,j,n1,m1)]
Next
Next
End Function

;---**********---

;--- TMatrix Funktionen ---

Type TMatrix
Field e#[1000]

Field n
Field m
End Type

; TMatrix tCreateMatrix, erstellt eine neue Matrix R und liefert diese zurück
;
; n,m: Int, die Dimensionen der Matrix R
Function tCreateMatrix.TMatrix(n, m)
Local R.TMatrix=New TMatrix

R\n=n
R\m=m

Return R
End Function

; Void tSetValue, Setzt einen Wert in die Matrix A an Stelle i,j
;
; A: TMatrix, die zu füllende Matrix
; W: Float, der zu setzende Wert
; i,j: Int, die Indizes
Function tSetValue(A.TMatrix, W#, i, j)
SetValue(A\e,W,i,j,A\n,A\m)
End Function

; Float tGetValue, liefert den Wert der Matrix an der Stelle i,j zurüc
;
; A: TMatrix, die Matrix
; i,j: Int, die Koordinaten
Function tGetValue#(A.TMatrix, i,j)
Return A\e[GetI(i,j,A\n,A\m)]
End Function

; TMatrix tMM_Multiply, Multipliziert 2 Matrizen A und B, liefert R=A*B zurück
;
; A,B: TMatrix, die Komponenten der Multiplikation
Function tMM_Multiply.TMatrix(A.TMatrix, B.TMatrix)
If A\m<>B\n
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

Local R.TMatrix=New TMatrix

R\n=A\n
R\m=B\m

MM_Multiply(R\e, A\e,A\n,A\m, B\e,B\n,B\m)
Return R
End Function

; TMatrix tMM_Add, Addiert 2 Matrizen A und B, liefert R=A+B zurück
;
; A,B: TMatrix, die Komponenten der Addition
Function tMM_Add.TMatrix(A.TMatrix, B.TMatrix)
If A\n<>B\n
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

If A\m<>B\m
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

Local R.TMatrix=New TMatrix

R\n=A\n
R\m=A\m

MM_Add(R\e, A\e,A\n,A\m, B\e,B\n,B\m)
Return R
End Function

; TMatrix tMM_Subtract, Subtrahiert Matrix B von A, liefert R=A-B zurück
;
; A,B: TMatrix, die Komponenten der Subtraktion
Function tMM_Subtract.TMatrix(A.TMatrix, B.TMatrix)
If A\n<>B\n
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

If A\m<>B\m
RuntimeError "Inner Matrix Dimensions must agree"
EndIf

Local R.TMatrix=New TMatrix

R\n=A\n
R\m=A\m

MM_Subtract(R\e, A\e,A\n,A\m, B\e,B\n,B\m)
Return R
End Function

; TMatrix tM_Transpose, Transponiert Matrix A, liefert R=A^T zurück
;
; A: TMatrix, die zu transponierende Matrix
Function tM_Transpose.TMatrix(A.TMatrix)
Local R.TMatrix=New TMatrix

R\n=A\m
R\m=A\n

M_Transpose(R\e, A\e,A\n,A\m)
Return R
End Function

;---**********---

;--- Debug/Output ---

; Void tDebug, schreibt eine Matix in den Debuglog
;
; A: TMatrix, die zu schreibende Matrix
Function tDebug(A.TMatrix)
Local txt$

For i=1 To A\n
txt=""
For j=1 To A\m
txt=txt+tGetValue(A,i,j)+" "
Next
DebugLog txt
Next
End Function

; Void tPrint, schreibt eine Matix auf den Bildschirm mit Print
;
; A: TMatrix, die zu schreibende Matrix
Function tPrint(A.TMatrix)
Local txt$

For i=1 To A\n
txt=""
For j=1 To A\m
txt=txt+tGetValue(A,i,j)+" "
Next
Print txt
Next
End Function

; Void tText, schreibt eine Matrix auf den Bildschirm mit Text
;
; A: TMatrix, die zu schreibende Matrix
Function tText(A.TMatrix, x, y)
Local txt$

For i=1 To A\n
txt=""
For j=1 To A\m
txt=txt+tGetValue(A,i,j)+" "
Next
Text x,y+i*15,txt$
Next
End Function

;---**********---


EDIT: Ich hab bei MM_Subtract() ein Plus geschrieben statt einem Minus. Das führte dazu, dass statt einer Subtraktion eine Addition gemacht wurde, was natürlich nicht der Zweck der Funktion ist. Habe ich nun korrigiert.

Dokumentation ist direkt im Code und sollte ausführlich genug sein. Vielleicht könnte man mir noch einen Tipp geben, wie ich die Funktionen klüger benennen kann, hier mein bisheriger Ansatz: MM_xxx ist der Funktionsname für die direkte Verwendung, tMM_xxx ist zur Arbeit mit dem Type gedacht. Man kann die MM_xxx Funktionen direkt verwenden, zum "Wie" -> siehe Dokumentation. Als Beispiel hier einen kleine Rechnung von einer (2x2)-Matrix mit einem Vektor (auch Vektoren sind (nx1)-Matrizen!).

BlitzBasic: [AUSKLAPPEN]
Print "Test:"
Print ""

Local A.TMatrix=tCreateMatrix(3,3)
Local B.TMatrix=tCreateMatrix(3,1)
Local R.TMatrix

tSetValue(A, 1, 1,1)
tSetValue(A, 1, 1,2)
tSetValue(A, 1, 2,1)
tSetValue(A, 1, 2,2)

tSetValue(B, 1, 1,1)
tSetValue(B, 1, 2,1)

R=tMM_Multiply(A,B)
tPrint R

time=MilliSecs()
For i=0 To 10000
R=tMM_Multiply(A,B)
Next
time=MilliSecs()-time

Print ""
Print "Eine Mult. brauchte "+(time/1000)+"ms, gesamt (für 10000): "+time

WaitKey()
End


DISCLAIMER: Es sind nicht alle Funktionen getestet Smile Aber Addition und Subtraktion müssten eigentlich auch ohne Test funktionieren. Für den Code wird keine Haftung übernommen!

Die Funktionen können von mir aus von jedem frei verwendet werden, dazu wurde es gemacht! Ich weiss allerdings nicht, wieviele von euch sich mit Matrizen auskennen und wirklich etwas damit anfangen können. Ich jedenfalls werde die oben angegebenen Pseudocodes in BB implementieren und hoffentlich mein IK-Problem so lösen können. Damit will ich dann eigentlich eine Steuerungsmöglichkeit für mein Spiel (ABK) schreiben, aber das ist noch Zukunftsmusik und muss erst gemacht werden.

Soweit so gut, ich wünsche der Leserschaft noch einen schönen Abend,
MfG,
Darth

Pseudo Voronoi

Donnerstag, 14. Januar 2010 von darth
Hallo,

bei meinem Polygonfüller habe ich die Polygone links und rechts am Bildschirmrand geclipt, ich dachte mir, das könne man auch allgemein an einer beliebigen Gerade tun. Das Problem dabei ist, dass man entscheiden muss, was drin und was draussen ist. Ich habe mich dafür entschieden, dass man dies mithilfe der Hesseschen Normalform machen kann und alles was hinter der Geraden liegt löschen lassen. Vom Prinzip her sieht es so aus:

user posted image
Nach dem clipping hat man nur noch das rote Polygon übrig.

Den Code dazu hatte ich schon ziemlich, ich musste nur noch ein bisschen umstellen mit der Schnittpunktberechnung und dem Löschmechanismus, an sich keine grosse Arbeit, hier das Ergebnis:

BlitzBasic: [AUSKLAPPEN]
Function ClipPolyAtLine(P.Polygon, PX1#, PY1#, PDx#, PDy#)
Local Width, Vnew.Vector, PX#, PY#, DX#, DY#, k#, t#, NX#, NY#, ND#, L#, HNF#

Width=GraphicsWidth()

j=P\count-1
For i=0 To P\count-1
If Not (P\P[i:1]\X<0 And P\P[j]\X<0)
PX=P\P[i]\X
PY=P\P[i]\Y

DX=P\P[j]\X-P\P[i]\X
DY=P\P[j]\Y-P\P[i]\Y

;P+k*D = P1+t*PD

t=(DX*(PY-PY1)-DY*(PX-PX1))/(DX*PDy-DY*PDx)
k=(PDx*(PY-PY1)-PDy*(PX-PX1))/(DX*PDy-DY*PDx)

If k>0 And k<1
Vnew=cVector(PX+k*DX, PY+k*DY)

InsertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf
EndIf

j=i
Next

NX=PDy
NY=-PDx

L=Sqr(NX*NX+NY*NY)
NX=NX/L
NY=NY/L

ND=-PX1*NX-PY1*NY

For i=0 To P\count-1
HNF=NX*P\P[i]\X+NY*P\P[i]\Y+ND

If HNF<-0.1
RemovePointFromPoly(P, i)
i=i-1
EndIf
Next
End Function


Nachdem dies getan war hatte ich den Einfall, dass ich damit endlich eine vernünftige Voronoi-Zerlegung meiner Polygone erreichen kann. Man findet ziemlich schnell irgendwelche Algorithmen und Anweisungen dazu. Das Problem dabei ist, dass diese meistens mit irgendwelchen [i]Edges und Halfedges und Listen und irgendwelchen Events arbeiten, das in BB ziemlich mühsam umzusetzen wird, von daher hab ich es immer wieder verschoben und nie gemacht.

Ein typisches Voronoi-Diagramm findet man auch relativ viel im Internet, es gibt Bilder und Applets etcpp. Allerdings war ich noch nie ein grosser Fan von Nachlesen und Umsetzen von Algorithmen, ich habe Freude daran eigene Wege zu finden (darum ist mein Wasser auch noch immer kaputt *hust*). Eine standard Beispielzerlegung sieht zum Beispiel so aus:

user posted image
(DISCLAIMER: Dies ist nicht mein Bild, das habe ich von einer Seite geklaut)

Die theoretische Methode ist so, dass man an den Mittelsenkrechten zwischen den Punkten teilt, und hier kommt das Polygonclipping ins Spiel. Ich dachte mir, dass ich einfach das Polygon an dieser Geraden teilen kann. Das Problem ist dann, dass man viele kleine Polygone bekommt, die eigentlich nicht dahingehören. Man muss sie nachträglich noch zusammenfassen zu den grossen Polys die man für die Zerlegung will. Das ist an sich auch kein grosses Problem, ein wenig überlegen führte zu dieser Arbeitsweise:

Code: [AUSKLAPPEN]
* finde Polygon mit Voronoi Punkt
* finde Nachbarpolygon (gemeinsame Kante)
   -> hat es einen Punkt?
   ja:
      * ignoriere es
   nein:
      * finde einen Nachbar für dieses Polygon
         -> hat dieses einen Punkt?
         ja:
            * suche die kleinere Distanz
            * füge es zum entsprechenden Polygon hinzu
         nein:
            * füge es zum Polygon hinzu


Dieser Algorithmus hat sich bisher bewährt und funktioniert wunderbar. In Arbeit sieht es etwa so aus (Zusammenschnitt):

user posted image

Bei Punkt (1) sieht man die Zerlegung in die Einzelteile. Danach werden die Polygone zusammengeschweisst zu der resultierenden Zerlegung, die man in (2) sieht. Die Zahlen oben sind Debugwerte, links die FPS Zahl, Mitte die Mauskoordinaten, rechts die Zeit die für die Zerlegung benötigt wurde (ms).

Der Code dazu hier, Erklärung folgt im Anschluss:

BlitzBasic: [AUSKLAPPEN]
Type VPoint
Field X#
Field Y#
End Type

Type Vector
Field X#
Field Y#

Field used
End Type

Type Polygon
Field P.Vector[64]
Field count

Field VFlag

Field Vx#
Field Vy#
End Type

Function cVector.Vector(x#, y#)
Local V.Vector

V=New Vector
V\X=x
V\Y=y

Return V
End Function

Function ClipPolyAtLine(P.Polygon, PX1#, PY1#, PDx#, PDy#)
Local Width, Vnew.Vector, PX#, PY#, DX#, DY#, k#, t#, NX#, NY#, ND#, L#, HNF#

Width=GraphicsWidth()

j=P\count-1
For i=0 To P\count-1
If Not (P\P[i:1]\X<0 And P\P[j]\X<0)
PX=P\P[i]\X
PY=P\P[i]\Y

DX=P\P[j]\X-P\P[i]\X
DY=P\P[j]\Y-P\P[i]\Y

;P+k*D = P1+t*PD

t=(DX*(PY-PY1)-DY*(PX-PX1))/(DX*PDy-DY*PDx)
k=(PDx*(PY-PY1)-PDy*(PX-PX1))/(DX*PDy-DY*PDx)

If k>0 And k<1
Vnew=cVector(PX+k*DX, PY+k*DY)

InsertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf
EndIf

j=i
Next

NX=PDy
NY=-PDx

L=Sqr(NX*NX+NY*NY)
NX=NX/L
NY=NY/L

ND=-PX1*NX-PY1*NY

For i=0 To P\count-1
HNF=NX*P\P[i]\X+NY*P\P[i]\Y+ND

If HNF<-0.1
RemovePointFromPoly(P, i)
i=i-1
EndIf
Next
End Function

Function InsertPointToPoly(P.Polygon, V.Vector, i)
If P\count=64
Return ;error!
EndIf

For j=P\count-1 To i Step -1
P\P[j+1]=P\P[j]
Next
P\P[i]=V

P\count=P\count+1
End Function

Function RemovePointFromPoly(P.Polygon, i)
If P\count=0
Return ;error!
EndIf

For j=i+1 To P\count-1
P\P[j-1]=P\P[j]
Next
P\P[P\count-1]=Null

P\count=P\count-1
End Function

Function PointInPoly(X#, Y#, P.Polygon)
Local in, X1#, Y1#, X2#, Y2#

in = False
For i=0 To P\count-1
If i Then j=i-1 Else j=P\count-1
X1#=P\P[i]\X
Y1#=P\P[i]\Y
X2#=P\P[j]\X
Y2#=P\P[j]\Y
If ((((Y1<=Y) And (Y<Y2)) Or ((Y2<=Y) And (Y<Y1))) And (X<(((X2-X1)*(Y-Y1))/(Y2-Y1))+X1))
in = Not in
EndIf
Next

Return in
End Function

Function PseudoVoronoi(P.Polygon)
Local PIter.Polygon, vP1.VPoint, vP2.VPoint, MX#, MY#, NX#, NY#, pP1.Polygon, pP2.Polygon

For PIter=Each Polygon
PIter\VFlag=False
Next

P\VFlag=True

For vP1=Each VPoint
vP2=After vP1
While vP2<>Null
MX=(vP1\X+vP2\X)/2
MY=(vP1\Y+vP2\Y)/2

NX=vP2\Y-vP1\Y
NY=vP1\X-vP2\X

For PIter=Each Polygon
If PIter\VFlag=True
If PointInPoly(vP1\X, vP1\Y, PIter)
pP1=PIter
EndIf
If PointInPoly(vP2\X,vP2\Y, PIter)
pP2=PIter
EndIf
EndIf
Next

If pP1=pP2
If pP1<>Null
SplitPolygon(pP1, vP1, vP2)
EndIf
Else
If pP1<>Null
SplitPolygon(pP1, vP1, vP2)
EndIf
If pP2<>Null
SplitPolygon(pP2, vP1, vP2)
EndIf
EndIf

vP2=After vP2
Wend
Next

For PIter=Each Polygon
SimplyfyPoly(PIter)
Next

CollectPolys()
End Function

Function CollectPolys()
Local Mx#, My#, PIter.Polygon, Pn1.Polygon, Pn2.Polygon, D1#, D2#, vP1.VPoint, vP2.VPoint, succ

For PIter=Each Polygon
If IsMainPoly(PIter)
Pn1=GetNeighbor(PIter)

If Not IsMainPoly(Pn1)
Pn2=GetNeighbor(Pn1)

If IsMainPoly(Pn2)
Mx=0
My=0

For i=0 To Pn1\count-1
Mx=Mx+Pn1\P[i]\X
My=My+Pn1\P[i]\Y
Next

Mx=Mx/Pn1\count
My=My/Pn1\count

vP1=GetVPointInPoly(PIter)
vP2=GetVPointInPoly(Pn2)

D1=Sqr((Mx-vP1\X)^2+(My-vP1\Y)^2)
D2=Sqr((Mx-vP2\X)^2+(My-vP2\Y)^2)

If D1<D2
MergePolygon(PIter, Pn1)
Else
MergePolygon(Pn2, Pn1)
EndIf
Else
MergePolygon(PIter, Pn1)
EndIf
EndIf
EndIf
Next

succ=True

For PIter=Each Polygon
If PIter\count<3
Delete PIter
Else
If Not IsMainPoly(PIter)
succ=False
EndIf
EndIf
Next

If Not succ
CollectPolys()
EndIf
End Function

Function GetNeighbor.Polygon(P.Polygon)
Local PIter.Polygon, count, PRet.Polygon

PRet=Null

For PIter=Each Polygon
count=0

If PIter<>P
For i=0 To P\count-1
For j=0 To PIter\count-1
If Abs(P\P[i]\X-PIter\P[j]\X)<0.1 And Abs(P\P[i]\Y-PIter\P[j]\Y)<0.1
count=count+1

If count=2
If PRet=Null
PRet=PIter
Else
If Not IsMainPoly(PIter)
PRet=PIter
EndIf
EndIf
EndIf
EndIf
Next
Next
EndIf
Next

Return PRet
End Function

Function IsMainPoly(P.Polygon)
Local vP.VPoint

For vP=Each VPoint
If PointInPoly(vP\X, vP\Y, P)
Return True
EndIf
Next

Return False
End Function

Function GetVPointInPoly.VPoint(P.Polygon)
Local vP.VPoint

For vP=Each VPoint
If PointInPoly(vP\X, vP\Y, P)
Return vP
EndIf
Next

Return Null
End Function

;Nur, wenn beide Polygone EINE gemeinsame Kante haben
Function MergePolygon(P1.Polygon, P2.Polygon)
Local iE, jE, ins, iT, iE0, jE0

iE=-1
jE=-1
ins=0

For i=0 To P1\count-1
For j=0 To P2\count-1
If Abs(P1\P[i]\X-P2\P[j]\X)<0.1 And Abs(P1\P[i]\Y-P2\P[j]\Y)<0.1
If iE=-1 And jE=-1
iE0=i
jE0=j
EndIf

iE=i
jE=j
EndIf
Next
Next

If iE=-1 Or jE=-1
Return False
EndIf

If iE0<>0
If iE0<iE
iE=iE0
jE=jE0
EndIf
EndIf

For i=jE+1 To P2\count+jE-1
iT=i Mod P2\count

InsertPointToPoly(P1, P2\P[iT], iE+ins+1)
ins=ins+1
Next

SimplyfyPoly(P1)
Delete P2

Return True
End Function

Function SimplyfyPoly(P.Polygon)
For i=0 To P\count-1
For j=0 To P\count-1
If i<>j
If Abs(P\P[i]\X-P\P[j]\X)<0.1 And Abs(P\P[i]\Y-P\P[j]\Y)<0.1
RemovePointFromPoly(P, j)
j=j-1
EndIf
EndIf
Next
Next
End Function

Function SplitPolygon(P.Polygon, P1.VPoint, P2.VPoint)
Local Tmp.Polygon, NX#, NY#, PX#, PY#

Tmp=New Polygon
For i=0 To P\count-1
Tmp\P[i]=cVector(P\P[i]\X, P\P[i]\Y)
Next
Tmp\count=P\count
Tmp\VFlag=True

PX=(P1\X+P2\X)/2
PY=(P1\Y+P2\Y)/2

NX=P2\Y-P1\Y
NY=P1\X-P2\X

Tmp\Vx=NY
Tmp\Vy=-NX

ClipPolyAtLine(Tmp, PX, PY, NX, NY)

Tmp=New Polygon
For i=0 To P\count-1
Tmp\P[i]=cVector(P\P[i]\X, P\P[i]\Y)
Next
Tmp\count=P\count
Tmp\VFlag=True

NX=-NX
NY=-NY

Tmp\Vx=NY
Tmp\Vy=-NX

ClipPolyAtLine(Tmp, PX, PY, NX, NY)

Delete P
End Function

Function DrawPolys()
Local P.Polygon, Mx#, My#

LockBuffer BackBuffer()

Color 255,0,0
For P.Polygon=Each Polygon
DrawOutLine(P, 255, 255, 255)
Next

UnlockBuffer BackBuffer()
End Function

Function DrawOutLine(P.Polygon, R, G, B)
Color R,G,B

j=P\count-1
For i=0 To P\count-1
Line P\P[i]\X,P\P[i]\Y,P\P[j]\X,P\P[j]\Y

j=i
Next
End Function

Function DrawVPoints()
Local P.VPoint

For P=Each VPoint
Rect P\X-3,P\Y-3,6,6,0
Next
End Function

Function Max#(A#,B#)
If A>B
Return A
Else
Return B
EndIf
End Function

Function Min#(A#,B#)
If A<B
Return A
Else
Return B
EndIf
End Function

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

Local Test.Polygon, P1.VPoint, P2.VPoint, P3.VPoint, P4.VPoint, P5.VPoint

Test.Polygon=New Polygon
Test\P[0]=cVector(300,200)
Test\P[1]=cVector(400,250)
Test\P[2]=cVector(520,160)
Test\P[3]=cVector(375,350)
Test\P[4]=cVector(200,450)
Test\P[5]=cVector(350,325)
Test\count=6

P1=New VPoint : P1\X=320 : P1\Y=370
P2=New VPoint : P2\X=410 : P2\Y=270
P3=New VPoint : P3\X=350 : P3\Y=250
P4=New VPoint : P4\X=380 : P4\Y=310
;P5=New VPoint : P5\X=370 : P5\Y=340

vtime=MilliSecs()
PseudoVoronoi(Test)
vtime=MilliSecs()-vtime

While Not KeyHit(1)
DrawPolys()
DrawVPoints()

Text 200,10,vtime

fps=fps+1
If MilliSecs()-fpstime>999
fpscur=fps
fps=0
fpstime=MilliSecs()
EndIf
Text 10,10,fpscur

Flip 0
Cls
Wend
End


Man muss das Polygon selber definieren, sowie die Punkte anhand welcher die Zerlegung durchgeführt werden soll. Danach ruft man EINmal die Zerlegung auf, indem man der Funktion [i]PseudoVoronoi das Hauptpolygon mitliefert. Dabei wird das Polygon zerstört (und gelöscht)! Mittels der Drawfunktionen kann man seine Polygone anzeigen lassen.

Wozu die Arbeit?

Mein Ziel ist es eigentlich, die Voronoi-Zerlegung in meine Physik einzubauen, um zerstörbare Objekte zu haben. Das Problem ist, dass ich bisher noch nie mit Destruktionsphysik gearbeitet habe, ich kenne mich etwas mit der Physik deformierbarer Körper aus, aber brechen oder splittern habe ich bisher weder in der Schule noch an der Universität behandelt.
Von daher muss ich entscheiden, wie und wo ich diese Voronoi Punkte setzen soll, damit die Zerlegung vernünftige Splitterungen hervorruft, aber das ist im Moment noch Zukunftsmusik, da muss ich mich noch etwas einlesen und darüber nachdenken.

Soweit so gut, genug zu meinem Krempel. Ich wünsche eine schöne Woche,
MfG,
Darth

Zurück zum Ursprung

Montag, 4. Januar 2010 von darth
Hallo,

dieser Beitrag dient eigentlich nur einem kleineren Update der Physik. Ich habe einige Dateien aus meinem Forenarchiv gelöscht und gedenke die nun durch neue Versionen zu ersetzen, dazu dieser Eintrag hier.
Ich hätte das Zeug gerne auf meinen eigenen Webspace hochgeladen, aber mein freundlicher FTP Client verweigert mir die Verbindung, obwohl ich das Passwort gerade erst neu gemacht habe, es sollte also stimmen :/ Naja, nächstes Thema.

Wer gestern den Forenunterteil "Allgemein" besucht hat, hat bestimmt meinen Thread zu meiner Polygon Füllroutine gesehen. Die Probleme dort sind nun gelöst, und das Ding ist erfolgreich in meiner Physik integriert.
Hier einmal der extrahierte Code, um eigene Polygone zu erstellen, anzuzeigen und zu füllen (der auskommentierte Teil arbeitet mit WritePixelFast, aber es hat sich herausgestellt, dass es viel schneller geht Line zu verwenden - aber als altes Überbleibsel ist der WPF Teil noch drin.)
Ebenfalls dabei ist der Algorithmus, um das Polygon links und rechts zu clippen, sprich abzuschneiden, wenn es den Bildschirmbereich überschreitet. Achtung: Das Polygon wird dabei verändert (und gegebenenfalls zerstört) - man sollte also stets eine Kopie des Originals anlegen, clippen und füllen. Ohne Polygonclipping kommt es beim Füllen zu Fehlern, wenn nicht das komplette Polygon im Fenster ist.

BlitzBasic: [AUSKLAPPEN]
Type Vector
Field X#
Field Y#

Field used
End Type

Type Polygon
Field P.Vector[64]
Field count
End Type

Function cVector.Vector(x#, y#)
Local V.Vector

V=New Vector
V\X=x
V\Y=y

Return V
End Function

Function ClipPoly(P.Polygon)
Local Width, Vnew.Vector, PX#, PY#, DX#, DY#, k#, PnewY

Width=GraphicsWidth()

j=P\count-1
For i=0 To P\count-1
If Not (P\P[i]\X<0 And P\P[j]\X<0)
PX=P\P[i]\X
PY=P\P[i]\Y

DX=P\P[j]\X-P\P[i]\X
DY=P\P[j]\Y-P\P[i]\Y

k=-PX/DX
If k>0 And k<1
PnewY=PY+k*DY

Vnew=cVector(1,PnewY)

InsertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf

k=(Width-PX)/DX
If k>0 And k<1
PnewX=PX+k*DX
PnewY=PY+k*DY

Vnew=cVector(Width-1,PnewY)

InsertPointToPoly(P, Vnew, j+1)

If i<>0
i=i+1
EndIf
EndIf
EndIf

j=i
Next

For i=0 To P\count-1
If P\P[i]\X<0 Or P\P[i]\X>Width
RemovePointFromPoly(P, i)
i=i-1
EndIf
Next
End Function

Function InsertPointToPoly(P.Polygon, V.Vector, i)
If P\count=64
Return ;error!
EndIf

For j=P\count-1 To i Step -1
P\P[j+1]=P\P[j]
Next
P\P[i]=V

P\count=P\count+1
End Function

Function RemovePointFromPoly(P.Polygon, i)
If P\count=0
Return ;error!
EndIf

For j=i+1 To P\count-1
P\P[j-1]=P\P[j]
Next
P\P[P\count-1]=Null

P\count=P\count-1
End Function

Type LList
Field X

Field Succ.LList
End Type

Function FillPoly(P.Polygon, R, G, B)
Local MinX#, MinY#, MaxX#, MaxY#, SX#, SY#, DX#, PX#, PY#, VX#, VY#, k#, CX#, Fill
Local LStart.LList, LIter.LList, Tmp.LList

Color R,G,B

MinX=GraphicsWidth()
MinY=GraphicsHeight()
MaxX=0
MaxY=0

For i=0 To P\count-1
If P\P[i]\X<MinX
MinX=P\P[i]\X
EndIf
If P\P[i]\X>MaxX
MaxX=P\P[i]\X
EndIf

If P\P[i]\Y<MinY
MinY=P\P[i]\Y
EndIf
If P\P[i]\Y>MaxY
MaxY=P\P[i]\Y
EndIf
Next

MaxY=Min(GraphicsHeight()-1,MaxY)
MinY=Max(0,MinY)

For SY=MinY+1 To MaxY
Delete Each LList
Fill=0

SX=MinX

DX=MaxX-MinX

j=P\count-1
For i=0 To P\count-1
PX=P\P[i]\X
PY=P\P[i]\Y+0.1

VX=P\P[j]\X-P\P[i]\X
VY=P\P[j]\Y-P\P[i]\Y

If VY<>0
k=(SY-PY)/VY
If k>=0 And k<=1
CX=PX+k*VX

k=(CX-SX)/DX
If k>=0 And k<=1
CX=Int(CX)

If LStart=Null
LStart=New LList
LStart\X=CX
Else
If CX<LStart\X
Tmp=LStart

LStart=New LList
LStart\X=CX
LStart\Succ=Tmp
Else
LIter=LStart
While LIter<>Null
If Int(CX)=LIter\X
Tmp=LIter\Succ

LIter\Succ=New LList
LIter\Succ\X=CX
LIter\Succ\Succ=Tmp

Exit
Else
If CX>LIter\X
If LIter\Succ<>Null
If CX<LIter\Succ\X
Tmp=LIter\Succ

LIter\Succ=New LList
LIter\Succ\X=CX
LIter\Succ\Succ=Tmp

Exit
EndIf
Else
LIter\Succ=New LList
LIter\Succ\X=CX

Exit
EndIf
EndIf
EndIf

LIter=LIter\Succ
Wend
EndIf
EndIf
EndIf
EndIf
EndIf

j=i
Next

LIter=LStart
If LIter<>Null
While LIter\Succ<>Null
Line LIter\X,SY,LIter\Succ\X,SY
LIter=LIter\Succ\Succ

If LIter=Null
Exit
EndIf
Wend
EndIf

;LIter=LStart
;If LIter<>Null
; For SX=Int(LIter\X) To MaxX
; If LIter\Succ<>Null
; If SX>LIter\X
; Fill=1-Fill
;
; LIter=LIter\Succ
;
; If LIter<>Null
; If Not Fill
; SX=LIter\X-1
; EndIf
; Else
; Exit
; EndIf
; EndIf
; Else
; If SX>LIter\X
; Exit
; EndIf
; EndIf
;
; If Fill
; WritePixelFast SX,SY,RGB
; EndIf
; Next
;EndIf
Next

Delete Each LList
End Function

Function Max#(A#,B#)
If A>B
Return A
Else
Return B
EndIf
End Function

Function Min#(A#,B#)
If A<B
Return A
Else
Return B
EndIf
End Function

Function DrawOutLine(P.Polygon, R, G, B)
Color R,G,B

j=P\count-1
For i=0 To P\count-1
Line P\P[i]\X,P\P[i]\Y,P\P[j]\X,P\P[j]\Y

j=i
Next
End Function

Function DrawPolys()
Local P.Polygon, Tmp.Polygon

LockBuffer BackBuffer()

Color 255,0,0
For P.Polygon=Each Polygon
Tmp.Polygon=New Polygon
For i=0 To P\count-1
Tmp\P[i]=cVector(P\P[i]\X,P\P[i]\Y)
Next
Tmp\count=P\count

ClipPoly(Tmp)
FillPoly(Tmp, 255, 255, 255)
DrawOutLine(Tmp, 255, 0, 0)

Delete Tmp
Next

UnlockBuffer BackBuffer()
End Function


Wer den Algorithmus testen will, kann gerne diesen Programmschnippsel verwenden (einfach unten an die Funktionen hinkopieren):

BlitzBasic: [AUSKLAPPEN]
Graphics 800,600,0,2
SetBuffer BackBuffer()

Local Test.Polygon, DX, DY

Test.Polygon=New Polygon
Test\P[0]=cVector(300,200)
Test\P[1]=cVector(400,250)
Test\P[2]=cVector(520,160)
Test\P[3]=cVector(375,350)
Test\P[4]=cVector(200,450)
Test\P[5]=cVector(350,325)
Test\count=6

While Not KeyHit(1)
DrawPolys()

DX=KeyDown(205)-KeyDown(203)
DY=KeyDown(208)-KeyDown(200)
For i=0 To Test\count-1
Test\P[i]\X=Test\P[i]\X+DX
Test\P[i]\Y=Test\P[i]\Y+DY
Next

fps=fps+1
If MilliSecs()-fpstime>999
fpscur=fps
fps=0
fpstime=MilliSecs()
EndIf
Text 10,10,fpscur

Flip 0
Cls
Wend
End


Als kleiner ("unnützer") Bonus noch meine Implementation eines rekursiven FloodFill Algorithmus. Ich rate davon ab, da er nebst WPF auch noch auf RPF basiert, rekursiv ist und dadurch EXTREM langsam! Ausserdem braucht er die Konturen des Polygons, weil er sonst einfach den ganzen Bildschirm füllt (der Scanline braucht das nicht!). Der Funktion muss nebst der Füllfarbe auch die Konturenfarbe mitgegeben werden.
So alles in allem würde ich von dem Algorithmus abraten, aber wenn man eine bestimmte Form hat die man füllen will, aber die Form nicht unbedingt in Polygone fassen will kann man diesen hier gut verwenden. Allerdings gibt es sicher bessere Lösungen, die nicht rekursiv sind, zum Beispiel diesen hier (DISCLAIMER: Nicht mein Algorithmus, ich habe ihn nicht gross angesehen, er wurde mir empfohlen).
Hier mein rekursiver Ansatz:

BlitzBasic: [AUSKLAPPEN]
Function FloodFill(x,y,bColR,bColG,bColB,fColR,fColG,fColB,minX,minY,maxX,maxY)
If x<minX Or x>maxX Or y<minY Or y>maxY
Return
EndIf

rgb=ReadPixelFast(x,y)

r=(rgb And $FF0000)/$10000
g=(rgb And $FF00)/$100
b=rgb And $FF

If r=bColR And g=bColG And b=bColB
Return
EndIf
If r=fColR And g=fColG And b=fColB
Return
EndIf

For sLeft=x To minX Step -1
rgb=ReadPixelFast(sLeft,y)

r=(rgb And $FF0000)/$10000
g=(rgb And $FF00)/$100
b=rgb And $FF

If r=bColR And g=bColG And b=bColB
sLeft=sLeft+1
Exit
EndIf
If r=fColR And g=fColG And b=fColB
sLeft=sLeft+1
Exit
EndIf

WritePixelFast sLeft,y,fColR*$10000+fColG*$100+fColB
Next
For sRight=x+1 To maxX
rgb=ReadPixelFast(sRight,y)

r=(rgb And $FF0000)/$10000
g=(rgb And $FF00)/$100
b=rgb And $FF

If r=bColR And g=bColG And b=bColB
sRight=sRight-1
Exit
EndIf
If r=fColR And g=fColG And b=fColB
sRight=sRight-1
Exit
EndIf

WritePixelFast sRight,y,fColR*$10000+fColG*$100+fColB
Next

For i=sLeft To sRight
FloodFill(i,y-1,bColR,bColG,bColB,fColR,fColG,fColB,minX,minY,maxX,maxY)
FloodFill(i,y+1,bColR,bColG,bColB,fColR,fColG,fColB,minX,minY,maxX,maxY)
Next
End Function


Genug dazu. Um den Algorithmus (Scanline) mal im Einsatz zu zeigen, habe ich meine kleine Physikspielerei dazu umgerüstet, die Polygone zu füllen. Die Farben werden rein zufällig gewählt, der Rand wird in der gespeicherten Farbe gezeichnet, die Füllung wird um 30% abgedunkelt (mir gefiel der Effekt). Hier das Ergebnis:

user posted image

Wer das Spiel gerne ausprobieren möchte, kann es sich hier runterladen:
LINK ~500kb

Wer gerne sein 2D Spiel (oder pseudo 3D) mit meiner Physik ausstatten möchte, kann sich hier die neuste Version runterladen:
LINK ~18kb

Der BB-Datei liegt eine Textdokumentation bei. Wenn es sich jemand ansieht, wäre ich froh um eine kurze Rückmeldung, ob die Dokumentation in dem Stil hilfreich ist, oder ob ich etwas grundlegend veränderen sollte, um es verständlicher zu machen.

Ich hoffe jemand kann etwas von meinem Geschreibsel hier mitnehmen und wünsche eine schöne erste Arbeitswoche im ersten Jahr (für die armen Charakteren die - im Gegensatz zu mir - arbeiten gehen müssen).

MfG,
Darth

Inverse Kinematik

Mittwoch, 30. Dezember 2009 von darth
Hallo,

durch meine momentane Tätigkeit bin ich wieder auf älteres Projekt von mir gestossen. Ich habe da so ein lustiges Spiel im Hinterkopf, das ich so nie programmieren werde Very Happy Im Prinzip geht es darum, dass man alles tun kann, was unmöglich ist *seufz*, aber der Hauptfokus sollte auf der Figurensteuerung liegen, man bewegt einzelne Gelenke und der Charakter reagiert entsprechend, wie diese Steuerung umsetzbar sein soll weiss ich nicht (darum werde ich das auch nie so umsetzen können :/ MotionCapture ftw!)
Wie dem auch sei, die Überlegungen führten immer wieder zu einem Schlagwort "Inverse Kinematics" oder für Anti-Anglikaner: "Inverse Kinematik" (Differenz: 1 Buchstaben + 1 Austausch).

Bisher bin ich an IK immer gescheitert. Vor Kurzem bin ich dann auf eine "Anleitung" gestossen, die als solches eigentlich ziemlich wenig hilft. Aber dennoch brachte es eine wichtige Erkenntnis:
The speed at which you should rotate the joint is proportional to the dot product of R and F.
So betrachtet ziemlich logisch, aber auch darauf muss man erstmal kommen. Mit dem habe ich es ziemlich schnell hinbekommen eine Kette zu programmieren, die sich zu einem Punkt ausrichten kann. Das Problem dabei ist (und darum ist die Anleitung eher nutzlos), dass sich JEDER Punkt dort ausrichtet, man kriegt also eine Linie und etwas zusammengefaltets.

Aber man lässt sich als Programmierer ja nicht entmutigen. Ich habe darauf angefangen meine Mechanikkenntnisse einzubringen (Uni ist schon etwas Tolles Smile im Nachhinein merkt man immer für was man den Kram benutzen kann den man lernt) und kam zu einer alternativen Darstellung der Armstellung:

user posted image

Jeder Arm hat einen Winkel (relativ zum vorhergehenden) und eine Länge. Ich transformiere mein Problem von (X/Y) zu (R/Phi), wobei R konstant ist. Wie im Bild beschrieben ist, habe ich dann 2 Gleichungen und N Unbekannte, und das ist das grosse Problem der IK.

Es gibt soweit ich weiss viele verschiedene Ansätze dieses nichtlineare Ausgleichsproblem zu lösen. Ich bin immernoch am Erlernen der numerischen Methoden und dachte mir, ich könnte einen Newton-Gauss-Algorithmus berechnen. Das Prinzip ist relativ einfach:
Code: [AUSKLAPPEN]
for k=1:MAX
    A=f'(x)
    b=-f(x)
    löse: A^T * A * dx = A^T * b nach dx
    x=x+dx
end

f'(x) ist die Jacobi Matrize der Funktion f(x), natürlich könnte man die von Hand berechnen, die beiden Funktionen für EX und EY stehen ja oben im Bild. Aber wer das macht ist, naja, fleissig. Es geht einfacher, und zwar numerisch Smile
Code: [AUSKLAPPEN]
df_i/dx_j (x) = ( f_i(x+h*e_j) - f_i(x) )/h


Weil das Ding in BB ziemlich mühsam zu implementieren ist (Matrixen transponieren, Matrizen multiplizieren, Gleichungssystem lösen -> mit dem LU-Algo vom letzten mal), dachte ich mir, ich versuch es erst einmal in Matlab. Gedacht, getan, Ergebnis:
Code: [AUSKLAPPEN]
function [ Phi, P, iter ] = IKSolver( PStart, PEnd, R )
    MAX = 100;
    TOL = 10^(-6);
    N = length(R);
   
    PhiOld = zeros(N, 1);
    Phi = ones(N, 1);
    iter=0;
   
    for k = 1:MAX
        J = GetJacobi(PStart, PEnd, Phi, R);
        b = J'*(-[f1(PStart,PEnd,R,Phi);f2(PStart,PEnd,R,Phi)]);
       
        A=J'*J;
       
        dPhi = A\b;
       
        Phi = Phi+dPhi;
       
        if norm([f1(PStart,PEnd,R,Phi);f2(PStart,PEnd,R,Phi)])<TOL
            break
        end
       
        PhiOld=Phi;
       
        iter=k;
    end
   
    P(1,1)=PStart(1);
    P(2,1)=PStart(2);
    for i = 1:N
        P(1,i+1) = f1(PStart,[0;0],R(1:i),Phi(1:i));
        P(2,i+1) = f2(PStart,[0;0],R(1:i),Phi(1:i));
    end
   
    figure
    plot(P(1,:),P(2,:),'-rs');
    hold on
    plot(PEnd(1),PEnd(2),'-bs');
end

function [ J ] = GetJacobi( PStart, PEnd, Phi, R )   
    h = 10^(-4);
    N = length(R);
    J = zeros(2, N);
   
    for j = 1:N
        e = GetEinhV(j, N);
       
        J(1, j) = (f1(PStart,PEnd,R,Phi+h*e)-f1(PStart,PEnd,R,Phi))/h;
        J(2, j) = (f2(PStart,PEnd,R,Phi+h*e)-f2(PStart,PEnd,R,Phi))/h;
    end
       
    function [ e ] = GetEinhV( i, N )
        e = zeros(N, 1);
        e(i, 1) = 1;
    end
end

% f1 = (sx-ex) + sum(i=1, n){ R(i) * cos( sum(j=1, i){ Phi(i) } ) }
% f2 = (sy-ey) - sum(i=1, n){ R(i) * sin( sum(j=1, i){ Phi(i) } ) }

function [ w ] = f1( PStart, PEnd, R, Phi )
    N = length(R);
   
    w = PStart(1)-PEnd(1);
       
    for i = 1:N
        pSum = 0;
           
        for j = 1:i
            pSum = pSum+Phi(j);
        end
       
        w = w+cos(pSum)*R(i);
    end
end

function [ w ] = f2( PStart, PEnd, R, Phi )
    N = length(R);
   
    w = PStart(2)-PEnd(2);
     
    for i = 1:N
        pSum = 0;
           
        for j = 1:i
            pSum = pSum+Phi(j);
        end
           
        w = w-sin(pSum)*R(i);
    end
end


Ein kleiner Test des Algorithmus brachte schöne Ergebnisse, wie zum Beispiel dieses hier:
user posted image

Aber sobald ich das System für mehr als zwei Arme lösen wollte wurde die Matrix A plötzlich singulär (das heisst sie hat kein Inverses und das Gleichungssystem ist nicht lösbar). Den Fehler konnte ich nicht beheben, ich konnte zwar ein Ergebnis nur zulassen wenn es gültig war, aber die Endstellung wich zusehr vom Zielpunkt ab.

Ziemlich frustriert von der Niederlage beschloss ich mit Panzerraketen auf Spatzen zu schiessen. Man verändert die Armstellung ziellos und wertet aus ob man nun näher am Endpunkt ist oder nicht, wenn ja wird die Änderung akzeptiert, wenn nein sucht man sich eine neue. Diese Vorgehensweise ist meiner Meinung nach relativ dämlich, funktioniert aber (leider -.-) bestens.
Code: [AUSKLAPPEN]
function [ Phi, P, iter ] = IKSolverNew( PStart, PEnd, R )
    MAX = 10000;
    TOL = 1;
    N = length(R);
   
    PhiOld = zeros(N, 1);
    Phi = zeros(N, 1);
    iter=0;
   
    figure
   
    for k = 1:MAX
        PStop(1) = f1(PStart, R, Phi);
        PStop(2) = f2(PStart, R, Phi);
       
        OldRes = norm(PEnd-PStop);
       
        for i = 1:N
            PhiNew(i) = Phi(i)+(rand(1)*2-1)*0.01;
        end
       
        PStop(1) = f1(PStart, R, PhiNew);
        PStop(2) = f2(PStart, R, PhiNew);
       
        NewRes = norm(PEnd-PStop);
       
        if NewRes<OldRes
            Phi = PhiNew;
           
            P(1,1)=PStart(1);
            P(2,1)=PStart(2);
            for i = 1:N
                P(1,i+1) = f1(PStart,R(1:i),Phi(1:i));
                P(2,i+1) = f2(PStart,R(1:i),Phi(1:i));
            end
           
            hold on
            plot(P(1,:),P(2,:))
        end
       
        if NewRes<TOL
            disp('Close enogh');
            break
        end
       
        iter = k;
    end
   
    P(1,1)=PStart(1);
    P(2,1)=PStart(2);
    for i = 1:N
        P(1,i+1) = f1(PStart,R(1:i),Phi(1:i));
        P(2,i+1) = f2(PStart,R(1:i),Phi(1:i));
    end
   
    figure
    plot(P(1,:),P(2,:),'-rs');
    hold on
    plot(PEnd(1),PEnd(2),'-bs');
end

% f1 = sx + sum(i=1, n){ R(i) * cos( sum(j=1, i){ Phi(i) } ) }
% f2 = sy - sum(i=1, n){ R(i) * sin( sum(j=1, i){ Phi(i) } ) }

function [ w ] = f1( PStart, R, Phi )
    N = length(R);
   
    w = PStart(1);
       
    for i = 1:N
        pSum = 0;
           
        for j = 1:i
            pSum = pSum+Phi(j);
        end
       
        w = w+cos(pSum)*R(i);
    end
end

function [ w ] = f2( PStart, R, Phi )
    N = length(R);
   
    w = PStart(2);
     
    for i = 1:N
        pSum = 0;
           
        for j = 1:i
            pSum = pSum+Phi(j);
        end
           
        w = w-sin(pSum)*R(i);
    end
end


Dieser Algorithmus liefert lustige Ergebnisse wie:
user posted image

Da dieses Prinzip tadellos funktioniert hat (und das hier ja ein BB Forum ist und nicht Matlab) habe ich das Ganze in meinen besteheden Code integriert. Es wird eine Konstellation berechnet (mit dem Try&Error Verfahren) und dann jedem Punkt sein Ziel zugewiesen. Danach kann ich die Punkte wie vorher schon zu ihrem Ziel bewegen.
BlitzBasic: [AUSKLAPPEN]
Type Joint
Field X#
Field Y#

Field TX#
Field TY#

Field Fixed
End Type

Type Bone
Field J1.Joint
Field J2.Joint

Field Length#
End Type

Function Draw()
Local J.Joint, B.Bone

For J.Joint=Each Joint
Oval J\X-3,J\Y-3,6,6
Next

For B.Bone=Each Bone
Line B\J1\X,B\J1\Y,B\J2\X,B\J2\Y
Next
End Function

Function GetNextFixedJoint.Joint(JSearch.Joint)
Local J.Joint, Passed

Passed=False

If JSearch=Null
Passed=True
Else
If Not JSearch\Fixed
Return Null
EndIf
EndIf

For J.Joint=Each Joint
If J=JSearch
Passed=True
Else
If Passed
If J\Fixed
Return J
EndIf
EndIf
EndIf
Next

Return Null
End Function

Function GetNextJoint.Joint(JSearch.Joint)
Local B.Bone

For B.Bone=Each Bone
If B\J1=JSearch
Return B\J2
EndIf
Next

Return Null
End Function

Function CalcBoneLength#(B.Bone)
B\Length=Sqr((B\J1\X-B\J2\X)*(B\J1\X-B\J2\X)+(B\J1\Y-B\J2\Y)*(B\J1\Y-B\J2\Y))
End Function

Function GetBone.Bone(JSearch.Joint)
Local B.Bone

For B.Bone=Each Bone
If B\J1=JSearch
Return B
EndIf
Next

Return Null
End Function

Function GetNextBone.Bone(BSearch.Bone)
Local B.Bone

For B.Bone=Each Bone
If B\J1=BSearch\J2
Return B
EndIf
Next

Return Null
End Function

Function RescaleBones()
Local JFix.Joint, J.Joint, B.Bone, DX#, DY#, DL#

JFix=GetNextFixedJoint(JFix)

While JFix<>Null
B=GetBone(JFix)

While B<>Null
DX=B\J2\X-B\J1\X
DY=B\J2\Y-B\J1\Y
DL=Sqr(DX*DX+DY*DY)

DX=DX/DL
DY=DY/DL

B\J2\X=B\J1\X+DX*B\Length
B\J2\Y=B\J1\Y+DY*B\Length

B=GetNextBone(B)
Wend

JFix=GetNextFixedJoint(JFix)
Wend
End Function

Function IKStep(JStart.Joint)
Local J.Joint, B.Bone, DX#, DY#, NX#, NY#, NL#, FX#, FY#, FL#, DP#, DXN#, DYN#

If Not JStart\Fixed
Return
EndIf

B=GetBone(JStart)

While B<>Null
DX=B\J2\X-B\J1\X
DY=B\J2\Y-B\J1\Y

NX=DY
NY=-DX
NL=Sqr(NX*NX+NY*NY)

NX=NX/NL
NY=NY/NL

FX=B\J2\TX-B\J2\X
FY=B\J2\TY-B\J2\Y
FL=Sqr(FX*FX+FY*FY)

FX=FX/FL
FY=FY/FL

DP=FX*NX+FY*NY
DP=DP

If FL>1
J=B\J2

While J<>Null
TurnJointAroundCenter(J, B\J1\X, B\J1\Y, DP)

J=GetNextJoint(J)
DP=DP/2.
Wend
EndIf

B=GetNextBone(B)
Wend

RescaleBones()
End Function

Global NaN#=1./Floor(0.1)
Function IKSolverRnd(JStart.Joint, TX#, TY#)
Local Phi#[100], R#[100], PStopX#, PStopY#, OldD#, NewD#, PhiNew#[100], J.Joint, B.Bone, DX#, DY#, oDX#, oDY#, N, PX#, PY#, MAX, TOL#

N=0
MAX=50000
TOL=3

B=GetBone(JStart)
oDX=1
oDY=0

While B<>Null
DX=B\J2\X-B\J1\X
DY=B\J2\Y-B\J1\Y

Phi[N]=ACos((oDX*DX+oDY*DY)/(B\Length*Sqr(oDX*oDX+oDY*oDY)))
R[N]=B\Length

If Phi[N]=NaN
Phi[N]=0
EndIf

N=N+1

B=GetNextBone(B)
oDX=DX
oDY=DY
Wend

For k=1 To MAX
PStopX=F1(JStart\X, R, Phi, N-1)
PStopY=F2(JStart\Y, R, Phi, N-1)

OldD=Sqr((PStopX-TX)^2+(PStopY-TY)^2)

SeedRnd(MilliSecs())
For i=0 To N-1
PhiNew[i]=Phi[i]+Rnd(-1.00,1.00)
Next

PStopX=F1(JStart\X, R, PhiNew, N-1)
PStopY=F2(JStart\Y, R, PhiNew, N-1)

NewD=Sqr((PStopX-TX)^2+(PStopY-TY)^2)

If NewD<OldD
For i=0 To N-1
Phi[i]=PhiNew[i]
Next
EndIf

If NewD<TOL
Exit
EndIf
Next

N=0

J=JStart
While J<>Null
J\TX=F1(JStart\X, R, Phi, N-1)
J\TY=F2(JStart\Y, R, Phi, N-1)

N=N+1

J=GetNextJoint(J)
Wend
End Function

Function TurnJointAroundCenter(J.Joint, CX#, CY#, Angle#)
Local DX#, DY#, DXN#, DYN#

DX=J\X-CX
DY=J\Y-CY

DXN=Cos(Angle)*DX+Sin(Angle)*DY
DYN=Cos(Angle)*DY-Sin(Angle)*DX

J\X=CX+DXN
J\Y=CY+DYN
End Function

Function F1#(PStartX#, R#[100], Phi#[100], N)
Local w#, pSum#

w=PStartX

For i=0 To N
pSum=0

For j=0 To i
pSum=pSum+Phi[j]
Next

w=w+Cos(pSum)*R[i]
Next

Return w
End Function

Function F2#(PStartY#, R#[100], Phi#[100], N)
Local w#, pSum#

w=PStartY

For i=0 To N
pSum=0

For j=0 To i
pSum=pSum+Phi[j]
Next

w=w-Sin(pSum)*R[i]
Next

Return w
End Function

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

Local N=2

Local sJ.Joint[100], sB.Bone[100]
Local TX#, TY#, Start

Start=False

For i=0 To N-1
sJ[i]=New Joint
sJ[i]\X=100+i*(700./(2*N))
sJ[i]\Y=300

If i=0
sJ[i]\Fixed=True
EndIf

If i>0
sB[i-1]=New Bone
sB[i-1]\J1=sJ[i-1]
sB[i-1]\J2=sJ[i]

CalcBoneLength(sB[i-1])
EndIf
Next

; Winkel werden relativ zum vorherigen angegeben
;ZielX = StartX + Summe( +cos( Summe( Winkel ) ) * Laenge )
;ZielY = StartY + Summe( -sin( Summe( Winkel ) ) * Laenge )

Local Timer=CreateTimer(60)
While Not KeyHit(1)
Draw()

If MouseHit(1)
TX=MouseX()
TY=MouseY()

Start=True

CalcTime=MilliSecs()
IKSolverRnd(sJ[0], TX, TY)
CalcTime=MilliSecs()-CalcTime
EndIf

If MouseHit(2)
J1.Joint=sJ[N-1]
J2.Joint=sJ[N-2]

DX#=J1\x-J2\x
DY#=J1\y-J2\y

J.Joint=New Joint
J\x=J1\x+DX
J\y=J1\y+DY

B.Bone=New Bone
B\J1=J1
B\J2=J

CalcBoneLength(B)

sJ[N]=J
N=N+1
EndIf

Text 10,30,"Time to calculate Endposition: "+CalcTime+"ms"
Text 10,50,"Number of Joints in Chain: "+N

If Start
Rect TX-3,TY-3,6,6

IKStep(sJ[0])
EndIf

fps=fps+1
If MilliSecs()-fpstimer>999
fpscur=fps
fps=0
fpstimer=MilliSecs()
EndIf
Text 10,10,"FPS: "+fpscur

Flip 0
Cls

WaitTimer(Timer)
Wend
End


Mit Linksklick setzt man den Zielpunkt, mit Rechtsklick kann man neue Gelenke erstellen (sie werden automatisch am Ende der Kette angefügt). Mit dem lokalen Parameter N kann man steuern wie viele Gelenke am Anfang sind und wie lange ein Arm ist. Das System funktioniert relativ flüssig, und hat Berechnungszeiten von ca. 10-100ms, es kann aber auch vorkommen, dass es sich "verläuft" und man hat eine Berechnungszeit von 600-1200ms. Aber da diese Rechnung nur einmal gemacht wird und danach das Programm sich einen Weg sucht die Einstellung zu erreichen merkt man nicht viel mehr als einen kleinen Schluckauf im Programm. Auch hier noch ein hübsches Bildchen dazu:
user posted image

Ich hoffe immernoch darauf einen besseren Lösungsweg zu finden, aber das Programm ist momentan so dynamisch dass ich den ohne Weiteres einbauen kann.
Falls irgendjemand eine gute Möglichkeit kennt das Ausgleichssystem zu lösen dann wäre ich dankbar für einen Link oder etwas in der Art.

Ich wünsche schonmal ein schönes neues Jahr und einen flutschen Rutsch,
MfG,
Darth

Gehe zu Seite Zurück  1, 2, 3  Weiter