BlitzBasic Portal Worklogs - DaDaPlayground

HO HO HO, I'm back!

darth — Sun, 25 Dec 2011 20:26:33 +0100

Hallo,

im letzten Worklog hatte ich angekündigt mit BlitzBasic aufzuhören. Daran hat sich eigentlich nicht viel geändert. Vielmehr habe ich mich endlich dazu aufgerafft, richtig C/C++ zu lernen (und C#, aber das ist ein anderes Thema). Aber ich habe meine "Wurzeln" nicht vergessen, und darum bin ich heute hier. Nach Umwegen.

Ich hatte, wie gesagt, beschlossen, mit C++ weiterzumachen. Das führte natürlich dazu, dass ich meine tollen Funktionssammlungen ("Libraries") von BlitzBasic nach C++ portieren musste. Dies geschah auch mit meiner RigidBody-Physik. Da nun also der Code schon bestand dachte ich mir vor ein paar Tagen, dass ich doch eine lustige DLL für BB daraus zaubern könnte. Also habe ich mich hingesetzt und angefangen.

Und ich kann euch sagen: BB ist beschissen. Echt beschissen. Die Sprache hat sich gesträubt wo sie nur konnte. Ich kann in meinem C++ Struct nur Arrays und Basis-Datentypen (float, int) verwenden, alles andere führt über kurz oder lang zu MAVs und das ärgert - enorm! Das hat mich gezwungen, meine wundervolle Codestruktur komplett über den Haufen zu werfen, alle einfachen Operatorenüberladungen zu verwerfen (weil ich ja keine Position in einem Vektor speichern darf..) und das meiste neu zu machen. Natürlich führt das auch dazu, dass die DLL in ihrem Funktionsumfang gegenüber anderen Versionen eingeschränkt ist.

Eine kurze Liste von Einschränkungen:
- keine konkaven Formen
- kein Splittern (zugegeben, das habe ich noch gar nicht umgesetzt in C++)
- kein Wasser (auch nicht umgesetzt in C++)

Und dennoch: Die Grundfunktionalität (Rigid-Body-Physics für konvexe Formen) ist vorhanden. Objekte werden automatisch zu Meshes verwandelt und angezeigt. Leider kam ich nicht um etwas Glue-Code herum, d.h ihr müsst trotzdem noch ein *.bb-File mitschleppen (darin sind Typen definiert und gewisse Meshdinge müssen weitergeleitet werden, weil ich das Mesh nicht direkt in der DLL behandeln kann). Zusätzliche Dinge wie Texturen habe ich (natürlich) BlitzBasic überlassen. Ihr könnt euch das Mesh über eine Funktion holen und dann bearbeiten wie es euch beliebt.

Und hier ist sie nun:

Wie ihr mit DLLs umgehen müsst sollte eigentlich bekannt sein (zusammen mit der DECLS-Datei in den Userlib Ordner eurer BlitzBasic-Installtion packen und gut ist). Xeres hat mich noch darauf hingewiesen, dass man die DLL dem compilierten Programm beilegen muss, wenn mans weiterverbreiten will. Klingt eigentlich logisch :>
Hier ein Beispiel, wie ein Code aussehen könnte:

[syntax="bb"]Include "DaDaPhysics.bb"

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

pCreateCamera()

Local ground.RBody = New RBody

pCreateRect(ground, 800, 20)
pSetDensity(ground, 0)
pSetPosition(ground, 400, 500)
pAddObject(ground)

Local timer = CreateTimer(60)

While Not KeyHit(1)
RenderWorld

pUpdate()

If MouseHit(1)
Local box.RBody = New RBody

pCreateRect(box, 50, 50)
pSetDensity(box, 0.1)
pSetPosition(box, MouseX(), MouseY())
pSetRotation(box, 0)
pAddObject(box)
pSetColor(box, Rand(0, 255), Rand(0, 255), Rand(0, 255))
EndIf

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

Flip 0
WaitTimer(timer)
Cls
Wend
End[/syntax]

So. Ich habe festgestellt, dass es noch irgendwo ein Speicherleck hat, werde ich fixen sobald ich es finde. Aber im Moment ruhe ich mich darauf aus, dass es funktioniert. Zum Teil stürzt der bcc nach Beenden des Programmes ab, keine Ahnung woran das liegt, sollte ich das rausfinden, werde ich auch das noch beheben.
EDIT: Das Memoryleak ist behoben. Ich bin nicht 100% sicher woran es lag (ich habe temporäre Polygone in eine Liste gefügt und am Schluss die komplette Liste gelöscht, aber scheinbar bliebt immer was über.. jetzt lösch ich sie direkt), aber der Memoryverbrauch ist jetzt stabil. Der (mögliche) Absturz nach Beenden des Programmes verwirrt mich nachwievor. Für Vorschläge bin ich dankbar - gilt auch allgemein für Bug-Reports.

Hier eine Liste der Funktionen:

Code: [AUSKLAPPEN]

pCreateCamera()
pUpdate()
pAddObject(RBody)

pAddVertex(RBody, x, y)
pCreateRect(RBody, w, h)
pCreateCircle(RBody, w, n)

pSetDensity(RBody, d)
pSetPosition(RBody, x, y)
pSetRotation(RBody, r) <- in DEG

pSetColor(RBody, red, grn, blu)

pAddForce(RBody, x, y)
pAddForceR(RBody, fx, fy, px, py) <- Punkt relativ zum Körper-Mittelpunkt
pAddForceA(RBody, fx, fy, px, py) <- Punkt absolut in Weltkoordinaten

pGetPosX(RBody)
pGetPosY(RBody)
pGetVelX(RBody)
pGetVelY(RBody)
pGetRot(RBody)
pGetVelA(RBody)

pGetMass(RBody)

pSetGravity(x, y)

pDegToRad(r)
pRadToDeg(r)

pGetMesh(RBody)

Dies sollten die wichtigsten Funktionen sein, die man braucht. Sollten noch zusätzliche benötigt werden, lassen sich diese ohne viel Aufwand (von mir) einbauen, über eine Meldung diesbezüglich wäre ich froh.
Ich kenne mich Lizenzmässig überhaupt nicht aus, aber ihr seid eigentlich ziemlich frei die DLL zu benutzen, aber egal was ihr damit anstellt: ich bin nicht verantwortlich dafür (!!).
Ihr solltet es aber irgendwo angeben, wenn ihr meine Lib benutzt, damit Leute sehen, von wem die coole Physik in euren Spielen stammt und mich alle lieben werden (weil ich cool bin!).

Tja, dies wäre mein Weihnachtsgeschenk an das Forum. Mal sehen was draus wird
MfG,
Darth

Das Ende ist nah

darth — Sat, 19 Feb 2011 13:12:11 +0100

Hallo,

ich bin gerade dabei, meine Tätigkeiten mit Blitzbasic einzustellen. Die Sprache eignet sich, um schnell kleine Dinge auszuprobieren, aber je länger ich versuche etwas Grösseres damit zu machen, kriege ich Probleme. Ausserdem macht die schwindende Unterstützung der Sprache zu schaffen, man kennt das ja. Ich könnte ja nach BlitzMax umsteigen, aber ich habe eigentlich keine Lust für eine (weitere) Sprache zu zahlen :/ Von der Uni her muss ich sowieso mit anderen Sprachen arbeiten (Java, Matlab, Fortran,..), ich habe genug Auswahl um weiter machen zu können :> Allerdings darf ich die Dinge hier ja nicht vorstelle, weil mich sonst der böse BladeRunner tötet.. und tote Darths sind voll uncool!

Nun denn, ich versuche mal mein Zeug zusammenzutragen, damit ich (vor allem für mich, ich bin ja egoistisch) eine Liste meiner bisherigen Arbeiten habe. (Download-Links sind in den Titeln, booyaah!)

DaDaPhysics

Der aktuelle (irgendwas vor 19.2.11) Stand meiner Physik-Routinen. Ich habe die Einzelteile ein wenig aufgezettelt. Die Stücke fügen sich über ein include gegenseitig hinzu (was halt gerade benötigt wird), da BlitzBasic das zirkuläre-include unterbindet, ist das kein Problem. Die Programme haben Testfunktionen dabei, die ein kleines Programm starten das die Funktionen aufzeigt.

Der momentane Stand ist: Man kann (konkave) Polygone eingeben, die automatisch in konvexe Einzelstücke zerlegt werden. Das Zeichnen der Polygone unterstützt nebst dem normalen Füllalgorithmus auch eine Möglichkeit das Objekt zu texturieren. Weitere Funktionen sind das automatische Zerbrechen von Polygonen (das ~ experimentell ist..) und eine Wasserbox, in der physikalische Objekte schwimmen können.

Graphen

Von der Uni her etwas Graphentheorie.
AVL-Bäume sind eine Sonderart von binären Bäumen, sie sind so gemacht, dass die einzelnen Äste ausgewogen sind. Dazu muss man beim Einfügen und Entfernen bestimmte Regeln beachten. Ein kleines Implementationsproblem ist, dass sich die Wurzel verschieben kann. Also muss die bei jedem Einfügevorgang zurückgeliefert und aufgefangen werden.

Der Dijkstra Algorithmus ist eine Art "Pfadfinder" in einem gewichteten Graphen. Hier ist keine Testfunktion dabei, aber die Funktionen und Felder sollten ausführlich genug erklärt sein.
Zusätzlich noch einen Labyrinth-Generator um einen A*-Pathfinder zu testen.

Grafisches

Was man so mit Punkten halt machen kann. Zum Beispiel eine Konvexe Hülle darum ziehen, in O(n log n). Dabei ist auch eine Delaunay-Triangulierung. Was fehlt (und was ich eigentlich immer mal machen wollte) ist eine saubere Voronoi-Zerlegung. Aber das sollte eigentlich nicht so schwer sein, sollte man meinen -.- trotzdem hab ichs nie gemacht.

Edit:

Als kleines "Abschiedsgeschenk" :> Ich habe die Voronoi-Zerlegung eingebaut. Wird aus der Delaunay-Triangulierung generiert. Zusätzlich sind noch einige Testfunktionen dabei, die nichtmehr verwendet werden. Die Berechnung eines Dreieck-Umkreises, Linienschnitte und Ähnliches. Das wars.

Mathematik

Ein Stringparser, der durch ein bisschen String-Numerik unterstützt wird. Dabei ist eine Funktion, die Terme auf ihre Korrektheit prüft. Unterstütz werden automatisch die mir bekannten mathematischen Funktionen (sin, cos,..). Neue einzubauen ist ziemlich einfach (einfach die Liste ergänzen). Numerisch unterstützt werden Integration, Differentiation und einfache Nullstellenfindung.
Dazu eine kleine Bibliothek um Matrizen zu verwalten und zu benutzen. Die meisten Funktionen räumen selber auf, aber sicherheitshalber ist ein GarbageCollector dabei. Der Funktionsumfang beinhaltet so ziemlich alles was mir eingefallen ist, bis auf Eigenwerte/Eigenvektoren. (Wens interessiert: Ich habe in Java eine SVD-Zerlegung geschrieben, die die Eigenwerte aus der Matrix numerisch annähert.)

Figuren

Der Grund weshalb ich so lange in BlitzBasic verweilte. Meine 2D (gibts auch in 3D, aber nicht so ausgearbeitet..) Bone-Figuren. Mittlerweilen ist auch ein bisschen GUI-Zeug dabei, um damit umzugehen. Geplant war ein Editor um Figuren zu bauen und dann zu animieren, ist auf dem halben Weg stehen geblieben :> (ich hasse Programm Design..). Dabei ist auch eine Funktion um Schatten von der Figur auf einen beliebigen Hintergrund zu projezieren, siehe Testprogramm.

Beiliegend sind ein Player und ein Animations-Generator für die Figuren. Die Knöpfe sind nicht erklärt, aber ihre Funktion sollten aus den Namen im Programm erschlossen werden können. Zusätzlich dabei ist eine allgemein einsetzbare Scrollbar und ein Explorer-ähnliches Dateiauswahl Fenster (allerdings werden noch keine Dateien zurückgeliefert, ist also in dem Zustand nur zur Suche einsetzbar, ein Return fehlt).

Bäume

Etwas neues, das ich bisher noch nicht gezeigt habe, einen Baum-Generator. In einem beigelegten Input-File kann man verschiedene Parameter einstellen, aus diesen werden dann zufällige Bäume generiert. Der Baum ist am Ende als Mesh-Feld in einem Type gespeichert. (Die Funktionsnamen sind vielleicht etwas irreführend.. anfangs war es 2D.)

Die Bäume haben (mit den Parametern im Beispiel) etwa 500-1000 Triangles, hängt allerdings stark von der Iterationstiefe und Anzahl Astunterteilungen ab. Zusätzlich kann man verschiedene Wahrscheinlichkeiten einstellen. Ich hoffe, die Parameternamen sind selbsterklärend genug.

Ende

So. Das sind wohl so etwa die nützlichsten und mir wichtigsten Programme und Funktionen die ich bisher in BlitzBasic geschrieben habe. Natürlich wären noch viele kleine Fitzelchen hier und da, vieles das ich im Worklog mal vorgestellt habe und dann wieder vergessen. Aber die oben erwähnten Stücke sind die, die ich immer mal wieder zu Rate ziehe oder verwende um etwas daraus zu machen.
Da ich BB nachwievor für kleine Tests benutzen werde, wird vielleicht hin und wieder etwas Neues entstehen, aber ich werde nichtmehr gezielt für/mit BlitzBasic programmieren. Ich wünsche aber allen, die weiterhin mit diesen Sprachen arbeiten viel Spass und Erfolg.

MfG,
Darth

Ferien ohne Internet

darth — Sun, 09 Jan 2011 13:35:53 +0100

Hallo,

ich war mal wieder ein wenig in den Ferien und habe festgestellt, dass man äusserst produktiv sein kann, wenn man kein Internet hat, das einen ständig mit neuem Inhalt ablenkt. Daher habe ich wieder einiges zu präsentieren, kleineres sowie grösseres. Dann mal frisch ans Werk.

RayTracer

Ich habe als Teil meiner Maturarbeit mal einen kleinen Raytracer geschrieben. Den fand ich leider nichtmehr, aber ich habe ihn als ziemlich schrecklich in Erinnerung. Ein ziemlich instabiles Konstrukt und viele wichtige Teile hardcoded. Ich habe daher mal beschlossen, einen neuen Versuch zu wagen. Es war nicht das Ziel, einen bis ins letzte optimierte Maschine zu schreiben. Ich wollte einfach nochmal eine Version haben, anhand derer man die Funktionsweise sehen kann, und die ziemlich einfach erweiterbar sein sollte.
Ich habe darauf verzichtet, die üblichen kleinen Tricks einzubauen (Kugeln als wirkliche Kugeln erkennen z.B), er basiert alleine auf Dreiecken, und bringt daher nicht die üblichen tollen Bilder einer perfekten Kugel in der sich dann ein Boden perfekt spiegelt.
Auch auf Lichter habe ich bis anhin verzichtet (das könnte noch folgen), aus dem einfachen Grund meiner Faulheit :> Zudem war ich nicht ganz sicher, wie ein Raytracer mit Lichtern umzugehen pflegt, wenn sie z.B auf eine spiegelnde Fläche treffen. Ich habe es im Moment so gemacht, dass ich eine „Lichtquelle“ (= Kamera) habe, die sich dann auch im Spiegel spiegelt und von dieser dann die Helligkeit der Fläche berechnet wird.
Der Raytracer unterstützt auch Textur und Heightmap (die noch etwas experimentell ist, aufgrund des Lichtvektors den ich „verzerre“..). Den Teil möchte ich gerne etwas genauer erläutern, weil ich das Problem nun etwa zum dritten mal neu gelöst habe, und das langsam nervt. Also habe ich mich mal hingesetzt und mir genauer aufgeschrieben, was ich eigentlich berechne. Vielleicht hilft es ja dem einen oder anderen, der ein ähnliches Problem hat.

Problemstellung: Ich habe einen Punkt P = (x/y/z) in der Ebene des Dreiecks T = (p1, p2, p3). Ich brauche die UV-Koordinaten des Punktes.
Gelöst werden muss die Gleichung: P = p1 +a *v1 + b *v2

Lösungsansatz: (Ich gehe davon aus, dass die Funktion einer Matrixmultiplikation bekannt ist)
Die Gleichung ist überdefiniert. Ich muss 3 Gleichungen (für x, y und z) nach 2 Parametern (a und b) auflösen. Man benutze hier den Ansatz der minimierung des quadratischen Fehlers.

Man definiere die Matrix A = [ v1 | v2 ], den Vektor x = [a ; b] und den Vektor b = P – p1.
Das Gleichungssystem lautet also Ax = b (immernoch überdefiniert). Man multipliziere nun von links die transponierte der Matrix A hinzu, man erhält: A' A x = A' b. Dieses System ist jetzt eine 2x2 Matrix mal ein 2x1 Vektor gleich einem anderen 2x1 Vektor. Also standardmässig Lösbar.
Lösung: x = (A' A)^-1 * (A' b). Da (A' A) = M eine 2x2 Matrix ist, ist die Inversion ziemlich einfach. Die Inverse von M ist M^-1 = 1/det(M) * [m22, -m12; -m21, m11]. Auch die Determinante ist einfach zu berechnen. det(M) = m11*m22 – m12*m21. (Wobei durch die spezielle Form hier gilt, dass m12 = m21).
M kann einfach über die Vektoren berechnet werden, auch y = A' b ist einfach errechenbar.
Die erhaltenen Koeffizienten a und b sind die „pseudo-UV“ Koordinaten.

Bemerkungen:
- Falls gilt: a >= 0 und b >= 0 und a+b <= 1, liegt der Punkt innerhalb des Dreiecks. (Kann man sich einfach durch aufzeichnen des Parallelogramms erklären.)
- Die tatsächlichen UV-Koordinaten ergeben sich dann aus C = c1 +a *(c3-c1) +b *(c2-c1), wobei ci die UV-Koordinaten der jeweiligen Punkte pi sind.

[syntax="bb"]Function getTextureColor.TVector3D( x#, y#, z#, t.TTrig3D, light.TVector3D )
Local v0.TVector3D, v1.TVector3D, v2.TVector3D

v0=newTVector3D(t\p3\x-t\p1\x, t\p3\y-t\p1\y, t\p3\z-t\p1\z)
v1=newTVector3D(t\p2\x-t\p1\x, t\p2\y-t\p1\y, t\p2\z-t\p1\z)
v2=newTVector3D(x-t\p1\x, y-t\p1\y, z-t\p1\z)

Local dot00#, dot01#, dot02#, dot11#, dot12#

dot00=vDot(v0, v0)
dot01=vDot(v0, v1)
dot02=vDot(v0, v2)
dot11=vDot(v1, v1)
dot12=vDot(v1, v2)

Delete v0
Delete v1
Delete v2

Local invDet#=1./(dot00*dot11 - dot01*dot01)
Local a#=(dot11*dot02 - dot01*dot12)*invDet
Local b#=(dot00*dot12 - dot01*dot02)*invDet

Local uv1.TVector3D, uv2.TVector3D

uv1 = newTVector3D(t\p3\u-t\p1\u, t\p3\v-t\p1\v, 0)
uv2 = newTVector3D(t\p2\u-t\p1\u, t\p2\v-t\p1\v, 0)

Local u#, v#

u = t\p1\u +a *uv1\x +b *uv2\x
v = t\p1\v +a *uv1\y +b *uv2\y

Delete uv1
Delete uv2

Local col = getStdRGB(t\tex, u, v)
Local cr, cg, cb

cr = (col And $FF0000 )/$10000
cg = (col And $FF00 )/$100
cb = (col And $FF )

Return newTVector3D(cr, cg, cb)
End Function[/syntax]

Oben sieht man ein kleines Ergebnis des Raytracers. Ich verzichte darauf, den gesamten Code zu posten. Es gibt hunderte davon im Internet (viele davon um Längen besser), und es wäre sinnlos einen weiteren hinzuzufügen.
Ich bin grad noch dabei, den Prozess durch einen Octree etwas zu optimieren. Allerdings fehlt mir momentan eine Methode für Ray-Box-Intersection. Sowas muss ich noch suchen :/ Ich habe es auf 2D mal kurz ausprobiert (Quadtree und Ray-Rect-Intersection). Das sollte sich eigentlich relativ einfach auf 3D konvertieren lassen, und dann das Traceverfahren anpassen und bla bla bla.

Parser

Ich habe vor einiger Zeit mal einen Stringparser gepostet. Den wollte ich mal weiterführen und etwas ausbauen. Leider musste ich feststellen, dass er (ganz ähnlich dem alten Raytracer) ziemlich steif programmiert ist und absolut unverständlich. Ich habe ehrlich gesagt keine Ahnung mehr was die Hälfte der Schleifen da macht Ich weiss noch, dass ich Klammer gesetzt habe um Punkt-vor-Strich zu erzwingen und dann die Klammerausdrücke durch die Auswertung ersetzt habe. Das ganze absolut nicht rekursiv (wieso auch -.-) ... und ja :/ es hat funktioniert, ist aber unmöglich damit weiterzuarbeiten.
Darum habe ich auch hier neu angefangen \o/. Herausgekommen ist ein Produkt, auf das ich ehrlich stolz bin (jedenfalls im Moment..). Ich habe vor, daraus eine Art „MathPad“ zu machen. Vielleicht erinnert sich der eine oder andere noch an meine Float Numerics. Die habe ich jetzt auch so umgeformt, dass sie in meine Parserstruktur passen. Sie benötigen nun nichtmehr fix definierte Funktionen (das ist so geil!), sondern können mit einem String aufgerufen werden, der dann als Funktion interpretiert und geparst wird!

[syntax="bb"]Function parse$( term$ )
;DebugLog "INPUT: "+term

If checkTerm(term) = 0
Return "NaN"
EndIf

Local signs$ = "+-*/^"
Local signPos, sign$

; --a
If Mid(term, 1, 2) = "--"
term = Mid(term, 3, -1)
EndIf

For j = 2 To Len(term)
For i = 1 To Len(signs)
If Mid(term, j, 1) = Mid(signs, i, 1)
If signPos = 0
signPos = j
sign = Mid(signs, i, 1)
EndIf
EndIf
Next
Next

Local lhs$, rhs$, mt$

lhs = checkForSmallNumbers( Mid(term, 1, signPos-1) )
rhs = checkForSmallNumbers( Mid(term, signPos+1, -1) )

Local result$

If ( isNumber(lhs)+isText(lhs) = 1 ) And ( isNumber(rhs)+isText(rhs) = 1 )

;/* *\
; * cannot handle "text" *
; * only numerical calc *
;\* */

If lhs = "NaN" Or rhs = "NaN" Or lhs = "Infinity" Or rhs = "Infinity"
result = "NaN"
Else
Select sign
Case "+"
result = Float(lhs) + Float(rhs)
Case "-"
result = Float(lhs) - Float(rhs)
Case "*"
result = Float(lhs) * Float(rhs)
Case "/"
If Float(rhs) < 10^-8
result = "NaN"
Else
result = Float(lhs) / Float(rhs)
EndIf
Case "^"
result = Float(lhs) ^ Float(rhs)
Case "", " "
result = Float(lhs)
End Select
EndIf

result = checkForSmallNumbers( result )

;DebugLog "OUTPUT: "+result
Return result
Else
If Instr(term, "(")
;klammern

Local bOpen, bPosL, bPosR, calcPos
Local fnc$

bPosL = Instr(term, "(")

For j = bPosL To Len(term)
If Mid(term, j, 1) = "("
bOpen = bOpen +1
EndIf

If Mid(term, j, 1) = ")"
bOpen = bOpen -1
EndIf

If bOpen = 0
bPosR = j

Exit
EndIf
Next

If bPosL = 1
;klammer steht ganz links

lhs = Mid(term, 2, bPosR-bPosL-1)
rhs = Mid(term, bPosR+1, -1)

Return parse( parse(lhs)+rhs )
;ElseIf bPosR = Len(term)
; ;klammer steht ganz rechts
;
; lhs = Mid(term, 1, bPosL-1)
; rhs = Mid(term, bPosL+1, bPosR-bPosL-1)
;
; Return parse( lhs+parse(rhs) )
Else
;klammer steht irgendwo in der mitte

lhs = Mid(term, 1, bPosL-1)
rhs = Mid(term, bPosR+1, -1)
mt = Mid(term, bPosL+1, bPosR-bPosL-1)

;functions?
calcPos = 0
For j = bPosL-1 To 1 Step -1
For i = 1 To Len(signs)
If Mid(term, j, 1) = Mid(signs, i, 1)
If calcPos = 0
calcPos = j
EndIf
EndIf
Next
Next

fnc = Lower( Mid(term, calcPos+1, bPosL-calcPos-1) )
If isText(fnc)
lhs = Mid(term, 1, calcPos)

Select fnc
Case "sin"
mt = Sin( Float( parse(mt) ) )
Case "cos"
mt = Cos( Float( parse(mt) ) )
Case "tan"
mt = Tan( Float( parse(mt) ) )
Case "asin"
mt = ASin( Float( parse(mt) ) )
Case "acos"
mt = ACos( Float( parse(mt) ) )
Case "atan"
mt = ATan( Float( parse(mt) ) )
Case "sqr", "sqrt"
mt = Sqr( Float( parse(mt) ) )
Default
termError( lhs+fnc+mt+rhs, calcPos+1, bPosL-1, "Unknown function")

Return "NaN"
End Select

Return parse( lhs+mt+rhs )
Else
Return parse( lhs+parse(mt)+rhs )
EndIf
EndIf
Else
;punkt vor strich, hoch vor allem

If Instr(term, "*") Or Instr(term, "/") Or Instr(term, "^")
Local leftCalc, rightCalc

If Instr(term, "^")
For k = 2 To Len(term)
If Mid(term, k, 1) = "^"
Exit
EndIf
Next
Else
For k = 2 To Len(term)
If Mid(term, k, 1) = "*" Or Mid(term, k, 1) = "/"
Exit
EndIf
Next
EndIf

For i = 1 To Len(signs)
For j = 2 To Len(term)
If Mid(term, j, 1) = Mid(signs, i, 1)
If j < k
If j > leftCalc
leftCalc = j
EndIf
ElseIf j > k
; a*-b
If Not ( j = k+1 And Mid(term, j, 1)="-" )
If rightCalc = 0
rightCalc = j
EndIf
EndIf
EndIf
EndIf
Next
Next

If leftCalc = 0
;punkt/hoch steht ganz links

lhs = Mid(term, 1, rightCalc-1)
rhs = Mid(term, rightCalc, -1)

Return parse( parse(lhs)+rhs )
ElseIf rightCalc = 0
;punkt/hoch steht ganz rechts

lhs = Mid(term, 1, leftCalc)
rhs = Mid(term, leftCalc+1, -1)

Return parse( lhs+parse(rhs) )
Else
;punkt/hoch steht in der mitte

lhs = Mid(term, 1, leftCalc)
rhs = Mid(term, rightCalc, -1)
mt = Mid(term, leftCalc+1, rightCalc-leftCalc-1)

Return parse( lhs+parse(mt)+rhs )
EndIf
Else
;normale links -> rechts rechnung

Local calcFound = 0
Local calcPos1, calcPos2

For i = 1 To Len(signs)
For j = 2 To Len(term)
If Mid(term, j, 1) = Mid(signs, i, 1)
If calcFound = 0
calcPos1 = j

calcFound = calcFound +1
ElseIf calcFound = 1
; a+-b
If Not ( Mid(term, j, 1) = "-" And j = calcPos1+1 )
calcPos2 = j

calcFound = calcFound +1
EndIf
EndIf
EndIf
Next
Next

lhs = Mid(term, 1, calcPos2-1)
rhs = Mid(term, calcPos2, -1)

Return parse( parse(lhs)+rhs )
EndIf
EndIf
EndIf
End Function[/syntax]

Geplant waren zusätzlich zur normalen Termauswertung: Integration, Differentiation und ein einfacher Solver (der momentan eine „böse“ Schwäche hat, man muss die Gleichung so umformen, dass sie =0 ist). Der Solver soll eigentlich mal noch ausgebaut werden. Die Schwäche entfernt (natürlich) und dann soll er auch mehrdimensionale lineare (und vllt nicht-lineare?) Gleichungssysteme lösen können! Dafür würde ich dann den Parser mit meiner TMatrix-Klasse verbinden, die ich auch schon vorgestellt habe.

Auf dem Bild sieht man einige Beispiele die ich in meinem provisorischen „MathPad“ einprogrammiert habe. Dafür habe ich auch voll professionell eine GetKey-Input Routine geschrieben, die dann in Textzeilen umgewandelt wird. Man kann auch scrollen und mit dem Cursor irgendwo in der Mitte Text ändern (eintippen, löschen). Sollte ich irgendwann einmal die Musse haben, werde ich einen kleinen Editor darum herum programmieren, mit (cooler) GUI und so. Aber wahrscheinlicher ist, (da ich das Ganze eh schon nach Java portiert habe), dass ich die dort (= Java) schon vorhandene GUI verwenden werde.

Download: Parser und Numerics
Download: (Pseudo-) Editor

TMatrix

Im Zuge des Parsers habe ich mir auch nochmal die TMatrix-Klasse angesehen. Dabei habe ich festgestellt, dass noch zwei wichtige Funktionen fehlten. (Wahrscheinlich fehlen noch mehr, die werde ich dann implementieren, sobald es mir auffällt.)
tMInvert: Diese Funktion hat mich einige Zeit gekostet. Vor allem, weil ich das Prinzip falsch im Kopf hatte.. Ich habe es dann aber nach einigem herumprobieren mit Matlab geschafft, herauszufinden was ich überhaupt programmieren muss. Und es dann flux in meine Klasse eingebaut. Matrizen können nun invertiert werden. Sie muss natürlich quadratisch und nicht singulär sein.
tMDeterminant: Keine Ahnung, warum ich die nicht schon viel früher eingebaut hab. Die Determinante wird rekursiv über die Unterdeterminanten berechnet. Die einzige Schwierigkeit dabei ist, die Untermatrix zu schreiben, aber selbst das geht nach 5min.
Geplant: Was ich noch vorhatte war, das Implementieren einer Lösung für unausgeglichene Systeme. Wenn also 3 Gleichungen für nur 2 Variabeln vorhanden sind (z.B). Das wäre auch kein grosses Ding, ich müsste statt Ax = b einfach A'Ax = A'b lösen. Ich könnte das sogar direkt in den Gauss-Löser einbauen, für jeden Fall (bei ausgeglichenen Systemen ändert sich nichts an der Lösung). Dies würde allerdings einen Mehraufwand bedeuten und ich bin mir nicht sicher, ob ich das einfach so still und heimlich durchführen lassen sollte :/ Zudem bin ich mir nicht mehr sicher, ob das auch für unterdefinierte Systeme (2 Gleichungen für 3 Variabeln) funktioniert, das muss ich nochmal kurz nachlesen.
Ebenfalls wollte ich Eigenwerte und Eigenvektoren ausrechnen, aber das ist ziemlich schwer musste ich feststellen. Ich habs nicht einmal hingekriegt, das charakteristische Polynom richtig aufzustellen, und ohne das.. kein Gras. Und auch keine Eigenwerte und damit auch keine Eigenvektoren. Traurig. Ich muss mir wohl mal den SVD-Algorithmus ansehen.

[syntax="bb"]Function tMInvert.TMatrix(A.TMatrix, flag=False)
Local R.TMatrix, Ac.TMatrix, v#, c#, tmp#, switch

;für quadratische Matrizen, A=R^{n,n}
If A\n<>A\m
RuntimeError "Matrix must be square"
EndIf

R=tMIdentity(A\n)
Ac=tMClone(A)

For i=1 To A\n
v=tMGetValue(Ac, i, i)

If Abs(v)<10^-6
switch = False
For ii=i+1 To A\n
If Abs(tMGetValue(Ac, ii, i)) > 10^-6
switch = True

For jj=1 To A\n
tmp = tMGetValue(Ac, i, jj)

tMSetValue(Ac, tMGetValue(Ac, ii, jj), i, jj)
tMSetValue(Ac, tmp, ii, jj)

tmp = tMGetValue(R, i, jj)

tMSetValue(R, tMGetValue(R, ii, jj), i, jj)
tMSetValue(R, tmp, ii, jj)
Next

v = tMGetValue(Ac, i,i)

Exit
EndIf
Next

If Not switch
RuntimeError "Matrix is close to singular"
EndIf
EndIf

;Ac(i,i) wird zu 1
For k=1 To A\n
tMSetValue(Ac, tMGetValue(Ac, i, k)/v, i, k)
tMSetValue(R, tMGetValue(R, i, k)/v, i, k)
Next

;Ac(:,j) wird zu [1;0..]
For j=i+1 To A\n
v=tMGetValue(Ac, j, i)

For k=1 To A\n
tMSetValue(Ac, tMGetValue(Ac, j, k)-v*tMGetValue(Ac, i, k), j, k)
tMSetValue(R, tMGetValue(R, j, k)-v*tMGetValue(R, i, k), j, k)
Next
Next

;Ac(:,j) wird zu [0..;1;0..]
For k=i-1 To 1 Step -1
v = tMGetValue(Ac, k, i)

For j=1 To A\n
tMSetValue(Ac, tMGetValue(Ac, k,j)-v*tMGetValue(Ac, i,j), k,j)
tMSetValue(R, tMGetValue(R, k,j)-v*tMGetValue(R, i,j), k,j)
Next
Next
Next

; For i=A\n To 2 Step -1
; For k=i-1 To 1 Step -1
; v = tMGetValue(Ac, k, i)
;
; For j=1 To A\n
; tMSetValue(Ac, tMGetValue(Ac, k,j)-v*tMGetValue(Ac, i,j), k,j)
; tMSetValue(R, tMGetValue(R, k,j)-v*tMGetValue(R, i,j), k,j)
; Next
; Next
; Next

Delete Ac

R\FLAG=flag
Return R
End Function[/syntax]

[syntax="bb"]Function tMDeterminant#(A.TMatrix)
Local d#, subA.TMatrix

;für quadratische Matrizen, A=R^{n,n}
If A\n<>A\m
RuntimeError "Matrix must be square"
EndIf

If A\n=2
Return tMGetValue(A, 1,1)*tMGetValue(A, 2,2) - tMGetValue(A, 1,2)*tMGetValue(A, 2,1)
EndIf

d = 0
For j=1 To A\n
s = 1-2*((j+1) Mod 2)

subA = tMCreateMatrix(A\n-1, A\n-1)

For i=2 To A\n
For k=1 To A\n
If k <> j
tMSetValue(subA, tMGetValue(A, i,k), i-1, k-(k>j))
EndIf
Next
Next

d = d + s*tMGetValue(A, 1,j) *tMDeterminant(subA)
Delete subA
Next

Return d
End Function[/syntax]

Download

Edit: Ich habe noch eine weitere Funktion ergänzt (allerdings nicht im Download-Link, müsste von Hand noch hinzugefügt werden). Die QR-Zerlegung einer Matrix. Es zerlegt die Matrix A in A=Q*R, wobei Q orthogonal (QQ' = 1) und unitär (QQ* = 1), und R eine obere Dreiecksmatrix ist. Weil BB nur einen Rückgabewert liefern kann, wird die Inputmatrix A mit der R Matrix gefüllt und Q zurückgegeben. Will man sein A behalten, müsste man es also mit tMQR(tMClone(A)) aufrufen (auch wenn man dann keine Referenz auf den Klon von A hat..). Komischerweise bin ich mir überhaupt nichtmehr sicher, wofür man die QR-Zerlegung überhaupt gebraucht hat Ich erinner mich noch schwach an irgendwelche Gleichungssysteme oder so. Wahrscheinlich für unausgeglichene Systeme (ähnlich zum Problem im Raytracer), weil dann in der Rechnung M = A'A ein paar Teile wegfallen, und das Resultat einfacher (+einfacher zu berechnen) ist.
Bemerkung: Die Zerlegung ruft den tMGC auf, weil in der Routine viele nicht-referenzierte Matrizen erstellt werden, die den Speicher zumüllen. Man sollte also seine Matrizen mit den richtigen keep-Flags versehen, wenn man sie auch nach der QR-Routine noch haben möchte :>

[syntax="bb"]; TMatrix tMQR, zerlegt A zu A=Q*R, wobei das resultierende A=R, und Q zurückgeliefert wird
;
; A: TMatrix, die zu zerlegende Matrix
; flag: Bool, die keep-flag der Matrix Q
Function tMQR.TMatrix(A.TMatrix, flag=False)
Local n, m, Q.TMatrix, R.TMatrix, KMax, P.TMatrix, w.TMatrix, s#, t#, c#

n = A\n
m = A\m

Q = tMIdentity(m)
R = A

If m=n
KMax = n-1
Else
KMax = n
EndIf

For k = 1 To KMax
s = 0
For j = k To m
s = s +R\e[GetI(j,k, n,m)]^2
Next

s = Sqr(s)
t = R\e[GetI(k,k, n,m)]
c = s *(s +Abs(t))

w = tMCreateMatrix(m, 1)
w\e[GetI(k,1, m,1)] = t +s *Sgn(t)

For j = k+1 To m
w\e[GetI(j,1, m,1)] = R\e[GetI(j,k, n,m)]
Next

P = tMSubtract( tMIdentity(m), tMScale(1./c, tMMultiply( w, tMTranspose(w) ) ) )

Q = tMMultiply(P, Q)
R = tMMultiply(P, R)

Delete P
Delete w
Next

Q = tMTranspose(Q)

For i = 1 To n
For j = 1 To m
idx = GetI(i, j, n, m)

A\e[idx] = R\e[idx]
Next
Next

Q\FLAG = True
A\FLAG = True
tMGC()

Q\FLAG = flag
A\FLAG = flag
Return Q
End Function[/syntax]

On furhter notice

Ich habe festgestellt, dass ich immer wieder die gleichen Funktionen und Types schreibe. Also habe ich angefangen, zu kopieren und alles in eine Sammlung zu packen. Es handelt sich um Nützlichkeiten und Funktionen im 3D-Raum. Vektoren, Dreiecke und alles (jedenfalls alles was mir bisher eingefallen ist zu verwenden) was man davon braucht. Also Vektorrechnungen, Schnitte (kein Ebenen-Ebenen-Schnitt bisweilen.. lässt sich aus zwei Vektor-Ebenen Schnitten basteln) und solches Zeug. Zudem sind noch meine Funktionen für Texturen und Heightmaps drin.
Ich weiss nicht, wieviel es anderen nützen wird, deshalb werde ich keinen Code posten. Aber hier ist ein Link mit der Sammlung. Nur ein include entfernt von der Verwendung, hussay \o/

Für mein Figuren Animations Ding vom vorletzten Mal habe ich eine kleine Erweiterung gebastelt, die aus den (quadratischen, 2 Trig) Bone-Sprites Dreiecke ausliest, die das Bild ungefähr annähern. Die Dreiecke werden in einem weiteren Mesh gespeichert, aus dem ich irgendwann Schatten zu machen hoffe. Die Vorrichtung dafür habe ich das letzte Mal vorgestellt. (Dort musste ich noch einen kleinen Fehler verbessern, nichts grossartiges, sowas zwischen Tipp- und Denkfehler halt.) Allerdings fehlt nachwievor ein kluger Hintergrund.. Meh.

In meiner Physikimplementation habe ich die Art der Texturbeschreibung geändert. Früher war es ein „Ausschnitt“ aus der Textur (angegeben wurde oben links und Dimension, danach wurde das Objekt reingepasst), jetzt arbeitet es mit UV-Koordinaten. Das Problem dabei ist, dass es keine Dreiecke sind, sondern Polygone. Es werden daher nur die ersten drei Punkte des Körpers betrachtet, aus denen werden dann die UV-Koordinaten des Punktes berechnet. Das geht ziemlich analog zur Methode, die ich im Raytracer erklärt habe, mit dem Unterschied, dass man das System direkt lösen kann (weil 2D->2D transformation). Ich habe dann auch die UV-Koordinaten beim Splitterprozess neu gesetzt, funktioniert ganz gut. Feldtest folgte mit einer etwas älteren Version, sollte aber auch in der neuen 1:1 funktionieren, da ich eigentlich nur Type-/ Funktionsnamen geändert habe (der Übersicht halber..).

Ende

So, das wärs vorerst. Ich muss jetzt wieder etwas für die Uni tun, und s pielen, und Internet. Ich lass wohl mal wieder was von mir hören, hier, in meinem Worklog.

MfG,
Darth

Eleganz ist für Wahnsinnige

darth — Tue, 16 Nov 2010 20:57:44 +0100

Hallo,

ich habe hier schon lange nichtsmehr gepostet wie mir scheint. Das hat einen ziemlich einfachen Grund, er heisst "Starcraft 2", ich bin ein riesen Fanboy des Spiels, wie schon vom ersten Spiel. Ich schaue auch gerne Turniere von richtig guten Spielern. Das nimmt schon einige Zeit in Anspruch, da kann man nichtmehr programmieren. Ein weiterer Grund ist (mal wieder) die Universität (hach, RL..), da lerne ich gerade Fortran (geniale Sprache, solltet ihr euch mal reinziehn!) und mache wenig wirklich Essentielles, das mir Ansporn für wirkliche Programmierarbeiten gibt.
Ich habe zwar ein etwas grösseres Projekt in Planung, aber davon existieren vor allem Theorien und Konzepte, aber nichts tatsächlich Brauchbares, hihi. Ich bräuchte da sowieso noch Grafiker und Sounddesigner, damit das wirklich Sinn machen wird. Horrorspiele leben so extrem von der Stimmung, die man halt irgendwie rüberbringen muss, da kann ich mit tollen Algorithmen nicht viel reissen.

Und damit wäre ich auch beim Punkt angekommen. Tolle Algorithmen. Die meisten werden wahrscheinlich den Titel gelesen haben und sich fragen, was ich damit meine. Ich habe vor, euch jetzt mal durch einen Prozess zu führen, wie ich programmiere. Mal sehen wie vernünftig das Ergebnis wird

Schritt 1: Der Plan

Motivation: Ein vernünftiges Horrorspiel braucht vernünftige Schatten. Schatten haben mich in der Kindheit immer erschreckt, und konnte nicht schlafen, weil der Baum vor dem Fenster seltsame Schatten an die Wand warf.

Idee: Man betrachte vorerst eine Linie. Der geworfene Schatten passt sich dem Gelände an. Das heisst, ich suche den Anfangs- und Endpunkt, dazwischen kann ich einfach den Trigs entlangfahren. Damit das einigermassen funktioniert, muss ich den Dreiecken ihre Nachbarn zuweisen (jedes Dreieck hat 3). Dann hole ich den zweiten Punkt übers Lot auf die Ebene, damit ich die Projektion der Linie in der Ebene des Dreiecks habe. Anschliessend prüfe ich, auf welcher Seite diese Linie das Dreieck verlässt, setze diesen Nachbarn als neues aktives Dreieck und wiederhole den Prozess bis ich im selben Dreieck wie der Endpunkt bin.

Probleme: Das zuordnen der Nachbarn muss eindeutig sein, das heisst, dass ich nur einfache Geometrien zulassen kann. Also sowas \|/ wird zu problemen führen, während sowas \/ völlig zulässig ist. Jedes Dreieck darf also maximal 3 Nachbarn haben. Das hat mich natürlich etwas gestört, aber meine Idee nicht wirklich behindert, weil ich sowieso nicht vor hatte, komplizierte Hintergründe zu basteln.

Implementation: Der Algorithmus wird umgesetzt, getestet und bis zur Funktionsfähigkeit gebracht. Toll!

Schritt 2: Der Tag danach

Am nächsten Tag versucht man natürlich, bei seinen Kollegen etwas Eindruck zu schinden und erzählt von seiner tollen Idee und dem grossartigen Algorithmus, den man sich ausgedacht hat. Irgendwann kam dann die Frage, wie man das optimieren könnte. Da habe ich zu rechnen angefangen.

Code: [AUSKLAPPEN]

Anfangspunkt: Muss alle Dreiecke durchgehen (um den nächsten Schnittpunkt zu finden) -> n
Endpunkt: Nochmal alle Dreiecke durchgenen -> n
(zugegeben, das könnte man optimieren indem man die Punkte gleichzeitig sucht.)

Trajektorie zwischen den Punkten: Maximal alle Dreiecke -> n

Wie man sieht ist das Ergebnis der Messung 3n (oder 2n wie mans nimmt..). Das brachte mich natürlich etwas ins grübeln. Wenn ich einfach "Bruteforce"mässig den Schatten auf jedes Dreieck einzeln werfe, kommte ich mit einem linearen Aufwand von nur n klar. Der tolle Algorithmus vom Vortag ist weniger effizient.
*Seufz* Also wird er umgeschrieben, die elegante Lösung wird weggeworfen, der uncoole Algorithmus wird erstmal implementiert und getestet. Funktioniert natürlich wunderbar (weil er so simpel ist) und spart etwa 5 verschiedene Funktionen, gut.

Mit diesem Code wird jetzt weitergearbeitet (natürlich, ist ja die effizientere Lösung). Erweiterung auf Dreiecke folgt auf dem Fusse. Man projeziert alle drei Linien auf die Dreiecksebene und schneidet sie ab, sobald sie das Dreieck verlassen. Hierbei gibt es 3 mögliche Fälle:

Fall 1 kann doppelt vorkommen, dafür prüft man einfach, ob Punkt1 oder Punkt2 der Linie innerhalb des Dreiecks ist, und tauscht dann aus, kein Problem. Der nächste Schritt ist es dann, die erhaltenen Punkte zu Dreiecken zu verbinden.

Schritt 3: Die Kapitulation

Bei diesem Schritt sind mir dann nach und nach neue Probleme aufgefallen, die ich nicht bedacht habe. Es gibt hier 7 Fälle, wie sich zwei Dreiecke überlagern können, aber nur drei verschiedene Zahlen von möglichen Schnittpunkten, auch hierzu wieder ein Bild zur Erklärung:

Wenn ich jetzt also weniger als 6 Schnittpunkte für das projizierte Dreieck habe, muss ich anfangen zu prüfen, ob Eckpunkte drin liegen. Und genau hier ist etwa der Punkt, an dem ich aufgegeben habe. Wahrscheinlich könnte man da irgendwie zwischen den Punkten was rechnen, ob man den Eckpunkt mit einbeziehen muss oder nicht. Aber ehrlich? Ich würde vermuten, das wird wieder aufwändiger, als einfach die drei Punkte zu prüfen.
Für das Verknüpfen zu Dreiecken mache ich auch etwas ziemlich tolles: Ich nehme alle Möglichkeiten. Ich weiss, dass ich maximal 6 Punkte habe, das führt zu maximal 24 Dreiecken. Irgendetwas intelligentes zu schreiben, das dieses kleine System zu Punkten verknüpft kommt (mit ziemlicher Sicherheit) teurer als einfach alle Möglichkeiten zu überlagern.
Ich kenne zwar Trigonalisierungsalgorithmen für beliebige Punkte (ich weiss ja, dass der Schatten des Dreiecks konvex sein wird), aber dazu müsste ich einen Basiswechsel ins System des Dreiecks durchführen (damit ichs in 2D habe), und äh .. das ist einiges an Rechenaufwand -> lohnt sich nicht für ein solch kleines System.
So! Das wars! Eleganz? Ohne mich. Akhams razor! DONE!

Abschluss

Im Anhang (also in etwa 4-5 Zeilen) folgt das Ergebnis. In einem etwas späteren Edit wird dann irgendwann ein kleiner Hintergrund folgen, auf den irgend ein bewegter Schatten projiziert werden wird. Aber solches Zeug muss ich als grafikalischer Anfänger noch erst erledigen, das kann etwas dauern :>

Und hier der Code dazu (ist noch nicht wirklich aufgeräumt, auch das wird in einem weiteren Edit noch folgen) ist auch hier zu finden:

[syntax="bb"];/* LIB CODE */;

;/*
; * Utilities
; * TVector3D
; * Vector for Points (with additional offset for normals)
; * TTrig3D
; * Background Triangle (will be projected on)
; * TSimpleTrig3D
; * Foreground Triangle (will be projected)
; */

Type TVector3D
Field x#
Field y#
Field z#

Field d#
End Type

Type TTrig3D
Field p1.TVector3D
Field p2.TVector3D
Field p3.TVector3D

Field n.TVector3D
End Type

Type TSimpleTrig3D
Field p1.TVector3D
Field p2.TVector3D
Field p3.TVector3D
End Type

Function newTVector3D.TVector3D(x#, y#, z#)
Local v.TVector3D=New TVector3D

v\x=x
v\y=y
v\z=z

Return v
End Function

Function vNormalise(v.TVector3D)
Local il#=1./Sqr(v\x*v\x + v\y*v\y + v\z*v\z)

v\x=v\x*il
v\y=v\y*il
v\z=v\z*il
End Function

Function vDot#(v1.TVector3D, v2.TVector3D)
Return v1\x*v2\x + v1\y*v2\y + v1\z*v2\z
End Function

Function vCross.TVector3D(v1.TVector3D, v2.TVector3D)
Return newTVector3D(v1\y*v2\z-v2\y*v1\z, v2\x*v1\z-v1\x*v2\z, v1\x*v2\y-v2\x*v1\y)
End Function

Function vDist#(v1.TVector3D, v2.TVector3D)
Return Sqr( (v1\x-v2\x)*(v1\x-v2\x) + (v1\y-v2\y)*(v1\y-v2\y) + (v1\z-v2\z)*(v1\z-v2\z) )
End Function

Function shadowLineIntersect3D.TVector3D(p1.TVector3D, p2.TVector3D, p3.TVector3D, p4.TVector3D)
Local EPS#=10^-8

Local p13.TVector3D, p43.TVector3D, p21.TVector3D
Local d1343#, d4321#, d1321#, d4343#, d2121#
Local numer#, denom#, mua#, mub#

p13=newTVector3D(p1\x-p3\x, p1\y-p3\y, p1\z-p3\z)

p43=newTVector3D(p4\x-p3\x, p4\y-p3\y, p4\z-p3\z)
If Abs(p43\x)<EPS And Abs(p43\y)<EPS And Abs(p43\z)<EPS
Delete p13
Delete p43

Return Null
EndIf

p21=newTVector3D(p2\x-p1\x, p2\y-p1\y, p2\z-p1\z)
If Abs(p21\x)<EPS And Abs(p21\y)<EPS And Abs(p21\z)<EPS
Delete p13
Delete p43
Delete p21

Return Null
EndIf

d1343 = p13\x * p43\x + p13\y * p43\y + p13\z * p43\z
d4321 = p43\x * p21\x + p43\y * p21\y + p43\z * p21\z
d1321 = p13\x * p21\x + p13\y * p21\y + p13\z * p21\z
d4343 = p43\x * p43\x + p43\y * p43\y + p43\z * p43\z
d2121 = p21\x * p21\x + p21\y * p21\y + p21\z * p21\z

denom = d2121*d4343 -d4321*d4321
If Abs(denom)<EPS
Delete p13
Delete p43
Delete p21

Return Null
EndIf

numer=d1343*d4321 -d1321*d4343

mua=numer/denom
mub=(d1343+d4321*mua)/d4343

Local pA.TVector3D=newTVector3D(p1\x+mua*p21\x, p1\y+mua*p21\y, p1\z+mua*p21\z)
Local pB.TVector3D=newTVector3D(p3\x+mub*p43\x, p3\y+mub*p43\y, p3\z+mub*p43\z)

Delete p13
Delete p43
Delete p21

If equalPoints(pA, pB)
If mua>0.01 And mua<1 And mub>=0 And mub<=1
Delete pB
Return pA
EndIf
EndIf

Delete pA
Delete pB

Return Null
End Function

Function newTSimpleTrig3D.TSimpleTrig3D(p1.TVector3D, p2.TVector3D, p3.TVector3D)
Local t.TSimpleTrig3D=New TSimpleTrig3D

t\p1=p1
t\p2=p2
t\p3=p3

Return t
End Function

Function newTTrig3D.TTrig3D(p1.TVector3D, p2.TVector3D, p3.TVector3D)
Local t.TTrig3D=New TTrig3D

t\p1=p1
t\p2=p2
t\p3=p3

Local vx1#=p2\x-p1\x
Local vy1#=p2\y-p1\y
Local vz1#=p2\z-p1\z

Local vx2#=p3\x-p1\x
Local vy2#=p3\y-p1\y
Local vz2#=p3\z-p1\z

t\n=newTVector3D(vy1*vz2-vz1*vy2, vz1*vx2-vx1*vz2, vx1*vy2-vy1*vx2)
vNormalise(t\n)
t\n\d= -t\n\x*p3\x -t\n\y*p3\y -t\n\z*p3\z

Return t
End Function

Function linePlaneIntersection.TVector3D(p.TVector3D, v.TVector3D, t.TTrig3D)
If Abs(v\x*t\n\x + v\y*t\n\y + v\z*t\n\z)<1 ;vllt etwas gross?
Return Null
EndIf

If Abs(p\x*t\n\x + p\y*t\n\y + p\z*t\n\z + t\n\d)<0.1
Return newTVector3D(p\x, p\y, p\z)
EndIf

Local k#= -(t\n\x*p\x +t\n\y*p\y +t\n\z*p\z +t\n\d)/(t\n\x*v\x +t\n\y*v\y +t\n\z*v\z)
k=k*0.999

Return newTVector3D(p\x+k*v\x, p\y+k*v\y, p\z+k*v\z)
End Function

Function pointInTrig3D(x#, y#, z#, t.TTrig3D)
If Abs(x*t\n\x + y*t\n\y + z*t\n\z + t\n\d)>0.1
Return False
EndIf

Local v0.TVector3D, v1.TVector3D, v2.TVector3D

v0=newTVector3D(t\p3\x-t\p1\x, t\p3\y-t\p1\y, t\p3\z-t\p1\z)
v1=newTVector3D(t\p2\x-t\p1\x, t\p2\y-t\p1\y, t\p2\z-t\p1\z)
v2=newTVector3D(x-t\p1\x, y-t\p1\y, z-t\p1\z)

Local dot00#, dot01#, dot02#, dot11#, dot12#

dot00=vDot(v0, v0)
dot01=vDot(v0, v1)
dot02=vDot(v0, v2)
dot11=vDot(v1, v1)
dot12=vDot(v1, v2)

Delete v0
Delete v1
Delete v2

Local invDenom#=1./(dot00*dot11 - dot01*dot01)
Local u#=(dot11*dot02 - dot01*dot12)*invDenom
Local v#=(dot00*dot12 - dot01*dot02)*invDenom

Return (u>=0) And (v>=0) And (u+v<=1)
End Function

Function equalPoints(p1.TVector3D, p2.TVector3D)
Local dist#=0.5

If p1=p2
Return True
EndIf

If Abs(p1\x-p2\x)<dist And Abs(p1\y-p2\y)<dist And Abs(p1\z-p2\z)<dist
Return True
EndIf

Return False
End Function

;/*
; */

Global shadowMesh
Global shadowSurf

Function initShadowMesh()
shadowMesh=CreateMesh()
EntityFX shadowMesh, 16

shadowSurf=CreateSurface(shadowMesh)
EntityColor shadowMesh, 50, 50, 50
End Function

Function projectShadow(lightPos.TVector3D)
ClearSurface(shadowSurf)

Local tProj.TSimpleTrig3D
Local tIter.TTrig3D

Local lVec1.TVector3D, lVec2.TVector3D, lVec3.TVector3D

Local p1.TVector3D, p2.TVector3D
Local v1.TVector3D, v2.TVector3D

Local proj1.TVector3D
Local proj2.TVector3D
Local b1, b2, iCase

Local pTmp.TVector3D, pCut1.TVector3D, pCut2.TVector3D, pCut3.TVector3D
Local tP1.TVector3D, tP2.TVector3D, tP3.TVector3D, tTr.TTrig3D

Local projList.TVector3D[6]
Local pCount
Local vList[6]

For tProj=Each TSimpleTrig3D
lVec1=newTVector3D(tProj\p1\x-lightPos\x, tProj\p1\y-lightPos\y, tProj\p1\z-lightPos\z)
lVec2=newTVector3D(tProj\p2\x-lightPos\x, tProj\p2\y-lightPos\y, tProj\p2\z-lightPos\z)
lVec3=newTVector3D(tProj\p3\x-lightPos\x, tProj\p3\y-lightPos\y, tProj\p3\z-lightPos\z)

For tIter=Each TTrig3D
pCount=0

For i=0 To 2
Select i
Case 0
p1=tProj\p1
p2=tProj\p2

v1=lVec1
v2=lVec2
Case 1
p1=tProj\p2
p2=tProj\p3

v1=lVec2
v2=lVec3
Case 2
p1=tProj\p3
p2=tProj\p1

v1=lVec3
v2=lVec1
End Select

proj1=linePlaneIntersection(p1, v1, tIter)
proj2=linePlaneIntersection(p2, v2, tIter)

If proj1=Null Or proj2=Null
Delete proj1
Delete proj2

pCount=-1
Exit
EndIf

b1=pointInTrig3D(proj1\x, proj1\y, proj1\z, tIter)
b2=pointInTrig3D(proj2\x, proj2\y, proj2\z, tIter)

iCase=-1
If b1=1 And b2=1
iCase=0
ElseIf b1=1 And b2=0
iCase=1
ElseIf b1=0 And b2=1
pTmp=proj1
proj1=proj2
proj2=pTmp

iCase=1
ElseIf b1=0 And b2=0
iCase=2
EndIf

Select iCase
Case 1
pTmp=shadowLineIntersect3D(proj1, proj2, tIter\p1, tIter\p2)
If pTmp<>Null
Delete proj2
proj2=pTmp
Else
pTmp=shadowLineIntersect3D(proj1, proj2, tIter\p2, tIter\p3)
If pTmp<>Null
Delete proj2
proj2=pTmp
Else
pTmp=shadowLineIntersect3D(proj1, proj2, tIter\p3, tIter\p1)
If pTmp<>Null
Delete proj2
proj2=pTmp
Else
Delete proj1
Delete proj2
EndIf
EndIf
EndIf
Case 2
pCut1=shadowLineIntersect3D(proj1, proj2, tIter\p1, tIter\p2)
pCut2=shadowLineIntersect3D(proj1, proj2, tIter\p2, tIter\p3)
pCut3=shadowLineIntersect3D(proj1, proj2, tIter\p3, tIter\p1)

Delete proj1
Delete proj2

If pCut1=Null
proj1=pCut2
proj2=pCut3
ElseIf pCut2=Null
proj1=pCut1
proj2=pCut3
ElseIf pCut3=Null
proj1=pCut1
proj2=pCut2
EndIf

If pCut1=Null And pCut2=Null And pCut3=Null
Delete proj1
Delete proj2
EndIf
End Select

If iCase<>-1
If proj1<>Null And proj2<>Null
projList[pCount]=proj1
projList[pCount+1]=proj2
pCount=pCount+2
EndIf
EndIf
Next

While pCount>0 ;damit ich ein Exit einbauen kann
If pCount<6
tP1=linePlaneIntersection(tProj\p1, lVec1, tIter)
tP2=linePlaneIntersection(tProj\p2, lVec2, tIter)
tP3=linePlaneIntersection(tProj\p3, lVec3, tIter)

If tP1=Null Or tP2=Null Or tP3=Null
Delete tP1
Delete tP2
Delete tP3

Exit
EndIf

tTr=newTTrig3D(tP1, tP2, tP3)

bool=pointInTrig3D(tIter\p1\x, tIter\p1\y, tIter\p1\z, tTr)
If bool
projList[pCount]=newTVector3D(tIter\p1\x, tIter\p1\y, tIter\p1\z)
pCount=pCount+1
EndIf

bool=pointInTrig3D(tIter\p2\x, tIter\p2\y, tIter\p2\z, tTr)
If bool
projList[pCount]=newTVector3D(tIter\p2\x, tIter\p2\y, tIter\p2\z)
pCount=pCount+1
EndIf

bool=pointInTrig3D(tIter\p3\x, tIter\p3\y, tIter\p3\z, tTr)
If bool
projList[pCount]=newTVector3D(tIter\p3\x, tIter\p3\y, tIter\p3\z)
pCount=pCount+1
EndIf

Delete tP1
Delete tP2
Delete tP3

Delete tTr\n
Delete tTr
EndIf

For i=0 To pCount-1
vList=AddVertex(shadowSurf, projList[i]\x, projList[i]\y, projList[i]\z)
Delete projList[i]
Next

For i=0 To pCount-3
For j=i+1 To pCount-2
For k=j+1 To pCount-1
AddTriangle(shadowSurf, vList[i], vList[j], vList[k])
Next
Next
Next

Exit
Wend
Next

Delete lVec1
Delete lVec2
Delete lVec3
Next
End Function

;/* LIB CODE */;

;/*
; * Testumgebung
; */

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

Local p.TVector3D
Local t.TTrig3D

;// Projektionsfläche
p1.TVector3d=newTVector3D(-30, -10, -10)
p2.TVector3d=newTVector3D(-30, -10, 10)
p3.TVector3D=newTVector3D(-10, -10, -10)
p4.TVector3D=newTVector3D(-10, -10, 10)
p5.TVector3D=newTVector3D(10, 10, -10)
p6.TVector3D=newTVector3D(10, 10, 10)
p7.TVector3D=newTVector3D(30, 10, -10)
p8.TVector3D=newTVector3D(30, 10, 10)

t1.TTrig3D=newTTrig3D(p1, p2, p3)
t2.TTrig3D=newTTrig3D(p2, p3, p4)
t3.TTrig3D=newTTrig3D(p3, p4, p5)
t4.TTrig3d=newTTrig3D(p4, p5, p6)
t5.TTrig3D=newTTrig3D(p5, p6, p7)
t6.TTrig3D=newTTrig3D(p6, p7, p8)

Local groundMesh=CreateMesh()
EntityFX groundMesh, 16
Local groundSurf=CreateSurface(groundMesh)

For t=Each TTrig3D
v1=AddVertex(groundSurf, t\p1\x, t\p1\y, t\p1\z)
v2=AddVertex(groundSurf, t\p2\x, t\p2\y, t\p2\z)
v3=AddVertex(groundSurf, t\p3\x, t\p3\y, t\p3\z)

AddTriangle(groundSurf, v1, v2, v3)
Next

;// Schattenwerfer
Local lightPos.TVector3D=newTVector3D(0, 100, 0)

point1.TVector3D=newTVector3D(-20, 20, 0)
point2.TVector3D=newTVector3D(20, 20, 0)
point3.TVector3D=newTVector3D(0, 20, 20)

trig1.TSimpleTrig3D=newTSimpleTrig3D(point1, point2, point3)

Local projMesh=CreateMesh()
EntityFX projMesh, 16
EntityColor projMesh, 255, 0, 0
Local projSurf=CreateSurface(projMesh)

v1=AddVertex(projSurf, point1\x, point1\y, point1\z)
v2=AddVertex(projSurf, point2\x, point2\y, point2\z)
v3=AddVertex(projSurf, point3\x, point3\y, point3\z)

AddTriangle(projSurf, v1, v2, v3)

;// 3D Umgebung
Global camera=CreateCamera()
PositionEntity camera, 0, 50, -100
Local camPiv=CreatePivot()
EntityParent camera, camPiv

Local light=CreateLight()

;// Init the shadowMesh
initShadowMesh()

While Not KeyHit(1)
RenderWorld
TurnEntity camPiv, 0, KeyDown(203)-KeyDown(205), 0

;// Project the shadow
projectShadow(lightPos)

Flip 0
Cls
Wend
End[/syntax]
Edit 1: Das erste der versprochenen Edits. Ich habe den Code etwas aufgeräumt, zwei Fehler verbessert und eine kleine Schönheitskorrektur gemacht. Ausserdem ist das Ding nun in eine Art Library verpackt (die ich der Einfachheit halber einfach direkt in den Code gepackt habe)
[i]Fehler 1: Wenn der Licht-Punkt Vektor annähernd parallel zur Dreiecksebene ist (Vektor * Normal ~ 0), gab es immernoch Schatten, allerdings äusserst unlogische. Diese habe ich nun rausgenommen, der Schönheit halber.
Fehler 2: Wenn der eine Punkt noch knapp im Dreieck war (meist direkt auf der Linie) und der zweite ausserhalb, dann wurde die Linie nicht korrekt beschnitten, es entstanden Schatten im Nichts. Wurde korrigiert (indem ich bei einem solchen Fall einfach die Linie verwerfe :>).
Schönheitskorrektur: Der Schatten liegt nun nichtmehr direkt auf dem projizierten Dreick, sondern wird ein bisschen in Richtung Punkt verschoben (Z-Sorting und so), sollte nun also immer über dem Hintergrund angezeigt werden.
Edit 2: Noch einen kleinen Fehler gefunden mit den Cases. Korrigiert.
Edit 3: Langsam wirds mühsam. Noch einen kleinen Fehler gefunden, ein >= statt einem >, tse.

So, nun gehe ich wieder ein paar Matches Spielen. Falls Werbung hier erlaubt ist: Holt euch SC2! Das Spiel ist absolut grossartig :> Und falls ihr es noch nicht habt: Holt euch SC1:BW, das Spiel ist noch grossartiger!

MfG,
Cabadath

Der Krug geht zum Brunnen bis er bricht

darth — Thu, 15 Jul 2010 16:58:41 +0200

Hallo,

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

Animation in 3D

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

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

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

Animation in 2D

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

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

(Gekürzt auf das Wesentliche.. sprich: Setter/Getter gestrichen)
[syntax="bb"]Global RENDERCAM

Function initRenderCam()
RENDERCAM=CreateCamera()

TurnEntity RENDERCAM, 180, 0, 0
PositionEntity RENDERCAM, GraphicsWidth()/2, GraphicsHeight()/2, GraphicsWidth()/2

CameraClsMode RENDERCAM, 0, 1
End Function

;/*
; * Figure Definition
; */

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

Type TFigure
Field posX#
Field posY#

Field phiZ#

Field dir

Field jList.TJoint[MAX_JOINTS]
Field jCount
Field bList.TBone[MAX_BONES]
Field bCount

Field aList.TAnimationSequence[MAX_ANIMSEQ]
Field aCount

Field frame
Field kf
Field animRunning ;=-1 falls keine Animation läuft

Field relX#
Field relY#

Field dX#
Field dY#

Field piv

Field vX#
Field vY#
End Type

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

Type TKeyframe
Field endFrame

Field jList.TJoint[MAX_JOINTS]
Field jCount

Field posX#
Field posY#
End Type

Type TJoint
Field x#
Field y#

Field parent.TJoint
Field cList.TJoint[MAX_JOINTS]
Field cCount

Field vX#
Field vY#

Field name$

Field fix
End Type

Type TBone
Field j1.TJoint
Field j2.TJoint

Field length#

Field sprite
End Type

;/*
; * String Handling
; */

Const MAX_SPLITS=64
Function splitString(source$, splitter$[MAX_SPLITS], splitterCount, split$[MAX_SPLITS])
Local idx=0
Local pos, minPos, minSplit

While Len(source)>0
minPos=Len(source)
minSplit=-1

For i=0 To splitterCount-1
pos=Instr(source, splitter[i])

If pos<minPos And pos>0
minPos=pos
minSplit=i
EndIf
Next

pos=minPos

If pos=0 Or minSplit=-1
split[idx]=Mid(source, 1, Len(source))
idx=idx+1

Exit
Else
split[idx]=Mid(source, 1, pos-1)
idx=idx+1

If Len(split[idx-1])=0
idx=idx-1
EndIf

source=Right(source, Len(source)-pos-Len(splitter[minSplit])+1)
EndIf
Wend

Return idx
End Function

Function cleanStringSplit(split$[MAX_SPLITS], count)
Local charsLeft$[2]
Local charsRight$[2]

charsLeft[0]="<"
charsLeft[1]="'"

charsRight[0]=">"
charsRight[1]="'"

Local chg=True

While chg
chg=False

For i=0 To count-1
For j=0 To 1
If Left(split[i], 1)=charsLeft[j]
split[i]=Right(split[i], Len(split[i])-1)
chg=True
EndIf

If Right(split[i], 1)=charsRight[j]
split[i]=Left(split[i], Len(split[i])-1)
chg=True
EndIf
Next
Next
Wend

For i=0 To count-1
split[i]=Lower(split[i])
Next
End Function

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

Function loadFigure.TFigure(file$)
Local stream=ReadFile(file)

If stream=0
RuntimeError "File does not exist"
EndIf

Local f.TFigure=New TFigure
Local a.TAnimationSequence
Local k.TKeyframe

Local sLine$
Local split$[MAX_SPLITS], sCount

Local splitter$[MAX_SPLITS]
splitter[0]=" "
splitter[1]="="

Local jStack.TJoint[MAX_JOINTS]
Local sIdx

Local vertexMode=0

Local x#, y#, z#

f\piv=CreatePivot()
f\animRunning=-1

f\dir=1

While Not Eof(stream)
sLine=Trim(ReadLine(stream))

If Left(sLine, 1)="<"
sLine=Right(sLine, Len(sLine)-1)
EndIf
If Right(sLine, 1)=">"
sLine=Left(sLine, Len(sLine)-1)
EndIf

For i=0 To MAX_SPLITS-1
split[i]=""
Next

sCount=splitString(sLine, splitter, 2, split)
cleanStringSplit(split, sCount)

;dbg$=""
;For i=0 To sCount-1
; dbg=dbg+split[i]+" "
;Next
;DebugLog dbg

Select split[0]
;/*
; * Joint
; */

Case "joint"
jStack[sIdx]=newJoint(0, 0)
sIdx=sIdx+1

If sIdx>1
jStack[sIdx-1]\parent=jStack[sIdx-2]

jStack[sIdx-2]\cList[jStack[sIdx-2]\cCount]=jStack[sIdx-1]
jStack[sIdx-2]\cCount=jStack[sIdx-2]\cCount+1
EndIf

If vertexMode=0 ;Fill into Figure
f\jList[f\jCount]=jStack[sIdx-1]
f\jCount=f\jCount+1
Else ;Fill into Keyframe
If k<>Null
addJointToKeyframe(k, jStack[sIdx-1])
EndIf
EndIf

For i=1 To sCount-1
Select split[i]
Case "name"
jStack[sIdx-1]\name=split[i+1]

i=i+1
Case "coo", "coords", "coordinates"
jStack[sIdx-1]\x=Float(split[i+1])
jStack[sIdx-1]\y=Float(split[i+2])

i=i+3
End Select
Next

If vertexMode=0
If sIdx>1
; parent child
f\bList[f\bCount]=newBone(jStack[sIdx-2], jStack[sIdx-1])
f\bCount=f\bCount+1

For i=1 To sCount-1
Select split[i]
Case "sprite", "bonesprite"
f\bList[f\bCount-1]\sprite=nLoadSprite(split[i+1], 1+4)

EntityFX f\bList[f\bCount-1]\sprite, 16+1
;SpriteViewMode f\bList[f\bCount-1]\sprite, 2

;ScaleSprite f\bList[f\bCount-1]\sprite, f\bList[f\bCount-1]\length/2*1.2, f\bList[f\bCount-1]\length/2*1.2
ScaleEntity f\bList[f\bCount-1]\sprite, f\bList[f\bCount-1]\length/2*1.2, f\bList[f\bCount-1]\length/2*1.2, 1

i=i+1
Case "order"
If f\bList[f\bCount-1]\sprite<>0
EntityOrder f\bList[f\bCount-1]\sprite, Int(split[i+1])
EndIf

i=i+1
End Select
Next

If f\bList[f\bCount-1]\sprite=0
f\bList[f\bCount-1]\sprite=nCreateSprite()

EntityFX f\bList[f\bCount-1]\sprite, 16+1
;SpriteViewMode f\bList[f\bCount-1]\sprite, 2

;ScaleSprite f\bList[f\bCount-1]\sprite, 2, f\bList[f\bCount-1]\length/2
ScaleEntity f\bList[f\bCount-1]\sprite, 2, f\bList[f\bCount-1]\length/2, 1
EndIf
EndIf
EndIf

If split[sCount-1]="/"
sIdx=sIdx-1
EndIf
Case "coo", "coord", "coordinates"
If sIdx>0
For i=1 To sCount-1
If split[i]<>"/"
Select i
Case 1
jStack[sIdx-1]\x=Float(split[i])
Case 2
jStack[sIdx-1]\y=Float(split[i])
End Select
Else
Exit
EndIf
Next
EndIf
Case "name"
If sIdx>0
jStack[sIdx-1]\name=split[1]
EndIf
Case "/joint"
sIdx=sIdx-1

;/*
; * Bone
; */

Case "sprite", "bonesprite"
If f\bList[f\bCount-1]\sprite<>0
FreeEntity f\bList[f\bCount-1]\sprite
EndIf

f\bList[f\bCount-1]\sprite=nLoadSprite(split[1], 1+4)

EntityFX f\bList[f\bCount-1]\sprite, 16+1
;SpriteViewMode f\bList[f\bCount-1]\sprite, 2
Case "order"
If f\bList[f\bCount-1]\sprite<>0
EntityOrder f\bList[f\bCount-1]\sprite, Int(split[1])
EndIf

;/*
; * Animation
; */

Case "animation", "anim"
sIdx=0

a=newAnimationSeq()

f\aList[f\aCount]=a
f\aCount=f\aCount+1

vertexMode=1
Case "/animation", "/anim"
a=Null

vertexMode=0

;/*
; * Keyframe
; */

Case "keyframe", "kf"
k=newKeyframe()

If a<>Null
a\kList[a\kCount]=k
a\kCount=a\kCount+1
EndIf

For i=1 To sCount-1
Select split[i]
Case "frame", "endframe", "f"
k\endFrame=Int(split[2])
End Select
Next

vertexMode=1
Case "frame", "endframe", "f"
If k<>Null
k\endFrame=Int(split[1])
EndIf
Case "pos", "position"
If k<>Null
k\posX=Float(split[1])
k\posY=Float(split[2])
EndIf
Case "/keyframe", "/kf"
k=Null

vertexMode=0

;/*
; * Uhm.. dunno what else
; */

Default
; DebugLog split[0]
End Select
Wend

f\jList[0]\fix=True

Return f
End Function

Function nLoadSprite(path$, mode)
Local tmpSprite=CreateMesh()
Local tmpSurf=CreateSurface(tmpSprite)

v1=AddVertex(tmpSurf, -1, -1, 0, 0, 1)
v2=AddVertex(tmpSurf, 1, -1, 0, 1, 1)
v3=AddVertex(tmpSurf, -1, 1, 0, 0, 0)
v4=AddVertex(tmpSurf, 1, 1, 0, 1, 0)

AddTriangle(tmpSurf, v1, v2, v3)
AddTriangle(tmpSurf, v2, v4, v3)

EntityTexture tmpSprite, LoadTexture(path, mode)

Return tmpSprite
End Function

Function nCreateSprite()
Local tmpSprite=CreateMesh()
Local tmpSurf=CreateSurface(tmpSprite)

v1=AddVertex(tmpSurf, -1, -1, 0, 0, 1)
v2=AddVertex(tmpSurf, 1, -1, 0, 1, 1)
v3=AddVertex(tmpSurf, -1, 1, 0, 0, 0)
v4=AddVertex(tmpSurf, 1, 1, 0, 1, 0)

AddTriangle(tmpSurf, v1, v2, v3)
AddTriangle(tmpSurf, v2, v4, v3)

Return tmpSprite
End Function

;/*
; * Figure Functions
; */

Function newFigure.TFigure()
Local f.TFigure=New TFigure

f\posX=0
f\posY=0

f\animRunning=-1

f\piv=CreatePivot()

Return f
End Function

Function moveFigure(f.TFigure, x#, y#)
Local piv=CreatePivot()

PositionEntity piv, f\posX, f\posY, 0
RotateEntity piv, 0, 0, f\phiZ
MoveEntity piv, x, y, 0

f\posX=EntityX(piv)
f\posY=EntityY(piv)

FreeEntity piv
End Function

Function updateFigure(f.TFigure)
If f\animRunning>-1
nextFrame(f)
EndIf

moveFigure(f, f\vX, f\vY)

For i=0 To 5
adjustFigureLength(f)
Next
createFigureModel(f)
End Function

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

For i=0 To f\jCount-1
Delete f\jList[i]
Next

Delete f
End Function

Function createFigureModel(f.TFigure)
Local trash, x1#, y1#, x2#, y2#, length#

RotateEntity f\piv,0,0,0
PositionEntity f\piv,0,0,0

For i=0 To f\bCount-1
trash=f\bList[i]\sprite

If trash<>0
EntityParent trash, 0

x1#=f\bList[i]\j1\x
y1#=f\bList[i]\j1\y

x2#=f\bList[i]\j2\x
y2#=f\bList[i]\j2\y

PositionEntity trash, (x1+x2)/2, (y1+y2)/2, 0
RotateEntity trash, 0, 180, 180+ATan2(x2-x1, y2-y1)

EntityParent trash, f\piv
EndIf
Next

PositionEntity f\piv, f\posX, f\posY, 0

If f\dir=1
RotateEntity f\piv, 0, 0, f\phiZ
EndIf
If f\dir=-1
RotateEntity f\piv, 0, 180, f\phiZ
EndIf
End Function

Function newJoint.TJoint(x#, y#)
Local j.TJoint=New TJoint

j\x=x
j\y=y

j\cCount=0

Return j
End Function

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

Function getJointFromKeyframe.TJoint(k.TKeyframe, name$)
name=Lower(name)

For i=0 To k\jCount-1
If k\jList[i]\name$=name$
Return k\jList[i]
EndIf
Next

Return Null
End Function

Function cloneJoint.TJoint(j.TJoint)
Local jc.TJoint=New TJoint

jc\x=j\x
jc\y=j\y

jc\name=j\name

Return jc
End Function

Function newBone.TBone(j1.TJoint, j2.TJoint)
Local b.TBone=New TBone

b\j1=j1
b\j2=j2

b\length=Sqr((j1\x-j2\x)^2+(j1\y-j2\y)^2)

Return b
End Function

Function newAnimationSeq.TAnimationSequence()
Return New TAnimationSequence
End Function

Function newKeyframe.TKeyframe()
Return New TKeyframe
End Function

Function animateFigure(f.TFigure, seq=0)
Local copy.TJoint

f\kf=0
f\frame=0

If seq>=f\aCount
Return
EndIf

f\animRunning=seq

If f\aList[seq]\kList[0]\endFrame=0 Then
For i=0 To f\jCount-1
copy=getJointFromKeyframe(f\aList[seq]\kList[0], f\jList[i]\name$)

If copy<>Null
f\jList[i]\x=copy\x
f\jList[i]\y=copy\y
EndIf
Next

f\posX=f\posX+f\aList[seq]\kList[0]\posX
f\posY=f\posY+f\aList[seq]\kList[0]\posY

f\relX=f\aList[seq]\kList[0]\posX*f\dir
f\relY=f\aList[seq]\kList[0]\posY

moveFigure(f, f\relX, f\relY)
Else
setAnimationVelocity(f)
EndIf
End Function

Function nextFrame(f.TFigure)
Local copy.TJoint
Local seq=f\animRunning

If f\frame>=f\aList[seq]\kList[f\kf]\endFrame
f\kf=f\kf+1

If f\kf>=f\aList[seq]\kCount
f\animRunning=-1
f\frame=0
f\kf=0

Return
Else
setAnimationVelocity(f)
EndIf
EndIf

For i=0 To f\jCount-1
f\jList[i]\x=f\jList[i]\x+f\jList[i]\vX
f\jList[i]\y=f\jList[i]\y+f\jList[i]\vY
Next

moveFigure(f, f\dX, f\dY)

f\relX=f\relX+f\dX
f\relY=f\relY+f\dY

f\frame=f\frame+1
End Function

Function setAnimationVelocity(f.TFigure)
Local x1#, y1#, x2#, y2#

Local copy.TJoint
Local seq=f\animRunning
Local ef=f\aList[seq]\kList[f\kf]\endFrame

For i=0 To f\jCount-1
copy=getJointFromKeyframe(f\aList[seq]\kList[f\kf], f\jList[i]\name$)

If copy<>Null
x1#=f\jList[i]\x
y1#=f\jList[i]\y

x2#=copy\x
y2#=copy\y

f\jList[i]\vX=(x2-x1)/(ef-f\frame)
f\jList[i]\vY=(y2-y1)/(ef-f\frame)
Else
f\jList[i]\vX=0
f\jList[i]\vY=0
EndIf
Next

f\dX=(f\aList[seq]\kList[f\kf]\posX*f\dir-f\relX)/(ef-f\frame)
f\dY=(f\aList[seq]\kList[f\kf]\posY-f\relY)/(ef-f\frame)
End Function

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

Function stretchBone(b.TBone)
Local dx#, dy#, deltaL#, diff#

Local j1.TJoint
Local j2.TJoint

j1=b\j1
j2=b\j2

dx#=j1\x-j2\x
dy#=j1\y-j2\y

deltaL#=Sqr(dx^2+dy^2)
diff#=0.5*(b\length-deltaL)/deltaL

If j1\fix Or j2\fix
diff=diff*2
EndIf

If Not j1\fix
j1\x=j1\x+dx*diff
j1\y=j1\y+dy*diff
EndIf

If Not j2\fix
j2\x=j2\x-dx*diff
j2\y=j2\y-dy*diff
EndIf
End Function[/syntax]
Edit: Nach dem Versagen der Sprite Variante habe ich die Sprites nun durch kleine quadratische Meshes ersetzt, ich habe es noch nicht testen lassen, aber ich hoffe es funktioniert nun besser.

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

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

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

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

Inventarsystem

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

[syntax="bb"];/*
; * TItem
; *
; * TInventory
; */

Type TItem
;füllen nach belieben
End Type

Function newItem.TItem()
Return New TItem
End Function

Const MAX_ITEMS=128
Const MAX_RAD#=100

Type TInventory
Field posX
Field posY

Field turning
Field turnPhi

Field turnStep#

Field rad#
Field open

Field pos

Field iList.TItem[MAX_ITEMS]
Field iCount
End Type

Function newInventory.TInventory()
Local i.TInventory=New TInventory

i\turnStep=10

i\turnPhi=1
i\turning=False

i\pos=0

Return i
End Function

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

Function addItemToInveotory(inv.TInventory, it.TItem)
If inv\iCount>=MAX_ITEMS
Return
EndIf

inv\iList[inv\iCount]=it
inv\iCount=inv\iCount+1
End Function

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

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

inv\iCount=inv\iCount-1
End Function

Function drawInventory(inv.TInventory)
If Not inv\open
Return
EndIf

Local phi#, it.TItem, posX#, posY#

phi=360./inv\iCount

For i=0 To inv\iCount-1
posX=inv\posX + Cos(i*phi + inv\pos*phi + inv\turnPhi -90)*inv\rad
posY=inv\posY + Sin(i*phi + inv\pos*phi + inv\turnPhi -90)*inv\rad

Rect posX,posY,32,32,0
Text posX,posY,i

Count=Count+1
Next
End Function

Function turnInventory(inv.TInventory, steps=10)
If Not inv\open
Return
EndIf

Local it.TItem

If Not inv\turning
If KeyDown(203)
inv\turnPhi=-1

inv\turning=True
EndIf

If KeyDown(205)
inv\turnPhi=1

inv\turning=True
EndIf
EndIf

If inv\turning
inv\turnStep=inv\turnStep+1

inv\turnPhi=inv\turnPhi+360./inv\iCount/steps*Sgn(inv\turnPhi)

If inv\turnStep>=steps
inv\turning=False

inv\pos=(inv\pos+Sgn(inv\turnPhi)) Mod inv\iCount

inv\turnPhi=0
inv\turnStep=0
EndIf
EndIf
End Function

Function openInventory(inv.TInventory, steps=10)
inv\open=True
inv\rad=0

Local dRad#=MAX_RAD/steps

For i=0 To steps-1
inv\rad=inv\rad+dRad

Cls
drawInventory(inv)
Flip
Next
End Function

Function closeInventory(inv.TInventory, steps=10)
inv\rad=MAX_RAD

Local dRad#=MAX_RAD/steps

For i=0 To steps-1
inv\rad=inv\rad-dRad

Cls
drawInventory(inv)
Flip
Next

inv\open=False
End Function

;/*
; * Test Program
; */

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

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

timer=CreateTimer(60)
While Not KeyHit(1)

;If Not inv\turning
If KeyHit(30)
addItemToInveotory(inv, newItem())
EndIf
;EndIf

drawInventory(inv)
turnInventory(inv)

If KeyHit(57)
If inv\open
closeInventory(inv)
Else
openInventory(inv)
EndIf
EndIf

Flip 0
WaitTimer(timer)
Cls
Wend
End[/syntax]

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

Ende

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

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

Sommer, Sonne, Sonnenschein

darth — Sat, 26 Jun 2010 19:06:56 +0200

Hallo,

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

Polygon Schatten

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

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

Feuer

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

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

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

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

-----

DaDaPhysics

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

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

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

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

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

-----

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

MfG,
Darth

I am sailing

darth — Fri, 28 May 2010 23:51:51 +0200

Hallo,

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

Punkte:

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

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

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

Type TPoint
Field x#
Field y#

Field succ.TPoint
End Type

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

p\x=x
p\y=y

Return p
End Function

Function comparePoints(p1.TPoint, p2.TPoint)
f#=p1\x*p2\y-p2\x*p1\y

If f>0
Return True
EndIf

If f>=-0.0001 ; == 0
If Abs(p1\x)+Abs(p1\y)>Abs(p2\x)+Abs(p2\y)
Return True
EndIf
EndIf

Return False
End Function

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

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

Function drawAllPoints(rad#=2)
Local p.TPoint

For p=Each TPoint
drawPoint(p, rad)
Next
End Function

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

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

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

t\p1=p1
t\p2=p2
t\p3=p3

Return t
End Function

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

Function drawAllTriangles()
Local t.TTriangle

For t=Each TTriangle
drawTriangle(t)
Next
End Function

Function triangleArea#(t.TTriangle)
Local x1#, y1#, x2#, y2#

x1=t\p2\x-t\p1\x
y1=t\p2\y-t\p1\y

x2=t\p3\x-t\p1\x
y2=t\p3\y-t\p1\y

Return 0.5*Abs(x1*y2-y1*x2)
End Function

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

Const MAX_POINTS=100

Function buildConvexHull.TPoint()
Local points.TPoint[MAX_POINTS]
Local pCount=0

Local p.TPoint

For p=Each TPoint
p\succ=Null

points[pCount]=p
pCount=pCount+1
Next

If pCount<3
Return Null
EndIf

exchange(points, 0, indexOfLowestPoint(points, pCount))

Local pl.TPoint=newPoint(points[0]\x, points[0]\y)
makeRelTo(points, pCount, pl)

quickSort(points, 1, pCount-1)

pl\x=-pl\x : pl\y=-pl\y
makeRelTo(points, pCount, pl)

Delete pl

Local m=2
For i=3 To pCount-1
While isCCW(points[m-1], points[m], points)<=0
m=m-1
Wend

m=m+1
exchange(points, m, i)
Next

For i=1 To m
points[i-1]\succ=points[i]
Next

Return points[0]
End Function

Function buildConcaveHull.TPoint()
Local points.TPoint[MAX_POINTS]
Local pCount=0

Local p.TPoint

For p=Each TPoint
p\succ=Null

points[pCount]=p
pCount=pCount+1
Next

If pCount<3
Return Null
EndIf

exchange(points, 0, indexOfLowestPoint(points, pCount))

Local pl.TPoint=newPoint(points[0]\x, points[0]\y)
makeRelTo(points, pCount, pl)

quickSort(points, 1, pCount-1)

pl\x=-pl\x : pl\y=-pl\y
makeRelTo(points, pCount, pl)

Delete pl

For i=1 To pCount-1
points[i-1]\succ=points[i]
Next

Return points[0]
End Function

Function quickSort(p.TPoint[MAX_POINTS], lo, hi)
Local i=lo, j=hi
Local q.TPoint=p[(lo+hi)/2]

While i<=j
While comparePoints(p[i], q)
i=i+1
Wend

While comparePoints(q, p[j])
j=j-1
Wend

If i<=j
exchange(p, i, j)
i=i+1
j=j-1
EndIf
Wend

If lo<j
quickSort(p, lo, j)
EndIf

If i<hi
quickSort(p, i, hi)
EndIf
End Function

Function makeRelTo(p.TPoint[MAX_POINTS], count, p0.TPoint)
Local p1.TPoint=newPoint(p0\x, p0\y)

For i=0 To count-1
p[i]\x=p[i]\x-p1\x
p[i]\y=p[i]\y-p1\y
Next

Delete p1
End Function

Function indexOfLowestPoint(p.TPoint[MAX_POINTS], count)
Local i, min=0

For i=1 To count-1
If p[i]\y>p[min]\y Or (p[i]\y=p[min]\y And p[i]\x<p[min]\x)
min=i
EndIf
Next

Return min
End Function

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

Function drawHull(p.TPoint)
Local started, oldX#, oldY#

Local startX#=p\x
Local startY#=p\y

Local pStart.TPoint=p

While p<>Null
If Not started
oldX=p\x
oldY=p\y

started=True
Else
Line oldX, oldY, p\x, p\y

oldX=p\x
oldY=p\y
EndIf

p=p\succ

If p=pStart
Exit
EndIf
Wend

If started
Line oldX, oldY, startX, startY
EndIf
End Function

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

Function generateDelaunay()
Delete Each TTriangle

Local p1.TPoint, p2.TPoint, p3.TPoint, p4.TPoint, t.TTriangle
Local pointValid, mx#, my#, rad#, m1x#, m1y#, n1x#, n1y#, m2x#, m2y#, n2x#, n2y#, k#

For p1=Each TPoint
p2=After p1
While p2<>Null
p3=After p2
While p3<>Null
m1x=(p1\x+p2\x)/2
m1y=(p1\y+p2\y)/2

n1x=p2\y-p1\y
n1y=p1\x-p2\x

m2x=(p2\x+p3\x)/2
m2y=(p2\y+p3\y)/2

n2x=p3\y-p2\y
n2y=p2\x-p3\x

k=-(m1x*n2y-m1y*n2x-m2x*n2y+m2y*n2x)/(n1x*n2y-n1y*n2x)

mx=m1x+k*n1x
my=m1y+k*n1y

rad=Sqr((p1\x-mx)^2+(p1\y-my)^2)

pointValid=True
For p4=Each TPoint
If p4<>p1 And p4<>p2 And p4<>p3
If Sqr((p4\x-mx)^2+(p4\y-my)^2)<=rad
pointValid=False
Exit
EndIf
EndIf
Next

If pointValid
t=newTriangle(p1, p2, p3)
EndIf

p3=After p3
Wend

p2=After p2
Wend
Next
End Function

;/*
; * Test Programm
; */

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

Local p.TPoint
Local t.TTriangle

Local Timer=CreateTimer(60)
While Not KeyHit(1)
Color 0,255,0
If MouseHit(1)
p=newPoint(MouseX(), MouseY())
EndIf

drawAllPoints(4)

Color 255,255,0
generateDelaunay()
drawAllTriangles()

Color 0,0,255
p=buildConcaveHull()
If p<>Null
; drawHull(p)
EndIf

Color 255,255,255
p=buildConvexHull()
If p<>Null
; drawHull(p)
EndIf

Flip 0
WaitTimer(Timer)
Cls
Wend
End[/syntax]

Stokes:

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

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

Wasser:

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

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

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

Global WATERCAM

Function initWaterCam()
WATERCAM=CreateCamera()

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

Const MAX_WAVE_COUNT=128

Type TWave
Field pList.TWavePoint[MAX_WAVE_COUNT]
Field pCount

Field segmentSize#

Field xStart#
Field xStop#
Field ySurface#
Field yBottom#

Field mesh
Field surf
End Type

Type TWavePoint
Field x#
Field y#

Field vx#
Field vy#

Field fix
End Type

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

w\x=x
w\y=y

Return w
End Function

Function newWave.TWave(xStart#, xEnd#, y#, yBottom#, size#)
Local w.TWave=New TWave

w\segmentSize=size

Local p1.TWavePoint, p2.TWavePoint
Local x#=xStart

w\xStart=xStart
w\xStop=xEnd
w\ySurface=y
w\yBottom=yBottom

While x<=xEnd
addNewWavePoint(w, x, y)

x=x+size
Wend

w\pList[0]\fix=True
w\pList[w\pCount-1]\fix=True

w\mesh=CreateMesh()
w\surf=CreateSurface(w\mesh)

PositionEntity w\mesh, -GraphicsWidth()/2, -GraphicsHeight()/2, 0
EntityFX w\mesh,16

Return w
End Function

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

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

Function updateWave(w.TWave)
Local wpAct.TWavePoint, wpPre.TWavePoint, wpSuc.TWavePoint
Local mY#

For i=1 To w\pCount-2
wpPre=w\pList[i-1]
wpAct=w\pList[i]
wpSuc=w\pList[i+1]

mY=(wpPre\y+wpSuc\y)/2

wpAct\vy=(mY-wpAct\y+wpAct\vy)*0.98
Next

For i=0 To w\pCount-1
If Not w\pList[i]\fix
w\pList[i]\y=w\pList[i]\y+w\pList[i]\vy
EndIf
Next

ClearSurface w\surf, True, True

Local v1, v2, v3, v4
Local stp#=1./w\pCount

v1=AddVertex(w\surf, w\pList[0]\x, w\pList[0]\y, 0, stp*i, 0)
v2=AddVertex(w\surf, w\pList[0]\x, w\yBottom, 0, stp*i, 1)

For i=1 To w\pCount-1
v3=AddVertex(w\surf, w\pList[i]\x, w\pList[i]\y, 0, stp*i, 0)
v4=AddVertex(w\surf, w\pList[i]\x, w\yBottom, 0, stp*i, 1)

AddTriangle(w\surf, v1, v2, v3)
AddTriangle(w\surf, v3, v4, v2)

v1=v3
v2=v4
Next
End Function

Function addWaveSource(w.TWave, x#, height#, width#)
Local dist#

For i=0 To w\pCount-1
If Not w\pList[i]\fix
dist=Abs(x-w\pList[i]\x)

If dist<width/2
w\pList[i]\y=w\pList[i]\y-height
EndIf
EndIf
Next
End Function

;/*
; * Testprogramm
; */

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

initWaterCam()

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

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

Local timer=CreateTimer(60)
While Not KeyHit(1)
RenderWorld

updateWave(w)

If MouseHit(1)
addWaveSource(w, MouseX(), 50, 30)
EndIf

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

Flip 0
Cls
WaitTimer(timer)
Wend
End[/syntax]

Intermezzo:

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

-----

DaDaPhysics:

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

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

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

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

-----

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

Squad..

darth — Fri, 14 May 2010 17:00:34 +0200

Hallo,

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

LSysteme:

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

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

Pattern Recognition:

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

[syntax="bb"];/*
; * KMP
; */

Const MAX_LENGTH=128

Function KMP_Analyze(m$, jump[MAX_LENGTH])
Local mLen=Len(m)

Local i=1, j=0

While i<mLen
If Mid(m, i+1, 1)=Mid(m, j+1, 1)
jump=j+1

i=i+1
j=j+1
Else
If j>0
j=jump[j-1]
Else
jump[i]=0
i=i+1
EndIf
EndIf
Wend
End Function

Function KMP(txt$, muster$, i0=0)
Local jump[MAX_LENGTH]
KMP_Analyze(muster, jump)

Local n=Len(txt)
Local m=Len(muster)

Local i=i0, j=0

While i<n
If Mid(txt, i+1, 1)=Mid(muster, j+1, 1)
If j=m-1
Return i-m+1
EndIf

i=i+1
j=j+1
Else
If j>0
j=jump[j-1]
Else
i=i+1
EndIf
EndIf
Wend

Return -1
End Function

;/*
; * Test
; */

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

Local i=KMP(txt, muster)

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

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

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

WaitKey()[/syntax]

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

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

Const d=-5

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

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

Const MAX_LENGTH=64

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

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

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

Function calculateMatrix(source[MAX_LENGTH], sLength, dest[MAX_LENGTH], dLength, res[(MAX_LENGTH+1)*(MAX_LENGTH+1)])
For y=0 To sLength-1
res[y]=d*y
Next

For x=0 To dLength-1
res[x*(MAX_LENGTH+1)]=d*x
Next

Local k, l, m

For y=1 To sLength
For x=1 To dLength
k=res[(y-1) + (x-1)*(MAX_LENGTH+1)] + simularity[source[y-1]*4 + dest[x-1]]
l=res[(y-1) + x*(MAX_LENGTH+1)] + d
m=res[y + (x-1)*(MAX_LENGTH+1)] + d

res[y + x*(MAX_LENGTH+1)]=max(max(k, l),m)
Next
Next
End Function

Function convertStringToArray(s$, ar[MAX_LENGTH])
Local n

For i=1 To Len(s)
Select Mid(s, i, 1)
Case "A"
n=0
Case "G"
n=1
Case "C"
n=2
Case "T"
n=3
Default
n=-1
End Select

ar[i-1]=n
Next
End Function

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

Global result1$, result2$

Function getAlignment(ar[(MAX_LENGTH+1)*(MAX_LENGTH+1)], A[MAX_LENGTH], B[MAX_LENGTH], sA$, sB$)
Local alA$=""
Local alB$=""

Local i=Len(sA)
Local j=Len(sB)

Local score, scorediag, scoreup, scoreleft

While i>0 And j>0
score=ar[i + j*(MAX_LENGTH+1)]
scorediag=ar[(i-1) + (j-1)*(MAX_LENGTH+1)]
scoreup=ar[i + (j-1)*(MAX_LENGTH+1)]
scoreleft=ar[(i-1) + j*(MAX_LENGTH+1)]

If score=scorediag+simularity[A[i-1]*4+B[j-1]]
alA=Mid(sA, i, 1)+alA
alB=Mid(sB, j, 1)+alB

i=i-1
j=j-1
ElseIf score=scoreleft+d
alA=Mid(sA, i, 1)+alA
alB="-"+alB

i=i-1
ElseIf score=scoreup+d
alA="-"+alA
alB=Mid(sB, j, 1)+alB

j=j-1
EndIf
Wend

While i>0
alA=Mid(sA, i, 1)+alA
alB="-"+alB

i=i-1
Wend

While j>0
alA="-"+alA
alB=Mid(sB, j, 1)+alB
Wend

result1=alA
result2=alB
End Function

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

Function getLevenshteinDistance(s$, t$)
Local n=Len(s)
Local m=Len(t)

If n=0
Return m
ElseIf m=0
Return n
EndIf

Local p[100], plen=n+1
Local d[100], dLen=n+1
Local tmp

Local i, j
Local tj$
Local cost

For i=0 To n
p=i
Next

For j=1 To m
tj=Mid(t, j, 1)
d[0]=j

For i=1 To n
If Mid(s, i, 1)=tj
cost=0
Else
cost=1
EndIf

d[i]=min(min(d[i-1]+1, p[i]+1), p[i-1]+cost)
Next

For i=0 To n ;array swap
tmp=p[i]
p[i]=d[i]
d[i]=tmp
Next
Next

Return p[n]
End Function

;/*
; * Test
; */

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

Local ar1[MAX_LENGTH]
Local ar2[MAX_LENGTH]

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

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

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

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

Print result1
Print result2

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

WaitKey()[/syntax]

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

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

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

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

Und weiter gehts..

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

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

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

Und noch ein Versuch..

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

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

Der Graph von MonteChristo

darth — Sat, 01 May 2010 17:33:53 +0200

Hallo,

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

Splines:

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

[syntax="bb"]Type Vector2
Field x#
Field y#
End Type

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

v\x=x
v\y=y

Return v
End Function

Const MAX_SPLINE_POINTS=128

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

Function cTSpline.TSpline()
Return New TSpline
End Function

Function addPointToSpline(s.TSpline, p.Vector2)
If s\count>=MAX_SPLINE_POINTS
Return
EndIf

s\p[s\count]=p
s\count=s\count+1
End Function

Function removePointFromSpline(s.TSpline, i)
If s\count<1
Return
EndIf

Delete s\p

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

s\count=s\count-1
End Function

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

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

cp\a=a
cp\b=b
cp\c=c
cp\d=d

Return cp
End Function

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

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

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

;// cp wird gefüllt
Function calcNatSpline(n, x[MAX_SPLINE_POINTS], cp.CubicPolynom[MAX_SPLINE_POINTS])
Local gamma#[MAX_SPLINE_POINTS]
Local delta#[MAX_SPLINE_POINTS]
Local d#[MAX_SPLINE_POINTS]

gamma[0]=0.5
For i=1 To n-1
gamma[i]=1./(4-gamma[i-1])
Next
gamma[n]=1./(2-gamma[n-1])

delta[0]=3*(x[1]-x[0])*gamma[0]
For i=1 To n-1
delta[i]=(3*(x[i+1]-x[i-1])-delta[i-1])*gamma[i]
Next
delta[n]=(3*(x[n]-x[n-1])-delta[n-1])*gamma[n]

d[n]=delta[n]
For i=n-1 To 0 Step -1
d[i]=delta[i]-gamma[i]*d[i+1]
Next

For i=0 To n-1
cp[i]=cCubicPolynom(x[i], d[i], 3*(x[i+1]-x[i])-2*d[i]-d[i+1], 2*(x[i]-x[i+1])+d[i]+d[i+1])
Next
End Function

Global STEPS=10
Global fSTEPS#=STEPS

Function drawSpline(s.TSpline)
LockBuffer BackBuffer()

If s\count>1
Local x[MAX_SPLINE_POINTS]
Local y[MAX_SPLINE_POINTS]

fillXCoordinates(s, x)
fillYCoordinates(s, y)

Local cx.CubicPolynom[MAX_SPLINE_POINTS]
Local cy.CubicPolynom[MAX_SPLINE_POINTS]

calcNatSpline(s\count-1, x, cx)
calcNatSpline(s\count-1, y, cy)

Local px1, py1, px2, py2
Local u#

For i=0 To s\count-2
px1=valueCP(cx[i], 0)
py1=valueCP(cy[i], 0)

For j=1 To STEPS
u=j/fSTEPS

px2=valueCP(cx[i], u)
py2=valueCP(cy[i], u)

Line px1, py1, px2, py2

px1=px2
py1=py2
Next
Next
EndIf

UnlockBuffer BackBuffer()

;// remove if used
For i=0 To s\count-1
Oval s\p[i]\x-2, s\p[i]\y-2, 4, 4
Next
End Function

Function getPointByMouse.Vector2(s.TSpline)
Local minDist#=1000000
Local dist#
Local pSel.Vector2

For i=0 To s\count-1
dist=Sqr((MouseX()-s\p[i]\x)^2+(MouseY()-s\p[i]\y)^2)

If dist<minDist
minDist=dist
pSel=s\p[i]
EndIf
Next

Return pSel
End Function

;/*
; * Test Program
; */

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

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

While Not KeyHit(1)
Color 255,255,255

drawSpline(s)

Text 10,10,s\count

If MouseDown(1)
pSel.Vector2=getPointByMouse(s)
If pSel<>Null
pSel\x=MouseX()
pSel\y=MouseY()
EndIf
EndIf

If MouseHit(2)
addPointToSpline(s, cVector2(MouseX(), MouseY()))
EndIf

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

Flip 0
Cls
Wend
End[/syntax]

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

Binäre Bäume:

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

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

[syntax="bb"];/*
; * AVL Tree
; */

Type TreeNode
Field value

Field cLeft.TreeNode
Field cRight.TreeNode
End Type

Function newTreeNode.TreeNode(x)
Local n.TreeNode=New TreeNode

n\value=x

Return n
End Function

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

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

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

Function insertToTree.TreeNode(n.TreeNode, x)
If n=Null
n=newTreeNode(x)
Else
If x<n\value
n\cLeft=insertToTree(n\cLeft, x)

If treeDepth(n\cLeft)-treeDepth(n\cRight)=2
If x<n\cLeft\value<0
n=rotateWithLeftChild(n)
Else
n=doubleRotateWithLeftChild(n)
EndIf
EndIf
ElseIf x>n\value
n\cRight=insertToTree(n\cRight, x)

If treeDepth(n\cRight)-treeDepth(n\cLeft)=2
If x>n\cRight\value
n=rotateWithRightChild(n)
Else
n=doubleRotateWithRightChild(n)
EndIf
EndIf
Else
;doppelter Wert
; hier wird er ignoriert
; man könnte ihn theoretisch auch einfügen..
EndIf
EndIf

Return n
End Function

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

n\cLeft=n2\cRight
n2\cRight=n

Return n2
End Function

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

n\cRight=n2\cLeft
n2\cLeft=n

Return n2
End Function

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

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

Function removeFromTree.TreeNode(root.TreeNode, x)
;eine sinnvolle Implementation ist nervig
; ich entferne den Knoten
; und füge nachher all seine Kinder wieder ein
;
; kann mit grosser Wahrscheinlichkeit effizienter gelöst werden
; aber das ist mir egal

Local rem.TreeNode=findInTree(root, x)
Local remParent.TreeNode=findParentinTree(root, rem)

If remParent\cLeft=rem
remParent\cLeft=Null
EndIf

If remParent\cRight=rem
remParent\cRight=Null
EndIf

root=insertBranchToTree(root, rem\cLeft)
root=insertBranchToTree(root, rem\cRight)

Return root
End Function

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

Return Null
End Function

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

If hasRight(n)
If c\value=n\cRight\value
Return n
EndIf
EndIf

If c\value>n\value
n=n\cRight
Else
n=n\cLeft
EndIf
Wend

Return Null
End Function

Function insertBranchToTree.TreeNode(root.TreeNode, n.TreeNode)
If n=Null
Return root
EndIf

insertToTree(root, n\value)

root=insertBranchToTree(root, n\cLeft)
root=insertBranchToTree(root, n\cRight)

Return root
End Function

Function treeDepth(n.TreeNode, d=0, max=0)
If n=Null
If d>max
Return d
Else
Return max
EndIf
EndIf

max1=treeDepth(n\cLeft, d+1, max)
max2=treeDepth(n\cRight, d+1, max)

If max1>max
max=max1
EndIf
If max2>max
max=max2
EndIf

Return max
End Function

Function printTree(n.TreeNode)
If n=Null
Return
EndIf

printTree(n\cLeft)
Print n\value
printTree(n\cRight)
End Function

Function dispTree(n.TreeNode, x, y)
If n=Null
Return
EndIf

Local maxDepth=treeDepth(n)
Local b#=5, h#=50

Text x, y, n\value

If hasLeft(n)
Line x+Len(n\value)*4, y+14, x-b*2^maxDepth+Len(n\cLeft\value)*4, y+h-2
EndIf

If hasRight(n)
Line x+Len(n\value)*4, y+14, x+b*2^maxDepth+Len(n\cRight\value)*4, y+h-2
EndIf

dispTree(n\cLeft, x-b*2^maxDepth, y+h)
dispTree(n\cRight, x+b*2^maxDepth, y+h)
End Function

;/*
; * Test
; */

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

root=removeFromTree(root, 46)

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

printTree(root)

dispTree(root, 400, 50)

Flip 0
WaitKey()[/syntax]

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

Dijikstra:

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

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

[syntax="bb"];/*
; * Weighted Graph
; * Dijkstra Example
; */

Type TVertex
Field value$
End Type

Function newTVertex.TVertex(value$)
Local v.TVertex=New TVertex

v\value=value

Return v
End Function

Type TEdge
Field n1.TVertex
Field n2.TVertex

Field cost
End Type

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

e\n1=n1
e\n2=n2

e\cost=cost

Return e
End Function

Const MAX_NODES=128
Const MAX_EDGES=128

Type TGraph
Field v.TVertex[MAX_NODES]
Field vCount

Field e.TEdge[MAX_EDGES]
Field eCount
End Type

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

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

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

Function newTGraphPathNode.TGraphPathNode(v.TVertex)
Local gpn.TGraphPathNode=New TGraphPathNode

gpn\v=v

gpn\succ=Null
gpn\prev=Null

Return gpn
End Function

Const INF=1000000
Function dijkstra.TGraphPathNode(g.TGraph, source.TVertex)
Local dist#[MAX_NODES]

Local Q.TVertex[MAX_NODES]
Local qCount=0

For i=0 To g\vCount-1
dist=INF+1 ;TO INFINITY, AND BEYOND!

Q[i]=g\v[i]
Next
qCount=g\vCount

Local sourceID

For i=0 To g\vCount-1
If g\v[i]=source
sourceID=i
Exit
EndIf
Next

dist[sourceID]=0

Local s.TGraphPathNode
Local pStart.TGraphPathNode

Local u.TVertex, uId
Local smallest#, alt#

While qCount>0

;suche den nächsten Nachbarn
smallest=INF+1
For i=0 To qCount-1
If dist[i]<smallest
smallest=dist[i]

u=Q[i]
uId=i
EndIf
Next

;kein Nachbar erreichbar
; abbruch, oder zurückliefern der bisherigen Liste
If smallest>=INF
;Return Null
Exit
EndIf

;entfernt u von der Liste
For i=uId To qCount-2
Q[i]=Q[i+1]
dist[i]=dist[i+1]
Next
qCount=qCount-1

;Erneuern der Distanzen/Pfadkosten
For i=0 To qCount-1
alt=getEdgeCost(g, u, Q[i])
If alt>=0
If alt<dist[i]
dist[i]=alt
EndIf
EndIf
Next

;Generieren des neuen Pfadknotens
If s=Null
s=newTGraphPathNode(u)

pStart=s ;damit ich den pfad nicht "zurückspulen" muss
Else
s\succ=newTGraphPathNode(u)
s\succ\prev=s

s=s\succ
EndIf
Wend

Return pStart
End Function

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

Return -1
End Function

;/*
; * Test program
; */

g.TGraph=New TGraph

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

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

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

s.TGraphPathNode=dijkstra(g, v1)

While s<>Null
Print s\v\value

s=s\succ
Wend

WaitKey()[/syntax]

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

Bump Mapping:

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

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

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

[syntax="bb"]Function fillTrig(x1#, y1#, x2#, y2#, x3#, y3#)
Local aX#, aY#, bX#, bY#, cX#, cY#

If y1<=y2 And y1<=y3
aX=x1
aY=y1

If y2<y3
bX=x2
bY=y2

cX=x3
cY=y3
Else
bX=x3
bY=y3

cX=x2
cY=y2
EndIf
EndIf

If y2<=y1 And y2<=y3
aX=x2
aY=y2

If y1<y3
bX=x1
bY=y1

cX=x3
cY=y3
Else
bX=x3
bY=y3

cX=x1
cY=y1
EndIf
EndIf

If y3<=y1 And y3<=y2
aX=x3
aY=y3

If y1<y2
bX=x1
bY=y1

cX=x2
cY=y2
Else
bX=x2
bY=y2

cX=x1
cY=y1
EndIf
EndIf

Local dx1#, dx2#, dx3#

If bY-aY>0
dx1=(bX-aX)/(bY-aY)
Else
dx1=0
EndIf

If cY-aY>0
dx2=(cX-aX)/(cY-aY)
Else
dx2=0
EndIf

If cY-bY>0
dx3=(cX-bX)/(cY-bY)
Else
dx3=0
EndIf

Local sX#, sY#, eX#

sX=aX
sY=aY

eX=aX

If dx1>dx2
While sY<=bY
Line sX, sY, eX, sY

sY=sY+1

sX=sX+dx2
eX=eX+dx1
Wend

eX=bX

While sY<=cY
Line sX, sY, eX, sY

sY=sY+1

sX=sX+dx2
eX=eX+dx3
Wend
Else
While sY<=bY
Line sX, sY, eX, sY

sY=sY+1

sX=sX+dx1
eX=eX+dx2
Wend

sX=bX
sY=bY

While sY<=cY
Line sX, sY, eX, sY

sY=sY+1

sX=sX+dx3
eX=eX+dx2
Wend
EndIf
End Function[/syntax]

Ende

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

Dann bis zum nächsten Mal,
MfG,
Darth

Meh!

darth — Thu, 22 Apr 2010 21:22:03 +0200

Hallo,

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

Trubadur

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

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

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

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

Hier der Download Link (~1MB)

What da Fock?

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

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

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

Evolution

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

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

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

[syntax="bb"];/*
; * Spieler Verwaltung
; */

Const MAX_MEM=100

Global pList.TPlayer[100]
Global plCount=0

Type TPlayer
Field fieldState$[MAX_MEM]
Field reaction[MAX_MEM]

Field stone$

Field sCount

Field victories
Field defeats
Field ties

Field age
End Type

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

p\stone=stone

Return p
End Function

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

Function addRndPlayers(anz)
Local s

For i=1 To anz
s=Rand(1,2)

If s=1
pList[plCount]=cTPlayer("X")
Else
pList[plCount]=cTPlayer("O")
EndIf

plCount=plCount+1
Next
End Function

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

Function removePlayerByIndex(i)
If plCount=0
Return
EndIf

Delete pList[i]

For j=i+1 To plCount-1
pList[j-1]=pList[j]
Next
pList[plCount-1]=Null

plCount=plCount-1
End Function

;/*
; * KI Verwaltung
; */

Function playerMove(p.TPlayer)
Local s$=getFieldState()
Local i=stateKnown(p, s)
Local iNeu

If i<>-1
If tField[p\reaction[i]]="-"
tField[p\reaction[i]]=p\stone
Else
While True
set=setRandom()
If tField[set]="-"
tField[set]=p\stone

Exit
EndIf
Wend
EndIf
Else
While True
set=setRandom()

If tField[set]="-"
tField[set]=p\stone
saveState(p, s, set)

Exit
EndIf
Wend
EndIf
End Function

Function setRandom()
Local poss[9]
Local pCount=0

For i=0 To 8
If tField[i]="-"
poss[pCount]=i
pCount=pCount+1
EndIf
Next

Return poss[Rand(0,pCount-1)]
End Function

Function getFieldState$()
Local s$=""

For i=0 To 8
If tField[i]=""
tField[i]="-"
EndIf

s=s+tField[i]
Next

Return s
End Function

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

Return -1
End Function

Function saveState(p.TPlayer, state$, reaction)
If p\sCount>=MAX_MEM
Return
EndIf

If stateKnown(p, state)=-1
p\fieldState[p\sCount]=state
p\reaction[p\sCount]=reaction

p\sCount=p\sCount+1
EndIf
End Function

;/*
; * Evolution
; */

Function nextGeneration(games)
For i=0 To games
startGame()

While Not checkVictory()
gameRoutine()
Wend
Next

quickSort(pList, 0, plCount-1)

Local oldCount=plCount
Local halfCount=plCount/2

For i=plCount-1 To plCount-halfCount Step -1
addPlayer(giveBirth(pList[i], pList[i-1]))
addPlayer(giveBirth(pList[i], pList[Rand(0,plCount-1)]))
Next

For i=0 To halfCount-1
removePlayerByIndex(0)
Next

removePlayerByIndex(Rand(0, halfCount-1))
addRndPlayers(1)

If plCount<oldCount
For i=plCount To oldCount-1
addRndPlayers(1)
Next
ElseIf plCount>oldCount
While plCount<>oldCount
removePlayerByIndex(Rand(0, Rand(0, plCount-1)))
Wend
EndIf
End Function

Function giveBirth.TPlayer(p1.TPlayer, p2.TPlayer)
Local count=(p1\sCount+p2\sCount)/2
Local p.TPlayer

If Rand(0,1)=0
p=cTPlayer("O")
Else
p=cTPlayer("X")
EndIf

For i=0 To count-1
If Rand(0,1)=0
If i<p1\sCount
saveState(p, p1\fieldState[i], p1\reaction[i])
Else
saveState(p, p2\fieldState[i], p2\reaction[i])
EndIf
Else
If i<p2\sCount
saveState(p, p2\fieldState[i], p2\reaction[i])
Else
saveState(p, p1\fieldState[i], p1\reaction[i])
EndIf
EndIf
Next

Return p
End Function

Function quickSort(list.TPlayer[100], le, ri)
Local l_tmp, r_tmp, piv, pivEl.TPlayer

l_tmp=le
r_tmp=ri
piv=list[le]\victories
pivEl=list[le]

While le<ri
While list[ri]\victories>=piv And le<ri
ri=ri-1
Wend
If le<>ri
list[le]=list[ri]
le=le+1
EndIf
While list[le]\victories<=piv And le<ri
le=le+1
Wend
If le<>ri
list[ri]=list[le]
ri=ri-1
EndIf
Wend

list[le]=pivEl
piv=le
le=l_tmp
ri=r_tmp

If le<piv
quickSort(list, le, piv-1)
EndIf

If ri>piv
quickSort(list, piv+1, ri)
EndIf
End Function

Function savePlayers()
Local stream=WriteFile("TTT_AI.txt")
Local p.TPlayer

quickSort(pList, 0, plCount-1)

For j=0 To plCount-1
p=pList[j]

If p\sCount>0
WriteLine stream, "Player "+p\stone
WriteLine stream, p\sCount

For i=0 To p\sCount-1
WriteLine stream, p\fieldState[i]+" "+p\reaction[i]
Next
EndIf
Next
End Function

Function loadPlayers()
Local stream=ReadFile("TTT_AI.txt")
Local p.TPlayer, s$

While Not Eof(stream)
s=ReadLine(stream)

If s=Left(s, 6)="Player"
p=New TPlayer

p\stone=Right(s,1)
p\sCount=Int(ReadLine(stream))

For i=0 To p\sCount-1
s=ReadLine(stream)

p\fieldState[i]=Left(s, 9)
p\reaction[i]=Right(s, 1)
Next

pList[plCount]=p
plCount=plCount+1
EndIf
Wend
End Function

;/*
; * Spiel Verwaltung
; */

Const FIELD_SIZE=50
Global tField$[9]

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

Global human=True
Global turn=0

Function startGame()
For i=0 To 8
tField[i]="-"
Next

If human
If player1=Null
player1=cTPlayer("O")
EndIf
Else
If plCount=0
player1=cTPlayer("O")

pList[0]=player1
plCount=plCount+1
Else
player1=pList[Rand(0, plCount-1)]
EndIf
EndIf

If plCount=0 Or (plCount=1 And human=False)
player2=cTPlayer("X")

pList[plCount]=player2
plCount=plCount+1
Else
While True
player2=pList[Rand(0, plCount-1)]

If player2<>player1
If player2\stone<>player1\stone
Exit
EndIf
EndIf
Wend
EndIf

turn=0

victor=Null

player1\age=player1\age+1
player2\age=player2\age+1

SeedRnd(MilliSecs())
End Function

Function gameRoutine()
If checkVictory()=True
Return
EndIf

If player1=Null Or player2=Null
Return
EndIf

If turn=0
If human
If MouseHit(1)
If setStone(player1\stone, MouseX(), MouseY())
turn=1-turn
EndIf
EndIf
Else
playerMove(player1)
turn=1-turn
EndIf
Else
playerMove(player2)
turn=1-turn
EndIf
End Function

Function setStone(stone$, sx, sy)
Local x=sx/FIELD_SIZE
Local y=sy/FIELD_SIZE

If tField[x+y*3]="-"
saveState(player1, getFieldState(), x+y*3)

tField[x+y*3]=stone$
Return True
EndIf

Return False
End Function

Function checkVictory()
If player1=Null Or player2=Null
Return True
EndIf

Local vic$

For i=0 To 2
vic=tField[i*3]
For x=0 To 2
If tField[i*3+x]<>vic
vic="-"
EndIf
Next

If vic<>"-"
Exit
EndIf

vic=tField[i]
For y=0 To 2
If tField[i+y*3]<>vic
vic="-"
EndIf
Next

If vic<>"-"
Exit
EndIf

vic="-"
Next

If tField[0]=tField[4] And tField[4]=tField[8]
If tField[0]<>"-"
vic=tField[0]
EndIf
EndIf

If tField[2]=tField[4] And tField[4]=tField[6]
If tField[2]<>"-"
vic=tField[2]
EndIf
EndIf

If vic="O"
victor=player1
player1\victories=player1\victories+1
player2\defeats=player2\defeats+1

Return True
ElseIf vic="X"
victor=player2
player2\victories=player2\victories+1
player1\defeats=player1\defeats+1

Return True
EndIf

For i=0 To 8
If tField[i]="-"
Return False
EndIf
Next

victor=Null
player1\ties=player1\ties+1
player2\ties=player2\ties+1

Return True
End Function

Function drawField()
Local y=0
Local x=0

For i=0 To 8
If tField[i]<>"-"
Text x*FIELD_SIZE, y*FIELD_SIZE, tField[i]
EndIf

x=x+1

If x Mod 3=0
y=y+1
x=0
EndIf
Next

For x=1 To 2
Line x*FIELD_SIZE, 0, x*FIELD_SIZE, FIELD_SIZE*3
Next

For y=1 To 2
Line 0, y*FIELD_SIZE, FIELD_SIZE*3, y*FIELD_SIZE
Next
End Function

;/*
; * Testumgebung
; */

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

human=False
addRndPlayers(20)

For i=0 To 500
nextGeneration(10)
Next

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

Local timer=CreateTimer(60)
While Not KeyHit(1)

gameRoutine()
drawField()

If checkVictory()
startGame()

player2=pList[plCount-1]
player1=cTPlayer("")

If player2\stone="X"
player1\stone="O"
Else
player1\stone="X"
EndIf
EndIf

Flip 0
WaitTimer(timer)
Cls
Wend

;savePlayers()

End[/syntax]

Bakterien und so

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

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

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

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

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

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

[syntax="bb"]Graphics 800,600,0,2
SetBuffer BackBuffer()

;/*
; * MetaBall
; */

Const threshold#=0.004

Type MetaBall
Field x#
Field y#

Field vx#
Field vy#
End Type

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

;For y=0 To GraphicsHeight()-1
; peakValues(0, y)=GraphicsWidth()
;Next

Dim fieldData(gridWidth,gridHeight)
Dim fieldDone(gridWidth,gridHeight)
Dim fieldRendered(gridWidth,gridHeight)

Local hull.Path

Local MX
Local MY

Local count=0
LockBuffer BackBuffer()

For m.metaBall=Each MetaBall
MX=m\x*gridWidth/GraphicsWidth()+1
MY=m\y*gridHeight/GraphicsHeight()+1

For yi=MY To 1 Step -1
If Not fieldDone(MX,yi)
fieldData(MX,yi)=getDataField(MX, yi)
EndIf

If yi<MY
If fieldData(MX, yi)=0
If fieldData(MX, yi+1)=1 And fieldRendered(MX, yi+1)=False
hull=identifyPerimeter(MX, yi+1)

If hull=Null
stopped=True
Else
hull\parent=m
drawPath(hull)

count=count+1
EndIf
EndIf

Exit
EndIf
EndIf
Next
Next

fillHulls()

UnlockBuffer BackBuffer()

Text 10,10,count

Delete Each Point
Delete Each Direction
Delete Each Path
End Function

;// MetaBall

;/*
; * Flood Fill
; */

Type TPixel
Field x
Field y
End Type

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

p\x=x
p\y=y

Return p
End Function

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

Function sBLine(x0, y0, x1, y1)
;Local col=ColorRed()*$10000+ColorGreen()*$100+ColorBlue()

Local steep
Local tmp, dX, dY, err, yStep, y

If Abs(y1-y0)>Abs(x1-x0)
steep=True

tmp=x0
x0=y0
y0=tmp

tmp=x1
x1=y1
y1=tmp
Else
steep=False
EndIf

If x0>x1
tmp=x0
x0=x1
x1=tmp

tmp=y0
y0=y1
y1=tmp
EndIf

dX=x1-x0
dY=Abs(y1-y0)
err=dX/2
y=y0

If y0<y1
yStep=1
Else
yStep=-1
EndIf

If steep
For x=x0 To x1
;WritePixelFast y,x,col

screenMap(y, x)=True
;If y<peakValues(0, x)
; peakValues(0, x)=y
;EndIf
;If y>peakValues(1, x)
; peakValues(1, x)=y
;EndIf

err=err-dY

If err<0
y=y+yStep

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

screenMap(x, y)=True
;If x<peakValues(0, y)
; peakValues(0, y)=x
;EndIf
;If x>peakValues(1, y)
; peakValues(1, y)=x
;EndIf

err=err-dY

If err<0
y=y+yStep

err=err+dX
EndIf
Next
EndIf
End Function

Function fillHull(hull.Path)
Local factorX#=GraphicsWidth()/gridWidth
Local factorY#=GraphicsHeight()/gridHeight

Local col=0*$10000+55*$100+255
Local startX, startY, newX, newY
Local p.TPixel, n.TPixel

startX=hull\parent\x
startY=hull\parent\y

p=newTPixel(startX, startY)
WritePixelFast startX, startY, col
screenMap(startX, startY)=True

For p=Each TPixel
For dir=0 To 3
newX=p\x+(dir=0)-(dir=2)
newY=p\y+(dir=1)-(dir=3)

If newX>=0 And newY>=0 And newX<GraphicsWidth() And newY<GraphicsHeight()
If screenMap(newX, newY)=0
If Not screenMap(newX, newY)
n=newTPixel(newX, newY)

WritePixelFast newX, newY, col
screenMap(newX, newY)=True
EndIf
;Else
; WritePixelFast newX, newY, col
EndIf
EndIf
Next

Delete p
Next
End Function

Function fillHulls()
Local factorX#=GraphicsWidth()/gridWidth
Local factorY#=GraphicsHeight()/gridHeight

Local col=0*$10000+55*$100+255
Local hull.Path
Local startX, startY, newX, newY
Local p.TPixel, n.TPixel

For hull=Each Path
;Hmm, Start ist etwas riskant
; nach Möglichkeit ist der Punkt ausserhalb des Pfads
; (oder auf der Linie)

startX=hull\parent\x;hull\originX*factorX+1
startY=hull\parent\y;hull\originY*factorY+1

p=newTPixel(startX, startY)
WritePixelFast startX, startY, col
screenMap(startX, startY)=True

For p=Each TPixel
For dir=0 To 3
newX=p\x+(dir=0)-(dir=2)
newY=p\y+(dir=1)-(dir=3)

If newX>=0 And newY>=0 And newX<GraphicsWidth() And newY<GraphicsHeight()
If screenMap(newX, newY)=0
If Not screenMap(newX, newY)
n=newTPixel(newX, newY)

WritePixelFast newX, newY, col
screenMap(newX, newY)=True
EndIf
;Else
; WritePixelFast newX, newY, col
EndIf
EndIf
Next

Delete p
Next
Next
End Function

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

;// FloodFill

;/*
; * Marching Squares Algorithm
; */

Global gridWidth=80
Global gridHeight=60

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

Type Point
Field x#
Field y#

Field prev.Point
Field succ.Point
End Type

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

p\x=x
p\y=y

Return p
End Function

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

Type Direction
Field dirX
Field dirY

Field succ.Direction
End Type

Function newDirection.Direction(dir[2])
d.direction=New Direction

d\dirX=dir[0]
d\dirY=dir[1]

Return d
End Function

Type Path
Field originX
Field originY

Field pList.Point
Field count

Field parent.MetaBall
End Type

Function newPath.Path(startX, startY, directions.Direction)
Local p.Path=New Path

p\originX=startX
p\originY=startY

p\pList=New Point
p\pList\x=startX
p\pList\y=startY

fieldRendered(startX,startY)=True

Local pList.Point=p\pList

Repeat
pList\succ=New Point
pList\succ\prev=pList

pList\succ\x=pList\x+directions\dirX
pList\succ\y=pList\y+directions\dirY

pList=pList\succ
directions=directions\succ

fieldRendered(pList\x,pList\y)=True

p\count=p\count+1
Until directions=Null

Return p
End Function

;// can be used to find the path around one speciffic connected field
Function identifyPerimeterStart.Path()
Dim fieldData(gridWidth, gridHeight)
Dim fieldDone(gridWidth, gridHeight)
Dim fieldRendered(gridWidth,gridHeight)

For x=0 To gridWidth-1
For y=0 To gridHeight-1
fieldData(x,y)=getDataPoint(GraphicsWidth()/gridWidth*x,GraphicsHeight()/gridHeight*y)
Next
Next

For x=0 To gridWidth-1
For y=0 To gridHeight-1
If fieldData(x,y)<>0
Return identifyPerimeter(x,y)
EndIf
Next
Next

Return Null
End Function

Function identifyPerimeter.Path(initialX, initialY)
Local initialValue=getDirection(initialX,initialY, Null)
If initialValue=-1
DebugLog "Wrong start Point"
stopped=True
Return Null
EndIf

Local dir.Direction

Local X=initialX
Local Y=initialY

Local maxIter=1000
Local iter=0

Local p.Path=New Path

p\originX=initialX
p\originY=initialY

p\pList=newPoint(initialX, initialY)
fieldRendered(initialX, initialY)=True

Local pList.Point=p\pList

Repeat
iter=iter+1
If iter>maxIter
;Wenn es hierzu kommt, ist irgendwo ein Fehler passiert
; ich weiss nicht wie es dazu kommt :/
; das Ergebnis sind Linien durch das Objekt

stopped=True
DebugLog "overflow"
Exit
EndIf

Select getDirection(X, Y, dir)
Case 1
dir=newDirection(North)
Case 2
dir=newDirection(East)
Case 3
dir=newDirection(South)
Case 4
dir=newDirection(West)
Default
stopped=True
DebugLog "wrong direction"
Return Null
End Select

X=X+dir\dirX
Y=Y+dir\dirY

pList\succ=New Point
pList\succ\prev=pList

pList\succ\x=pList\x+dir\dirX
pList\succ\y=pList\y+dir\dirY

pList=pList\succ

fieldRendered(pList\x, pList\y)=True

p\count=p\count+1
Until X=initialX And Y=initialY

Return p
End Function

Function getDirection(x, y, lastDir.Direction)
Local d1, d2, d3, d4

d1=getDataField(x-1,y-1)
d2=getDataField(x,y-1)
d3=getDataField(x-1,y)
d4=getDataField(x,y)

Local sum=d1+d2+d3+d4

Local N=1 ; NORTH
Local E=2 ; EAST
Local S=3 ; SOUTH
Local W=4 ; WEST

Select sum
Case 0
Return E
Case 1
If d2
Return E
ElseIf d4
Return S
ElseIf d1
Return N
ElseIf d3
Return W
EndIf
Case 2
If d2 And d4
Return S
ElseIf d1 And d2
Return E
ElseIf d1 And d3
Return N
ElseIf d3 And d4
Return W
ElseIf d1 And d4
If lastDir=Null
Return N
Else
If lastDir\dirX=1
Return N
Else
Return S
EndIf
EndIf

;Return N ;Original Line
ElseIf d2 And d3
If lastDir=Null
Return W
Else
If lastDir\dirY=1
Return W
Else
Return E
EndIf
EndIf

;Return W ;Original Line
EndIf
Case 3
If Not d2
Return N
ElseIf Not d1
Return W
ElseIf Not d3
Return S
ElseIf Not d4
Return E
EndIf
Default
Return -1
End Select
End Function

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

Return fieldData(x,y)
EndIf
End Function

;// this function should be overwritten if used elsewhere
Function getDataPoint(x,y)
Local strength#=0

For m.metaBall=Each MetaBall
strength=strength+1./((x-m\x)^2+(y-m\y)^2)
Next

If strength>threshold
Return True
Else
Return False
EndIf
End Function

Function normalDrawPath(hull.Path)
Local factorX#=GraphicsWidth()/gridWidth
Local factorY#=GraphicsHeight()/gridHeight

Local pIter.Point
Local pMiddle.Point
Local pLeft.Point
Local pRight.Point

pIter=hull\pList

Local x1#,y1#
Local x2#,y2#

pMiddle=pIter
pLeft=prevPoint(hull,pMiddle)
pRight=succPoint(hull,pMiddle)

x1=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
y1=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25

Repeat ;the points are counter clockwise
pMiddle=succPoint(hull,pIter)
pLeft=pIter
pRight=succPoint(hull,pMiddle)

x2=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
y2=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25

Line x1*factorX,y1*factorY,x2*factorX,y2*factorY

pIter=pIter\succ

x1=x2
y1=y2
Until pIter=Null
End Function

Function drawPath(hull.Path)
Local factorX#=GraphicsWidth()/gridWidth
Local factorY#=GraphicsHeight()/gridHeight

Local pIter.Point
Local pMiddle.Point
Local pLeft.Point
Local pRight.Point

pIter=hull\pList

Local x1#,y1#
Local x2#,y2#

pMiddle=pIter
pLeft=prevPoint(hull,pMiddle)
pRight=succPoint(hull,pMiddle)

x1=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
y1=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25

Repeat ;the points are counter clockwise
pMiddle=succPoint(hull,pIter)
pLeft=pIter
pRight=succPoint(hull,pMiddle)

x2=pMiddle\x*0.5+pLeft\x*0.25+pRight\x*0.25
y2=pMiddle\y*0.5+pLeft\y*0.25+pRight\y*0.25

sBLine x1*factorX,y1*factorY,x2*factorX,y2*factorY

pIter=pIter\succ

x1=x2
y1=y2
Until pIter=Null
End Function

Function prevPoint.Point(hull.Path,p.Point)
Local prev.Point
Local pIter.Point

prev=p\prev

If prev=Null
pIter=hull\pList

Repeat
pIter=pIter\succ
Until pIter\succ=Null

prev=pIter
EndIf

Return prev
End Function

Function succPoint.Point(hull.Path,p.Point)
Local succ.Point
Local pIter.Point

succ=p\succ

If succ=Null
succ=hull\pList
EndIf

Return succ
End Function

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

;// Marching Squares Algorithm

;/*
; * Test Program
; */

;SeedRnd(MilliSecs())

For k=1 To 50
m.metaBall=New MetaBall

m\x=Rnd(200,500)
m\y=Rnd(200,400)

m\vx=Rnd(-1.5,1.5)
m\vy=Rnd(-1.5,1.5)
Next

Global stopped=False

timer=CreateTimer(60)
While Not KeyHit(1)
If MouseHit(2)
stopped=Not stopped
EndIf

If stopped
Color 125,125,125
Text 50,10,"Stopped"

For xn=0 To gridWidth
For yn=0 To gridHeight
fieldData(xn,yn)=getDataField(xn,yn)
If fieldData(xn,yn)
Rect xn*10,yn*10,10,10
EndIf
Next
Next
EndIf

Color 255,255,255
drawMetaBalls()

For m.metaBall=Each MetaBall
If Not stopped
m\x=m\x+m\vx
m\y=m\y+m\vy
EndIf

If m\y<100 Or m\y>500
m\vy=-m\vy
EndIf
If m\x<100 Or m\x>700
m\vx=-m\vx
EndIf

WritePixel m\x, m\y, 255*$10000+255*$100+255
Next

fps=fps+1
If MilliSecs()-fpsTime>999
fpsCur=fps
fpsTime=MilliSecs()
fps=0
EndIf
Text 780,580,fpsCur

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

Ende

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

Bis zum nächsten Mal,
MfG,
Darth