 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
 Verfasst am: 19.06.2012, 20:44 Titel: Baumstruktur und eine solche auslesen/parsen und speichern |
 |
|
Ich versuche mich gerade an einem DirectX Model
Bisher habe ich alle wesentlichen Daten mit 'Instr' und ytwinky's 'splitstr'
Funktion auslesen können, probleme machen mir die Transformationsmatrizen die in einen
Hierarchischen Baum gespeichert sind...
Diese kann ich denke nicht einfach per instr verarbeiten da ich ja den Baum folgen
muss...
Aufgebaut ist das ganze so
| Code: |
Frame Bip01 {
FrameTransformMatrix {
1.000000,0.000000,0.000000,0.000000,0.000000,1.000000,0.000000,0.000000,0.000000,0.000000,1.000000,0.000000,0.000000,1.071153,-0.000000,1.000000;;
}
|
Das ist der anfang und der Baum wird hier noch nicht geschlossen, hier geht es tiefer so weiter
bis irgendwann ein '}' diesen bzw weiter unten liegene 'Frames' schliessen
Hat evtl jemand einen Vorschlag wie ich es am besten angehe diese Inhalte zu parsen und wie ich meine struktur(udt) am besten aufbaue?!
Edit: ups, falsches unterforum, blöd wenn man alles gleichzeitig nebenher macht, da macht man dann nichts mehr richtig 
_________________
 |
|
| Nach oben |
|
 |
28398
Anmeldungsdatum: 25.04.2008
Beiträge: 1917
|
| Verfasst am: 20.06.2012, 04:08 Titel: |
|
|
| Vorschlag: Stackbasiert. Du gehst einmal rüber und baust den Stack auf und baust dann den Stack ab, wobei du die Baumstruktur baust. Das dürfte sehr schnell zu implementieren sein. |
|
| Nach oben |
|
|
MisterD
Anmeldungsdatum: 10.09.2004
Beiträge: 3071
Wohnort: bei Darmstadt
|
| Verfasst am: 21.06.2012, 01:08 Titel: |
|
|
gib mal n input-beispiel mit mehr als einem datum an. Aus dem abgeschnittenen schnipsel zahlen da oben kann niemand erahnen, wie die daten aussehen.
_________________
"It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 21.06.2012, 02:34 Titel: |
|
|
Hab hier mal eine komplette x file Knight.zip, hab davon mehrere aus einem spiel gerippte in diesem Format, leider sind die so oder so nur unvollständig, es fehlen die animationssets und die texturen musste ich auch von hand 'nachreichen'
Wie gesagt habe ich bisher (eher schlecht als recht) das ganze ding schonmal darstellen können, habe auch schon die Weights, nur bekomme ich das mit der Bone/Tranformationsmatrix Hierarchie nicht so richtig hin...
Hab auch schon nach allen möglichen Alternativen gesucht zum konvertieren oder dergleichen, leider haben ausser Blender und Milkshape3D (nur Mesh, ohne Bones) kein programm es geschafft mir das file auch nur darzustellen... selbst DX Studio das mit .x Modellen wohl klar kommen sollte packt es nicht...
Hab hier ein (sau)code der mir bisher das Mesh lädt...
| Code: |
#Include once "gl/gl.bi"
#include once "gl/glext.bi"
#Include once "gl/glu.bi"
#include once "FreeImage.bi"
Function OGL_LoadTexture (byval filename as String, byval flags as integer=&h04) as Integer
glEnable(GL_TEXTURE_2D)
Dim file_ext as String*3
Dim file_atr as Integer = 0
Dim file_frm as Integer = -1 'FIF_UNKNOWN
If len(filename)>3 Then
file_ext=lcase(right(filename,3))
Select case file_ext
Case "bmp"
file_frm = FIF_BMP
file_atr = BMP_DEFAULT
Case "ico"
file_frm = FIF_ICO
file_atr = ICO_DEFAULT
Case "jpg"
file_frm = FIF_JPEG
file_atr = JPEG_DEFAULT
Case "pcx"
file_frm = FIF_PCX
file_atr = PCX_DEFAULT
Case "png"
file_frm = FIF_PNG
file_atr = PNG_DEFAULT
Case "tga"
file_frm = FIF_TARGA
file_atr = TARGA_DEFAULT
Case "tif","iff"
file_frm = FIF_TIFF
file_atr = TIFF_DEFAULT
Case "gif"
file_frm = FIF_GIF
file_atr = GIF_DEFAULT
End Select
Else
If len(filename)=0 Then return 0
End If
'-----------------------------------------------------------------------'
Dim Dib As FIBITMAP Ptr
Dim Dib32 as FIBITMAP Ptr
Dim SprWidth As Integer
Dim SprHeight As Integer
Dim Bits As Any Ptr
'' Bild laden:
Dib = FreeImage_Load(file_frm, filename, file_atr)
'' Wenn ein Fehler aufgetreten ist, hat der Device Context den Wert 0
If Dib = 0 Then
Return 0
End If
'-----------------------------------------------------------------------'
'' Ab hier wird mit 32 Bit Farbtiefe gearbeitet
Dib32 = FreeImage_ConvertTo32Bits(Dib)
SprWidth = FreeImage_GetWidth(Dib32)
SprHeight = FreeImage_GetHeight(Dib32)
Bits = FreeImage_GetBits(Dib32)
'-----------------------------------------------------------------------'
Dim Handle as UInteger
Dim minfilter as UInteger
Dim magfilter as UInteger
'-----------------------------------------------------------------------'
glGenTextures (1, @Handle) '' Create The Texture ( CHANGE )
glBindTexture (GL_TEXTURE_2D, Handle)
glTexImage2D (GL_TEXTURE_2D, 0, 4, SprWidth, SprHeight, _
0, &h80E1, &h1401, Bits)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
'-----------------------------------------------------------------------'
'' Speicher wieder freigeben
FreeImage_Unload(Dib)
FreeImage_Unload(Dib32)
glBindTexture (GL_TEXTURE_2D, 0)
Return Handle
End Function
Declare Function FB_OpenGLScreen (byval GL_width as Integer, byval GL_height as Integer, byval GL_Title as String="") as Integer
Function FB_OpenGLScreen (byval GL_width as Integer, byval GL_height as Integer, byval GL_Title as String="") as Integer
'-------------------------
' das Fenster öffnen
'-------------------------
Windowtitle GL_Title
Screenres GL_width, GL_height, 32, , &h02
'-------------------------
' Open-GL Init
'-------------------------
glMatrixMode GL_PROJECTION ' Den Matrix-Modus Projection wählen
glViewport 0, 0, GL_width, GL_height ' den Current Viewport auf eine Ausgangsposition setzen
glLoadIdentity ' Diesen Modus auf Anfangswerte setzen
gluPerspective 45.0f, GL_width/GL_height, 0.1f, 200.0f ' Grundeinstellungen des Anezeigefensters festlegen
glMatrixMode GL_MODELVIEW ' Auf den Matrix-Modus Modelview schalten
glLoadIdentity ' und auch diesen auf Anfangswerte setzen
glClearColor 0.0f, 0.0f, 0.0f, 0.0f ' Setze Farbe für löschen auf schwarz
glClearDepth 1.0f ' Depth-Buffer Löschen erlauben
glEnable GL_DEPTH_TEST ' den Tiefentest GL_DEPTH_TEST einschalten
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT ' Tiefen- und Farbpufferbits löschen
glDepthFunc(GL_LEQUAL)
Return 1
End Function
'X File - versuch1
Function SplitStr(byVal StrEx As String, _
byVal Seperator As String, _
byVal NPos As UInteger) As String
Dim As UInteger SNow
Dim as UInteger Found
Dim as UInteger PFound
If NPos=0 Or Len(StrEx)=0 Or Len(Seperator)=0 Or Instr(StrEx, Seperator)=0 Then Return ""
Do
If SNow=NPos-1 Then PFound=Found+Len(Seperator)
Found=Instr(Found+1, StrEx, Seperator)
If Found Then SNow+=1
If SNow=NPos Then Return Mid(StrEx, PFound, Found-PFound)
Loop While Found
If SNow=NPos-1 Then Return Right(StrEx, (Len(StrEx)+1)-PFound)
Return ""
End Function
Type Vec2
u as single
v as single
End Type
Type Vec3
x as single
y as single
z as single
End Type
Type xBone
BoneName as String
nVertices as Integer
Vertices as Integer ptr 'Index
Weight as single ptr
BMatrix(16) as single
End Type
Type Face
nVertex as Integer
Vertex as Integer ptr
End Type
Type xMaterial
nMaterial as Integer
Material as Integer ptr
nFaces as Integer
Faces as Integer ptr
End Type
Type xMeshNormals
nNormals as Integer
Normals as Vec3 ptr
nFaces as Integer
Faces as Face ptr
End Type
Type xMesh
nVertices as Integer
Vertices as Vec3 ptr
nFaces as Integer
Faces as Face ptr
MeshNormals as xMeshNormals ptr
nTexCoords as Integer
TexCoords as Vec2 ptr
Material as xMaterial ptr
nBones as Integer
Bones as xBone ptr
End Type
Function LoadXMesh (fromfile as String) as xMesh ptr
Dim FF as Integer
FF = Freefile
Dim Temp as String
Dim TempMesh as xMesh ptr = NEW xMesh
Open fromfile for input as #FF
Do
Line Input #FF, Temp
'------------------------------------------------------------------------------------'
If Instr(Temp,"Mesh ") and Instr(Temp,"template")=0 Then
'get nVertices {
Line Input #FF,Temp
TempMesh -> nVertices = val(trim(splitstr(Temp,";",1)))
TempMesh -> Vertices = NEW vec3[TempMesh -> nVertices]
' }
'Get Vertices {
For v as integer=0 to (TempMesh -> nVertices)-1
Line Input #FF,Temp 'Get Vertex (v) {
TempMesh -> Vertices[v].x = val(trim(splitstr(Temp,";",1)))
TempMesh -> Vertices[v].y = val(trim(splitstr(Temp,";",2)))
TempMesh -> Vertices[v].z = val(trim(splitstr(Temp,";",3)))
' }
Next v
' }
Line Input #FF,Temp 'get nFaces {
TempMesh -> nFaces = val(trim(splitstr(Temp,";",1)))
TempMesh -> Faces = NEW Face[TempMesh -> nFaces]
' }
'Get Faces {
for f as integer=0 to (TempMesh -> nFaces)-1
Line Input #FF,Temp 'get Face {
TempMesh -> Faces[f].nVertex = val(trim(splitstr(Temp,";",1)))
TempMesh -> Faces[f].Vertex = NEW Integer[TempMesh -> Faces[f].nVertex]
for l as integer=0 to (TempMesh -> Faces[f].nVertex)-1
TempMesh -> Faces[f].Vertex[l]=val(trim(splitstr(Temp,";",2+l)))
next l
' }
Next f
' }
'nVertices
'x,y,z -> ;;
'nFaces
'v1,v2,v3,v4 -> ;;
'-'nNormals
'-'x,y,z -> ;;
End If
'------------------------------------------------------------------------------------'
If Instr(Temp,"MeshNormals ") and Instr(Temp,"template")=0 Then
TempMesh -> MeshNormals = NEW xMeshNormals
'get nNormals {
Line Input #FF,Temp
TempMesh -> MeshNormals -> nNormals = val(trim(splitstr(Temp,";",1)))
TempMesh -> MeshNormals -> Normals = NEW vec3[TempMesh -> MeshNormals -> nNormals]
' }
'Get Normals {
For n as integer=0 to (TempMesh -> MeshNormals -> nNormals)-1
Line Input #FF,Temp 'Get Normal (n) {
TempMesh -> MeshNormals -> Normals[n].x = val(trim(splitstr(Temp,";",1)))
TempMesh -> MeshNormals -> Normals[n].y = val(trim(splitstr(Temp,";",2)))
TempMesh -> MeshNormals -> Normals[n].z = val(trim(splitstr(Temp,";",3)))
' }
Next n
' }
Line Input #FF,Temp 'get nFaces {
TempMesh -> MeshNormals -> nFaces = val(trim(splitstr(Temp,";",1)))
TempMesh -> MeshNormals -> Faces = NEW Face[TempMesh -> MeshNormals -> nFaces]
' }
'Get NormalFaces {
for f as integer=0 to (TempMesh -> nFaces)-1
Line Input #FF,Temp 'get Face {
TempMesh -> MeshNormals -> Faces[f].nVertex = val(trim(splitstr(Temp,";",1)))
TempMesh -> MeshNormals -> Faces[f].Vertex = NEW Integer[TempMesh -> MeshNormals -> Faces[f].nVertex]
for l as integer=0 to (TempMesh -> Faces[f].nVertex)-1
TempMesh -> MeshNormals -> Faces[f].Vertex[l]=val(trim(splitstr(Temp,";",2+l)))
next l
' }
Next f
' }
end if
'------------------------------------------------------------------------------------'
If Instr(Temp,"MeshTextureCoords ") and Instr(Temp,"template")=0 Then
'get nTexCoords {
Line Input #FF,Temp
TempMesh -> nTexCoords = val(trim(splitstr(Temp,";",1)))
TempMesh -> TexCoords = NEW vec2[TempMesh -> nTexCoords]
' }
'Get TexCoords {
For t as integer=0 to (TempMesh -> nTexCoords)-1
Line Input #FF,Temp 'Get TexCoords (t) {
TempMesh -> TexCoords[t].u = val(trim(splitstr(Temp,";",1)))
TempMesh -> TexCoords[t].v = val(trim(splitstr(Temp,";",2)))
' }
Next t
' }
end if
'------------------------------------------------------------------------------------'
If Instr(Temp,"MeshMaterialList ") and Instr(Temp,"template")=0 Then
TempMesh -> Material = NEW xMaterial
Line Input #FF,Temp
TempMesh -> Material -> nMaterial = val(trim(splitstr(Temp,";",1)))
TempMesh -> Material -> Material = NEW Integer[TempMesh -> Material -> nMaterial]
Line Input #FF,Temp
TempMesh -> Material -> nFaces = val(trim(splitstr(Temp,";",1)))
TempMesh -> Material -> Faces = NEW Integer[TempMesh -> Material -> nFaces]
For f as integer=0 to (TempMesh -> Material -> nFaces)-1
Line Input #FF,Temp
TempMesh -> Material -> Faces[f] = val(trim(splitstr(Temp,",",1)))
Next f
End If
'------------------------------------------------------------------------------------'
If Instr(Temp,"SkinWeights ") and Instr(Temp,"template")=0 Then
'count nBones
TempMesh -> nBones += 1
End If
Loop while not eof(FF)
Close #FF
Dim BoneNum as Integer
If (TempMesh -> nBones) Then
TempMesh -> Bones = NEW xBone[TempMesh -> nBones]
Open fromfile for input as #FF
Do
Line Input #FF, Temp
If Instr(Temp,"SkinWeights ") and Instr(Temp,"template")=0 Then
'Get Bonename
Line Input #FF, Temp
TempMesh -> Bones[BoneNum].BoneName = splitstr(Temp,chr(34),2)
'Get Num Vertices
Line Input #FF, Temp
TempMesh -> Bones[BoneNum].nVertices = val(trim(splitstr(Temp,";",1)))
If (TempMesh -> Bones[BoneNum].nVertices) Then
TempMesh -> Bones[BoneNum].Vertices = NEW Integer[TempMesh -> Bones[BoneNum].nVertices]
TempMesh -> Bones[BoneNum].Weight = NEW Single[TempMesh -> Bones[BoneNum].nVertices]
For v as integer=0 to (TempMesh -> Bones[BoneNum].nVertices)-1
Line Input #FF, Temp
TempMesh -> Bones[BoneNum].Vertices[v] = val(trim(splitstr(Temp,";",1)))
Next v
For w as integer=0 to (TempMesh -> Bones[BoneNum].nVertices)-1
Line Input #FF, Temp
TempMesh -> Bones[BoneNum].Weight[w] = val(trim(splitstr(Temp,";",1)))
Next w
Else
Line Input #FF, Temp
Line Input #FF, Temp
End If
Line Input #FF, Temp
for l as integer=1 to 16
TempMesh -> Bones[BoneNum].BMatrix(l-1) = val(trim(splitstr(Temp,",",l)))
next l
BoneNum += 1
End If
Loop while not eof(FF)
End If
Return TempMesh
End Function
Sub DrawMesh(ThisMesh as xMesh ptr) 'test
for f as integer=0 to (ThisMesh -> nFaces)-1
glBindTexture (GL_TEXTURE_2D, ThisMesh -> Material -> Material[ThisMesh -> Material -> Faces[f]])
glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAX_ANISOTROPY_EXT, ThisMesh -> Material -> Material[ThisMesh -> Material -> Faces[f]])
glBegin(GL_TRIANGLES)
glNormal3fv cast(any ptr,@(ThisMesh -> MeshNormals -> Normals[ThisMesh -> MeshNormals -> Faces[f].Vertex[0]]))
glTexCoord2fv cast(any ptr,@(ThisMesh -> TexCoords[ThisMesh -> Faces[f].Vertex[0]]))
glVertex3fv cast(any ptr,@(ThisMesh -> Vertices[ThisMesh -> Faces[f].Vertex[0]]))
glNormal3fv cast(any ptr,@(ThisMesh -> MeshNormals -> Normals[ThisMesh -> MeshNormals -> Faces[f].Vertex[1]]))
glTexCoord2fv cast(any ptr,@(ThisMesh -> TexCoords[ThisMesh -> Faces[f].Vertex[1]]))
glVertex3fv cast(any ptr,@(ThisMesh -> Vertices[ThisMesh -> Faces[f].Vertex[1]]))
glNormal3fv cast(any ptr,@(ThisMesh -> MeshNormals -> Normals[ThisMesh -> MeshNormals -> Faces[f].Vertex[2]]))
glTexCoord2fv cast(any ptr,@(ThisMesh -> TexCoords[ThisMesh -> Faces[f].Vertex[2]]))
glVertex3fv cast(any ptr,@(ThisMesh -> Vertices[ThisMesh -> Faces[f].Vertex[2]]))
glEnd()
next f
End Sub
Dim test as xMesh ptr
test=LoadXMesh ("Knight.x")
Dim Ambient(4) as single = {1,1,1,1}
?test -> nBones
for l as integer=0 to (test -> nBones)-1
?test -> Bones[l].BoneName, test -> Bones[l].nVertices
next l
FB_OpenGLScreen (800,600,"x test")
glEnable(GL_LIGHTING)
glEnable(GL_LIGHT0)
glLightModelfv (GL_LIGHT_MODEL_AMBIENT, @Ambient(0))
glLightfv (GL_LIGHT0, GL_AMBIENT, @Ambient(0))
glEnable (GL_TEXTURE_2D)
test -> Material -> Material[0]=OGL_LoadTexture("ni_face_000.png")
test -> Material -> Material[1]=OGL_LoadTexture("ni_face_000.png")
test -> Material -> Material[2]=OGL_LoadTexture("ni_bu_000.png")
test -> Material -> Material[3]=OGL_LoadTexture("ni_bd_000.png")
test -> Material -> Material[4]=OGL_LoadTexture("ni_hn_000.png")
test -> Material -> Material[5]=OGL_LoadTexture("ni_ft_000.png")
'glEnable(GL_POLYGON_SMOOTH)
Dim rot as single
Dim rottimer as double = timer
do
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity()
glTranslatef 0,-1,-3
glRotatef rot,0,1,0
DrawMesh(test)
flip
If (timer-rottimer) > .02 then
rot += 1
If rot > 359 then rot -= 360
End If
loop until multikey(&h01)
sleep
|
_________________
|
|
| Nach oben |
|
|
MisterD
Anmeldungsdatum: 10.09.2004
Beiträge: 3071
Wohnort: bei Darmstadt
|
| Verfasst am: 21.06.2012, 10:57 Titel: |
|
|
also so wie das aussieht brauchst du irgendeinen struct
| Code: | Node {
int[4][4] matrix
List<Node> subnodes
} |
und einlesen müsstest du das dann relativ einfach können indem du dir einfach ne methode bastelst
| Code: | Node read(Input input) {
Node result = new Node();
result.matrix = readMatrix(input);
while(input.nextToken() == "Frame") {
result.subnodes.add(read(input));
}
} |
Auf FreeBASIC übersetzen wirst du's selber müssen, das kann ich nich mehr ;p ich weiß nicht wie gut das da geht mangels listen-datenstruktur, string manipulation funktionen und vernünftigen input streams, das ist möglicherweise tonnenweise fummelei. Aber damit hast du dich vermutlich abgefunden wenn du FB benutzen willst. Die Grundstruktur von so ner rekursiven einlese-funktion sollte aber genauso relativ simpel sein wie in jeder anderen sprache auch, bloß dass so dinger wie input.nextToken und list.add ungefähr passend implementiert halt ggf hunderte zeilen code brauchen..
_________________
"It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra |
|
| Nach oben |
|
|
28398
Anmeldungsdatum: 25.04.2008
Beiträge: 1917
|
| Verfasst am: 21.06.2012, 15:40 Titel: |
|
|
| Ich habe mich gerade etwas gewundert und dann nachgesehen. FB hat ja tatsächlich keine Listen, Maps und all den STL-Kram... wie schnell man sowas vergisst |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 25.06.2012, 02:01 Titel: |
|
|
Ich versuche mir gerade eine (möglichst universelle) Tree Klasse zu bauen bzw einen Tree Manager den ich dann in einem separaten UDT nutzen kann...
bin mir nur grad nicht so recht sicher ob das ganze so richtig 'praktikabel' ist (obwohl es so einigemassen funktioniert):
| Code: |
'' Coder: Michael (EternalPain) Ahlborn (06-24-2012)
'' File : C_Tree(work)01.bi
'' Using: FreeBASIC Compiler - Version 0.24.0 (05-16-2012) for win32
Namespace EternalPainFunctions
Namespace Class_TreeManager
'Globals
const as Integer None = 0
const as Integer False = 0
const as Integer True = 1
Type Bool as Integer
Type P_TreeManager as C_TreeManager ptr
'Class
Type C_TreeManager 'EXTENDS OBJECT
Public:
'Getters 'like property's
Declare Function GetRoot() as P_TreeManager
Declare Function GetNext() as P_TreeManager
Declare Function GetPrev() as P_TreeManager
Declare Function GetDown() as P_TreeManager
Declare Function GetUp () as P_TreeManager
Declare Function GetData() as any ptr
'Setters
Declare Function AddDown(byval ThisNodeData as any ptr) as Bool
Declare Function Add (byval ThisNodeData as any ptr) as Bool
'Specials
Declare Function SwapNodeData(byval ThisNodeL as P_TreeManager, byval ThisNodeR as P_TreeManager) as Bool
'Deleter
Declare Function Del () as P_TreeManager
Private:
NextNode as P_TreeManager
PrevNode as P_TreeManager
DownNode as P_TreeManager 'Child
UpNode as P_TreeManager 'Parent
Protected:
NodeData as any ptr
End Type
End Namespace ''Class_TreeManager
End Namespace ''EternalPainFunctions
'Randomize Timer
'' Coder: Michael (EternalPain) Ahlborn (06-24-2012)
'' File : C_Tree(work)01.bas
'' Using: FreeBASIC Compiler - Version 0.24.0 (05-16-2012) for win32
'#Include once "C_Tree(work)01.bi"
Namespace EternalPainFunctions
Namespace Class_TreeManager
'class C_TreeManager
'Checklist:
'Done : Function GetRoot() as P_TreeManager 'returned the First entry in Tree
'Done : Function GetNext() as P_TreeManager
'Done : Function GetPrev() as P_TreeManager
'Done : Function GetDown() as P_TreeManager
'Done : Function GetUp () as P_TreeManager
'Done : Function GetData() as any ptr
'Done?: Function AddDown(byval ThisNodeData as any ptr) as Bool
'Done?: Function Add (byval ThisNodeData as any ptr) as Bool
'Done?: Function SwapNodeData(byval ThisNodeL as P_TreeManager, byval ThisNodeR as P_TreeManager) as Bool
'Done?: Function Del () as P_TreeManager
'Checklist:
'Done: Function GetRoot() as P_TreeManager 'returned the First entry in Tree
Function C_TreeManager.GetRoot() as P_TreeManager
Dim TempNode as P_TreeManager = @THIS
Do
If (TempNode -> GetUp ()) Then
TempNode = TempNode -> GetUp ()
ElseIf (TempNode -> GetPrev()) Then
TempNode = TempNode -> GetPrev()
Else
Return TempNode
End If
Loop
End Function
'Done: Function GetNext() as P_TreeManager
Function C_TreeManager.GetNext() as P_TreeManager
Return NextNode
End Function
'Done: Function GetPrev() as P_TreeManager
Function C_TreeManager.GetPrev() as P_TreeManager
Return PrevNode
End Function
'Done: Function GetDown() as P_TreeManager
Function C_TreeManager.GetDown() as P_TreeManager
Return DownNode
End Function
'Done: Function GetUp () as P_TreeManager
Function C_TreeManager.GetUp () as P_TreeManager
Return UpNode
End Function
'Done: Function GetData() as any ptr
Function C_TreeManager.GetData() as any ptr
Return NodeData
End Function
'Setters
Function C_TreeManager.Add (byval ThisNodeData as any ptr) as Bool
Function = False
Dim NewNode as P_TreeManager
If (NodeData = None) Then 'If no entrys exists
NodeData = ThisNodeData
Return True
Else
NewNode = NEW C_TreeManager
NewNode -> NodeData = ThisNodeData
NewNode -> NextNode = NextNode
NewNode -> UpNode = UpNode
NewNode -> PrevNode = @THIS
If NextNode Then NextNode -> PrevNode = NewNode
NextNode = NewNode
Return True
End If
End Function
Function C_TreeManager.AddDown(byval ThisNodeData as any ptr) as Bool
Function = False
Dim NewNode as P_TreeManager
If (NodeData = None) Then 'If no entrys exists
'You can't Add 'Child's' without Parent
Return False
Else
NewNode = NEW C_TreeManager
NewNode -> PrevNode = 0
NewNode -> NextNode = DownNode
NewNode -> NodeData = ThisNodeData
NewNode -> UpNode = @THIS
If (DownNode) Then
DownNode -> PrevNode = NewNode
End If
DownNode = NewNode
Return True
End If
End Function
Function C_TreeManager.SwapNodeData(byval ThisNodeL as P_TreeManager, byval ThisNodeR as P_TreeManager) as Bool
Function = False
Dim TempData as any ptr
If (ThisNodeL<>None) and (ThisNodeR<>None) Then
TempData = ThisNodeL -> NodeData
ThisNodeL -> NodeData = ThisNodeR -> NodeData
ThisNodeR -> NodeData = TempData
Return True
End If
End Function
Function C_TreeManager.Del () as P_TreeManager
Dim TempNode as P_TreeManager
Dim DelNode as P_TreeManager
Dim retValue as P_TreeManager
If (PrevNode <> None) Then
retValue = PrevNode
ElseIf (NextNode <> None) Then
retValue = NextNode
ElseIf (UpNode <> None) Then
retValue = UpNode
Else
retValue = None
End If
If (PrevNode <> None) Then PrevNode -> NextNode = NextNode
If (NextNode <> None) Then NextNode -> PrevNode = PrevNode
TempNode = DownNode
If (TempNode <> None) Then
DownNode = None
Do
DelNode = TempNode
TempNode = TempNode -> NextNode
DelNode -> Del()
loop while (TempNode <> None)
End If
If (NodeData <> None) Then
#PRINT WARNING (Class TreeManager): NodeData is NOT empty!
NodeData = 0
End If
If (retValue = None) Then
#PRINT WARNING (Class TreeManager): Can not delete root Node!
?NextNode,PrevNode,DownNode
Function = @THIS
Else
Function = retValue
Delete @THIS
End If
End Function
End Namespace ''Class_TreeManager
End Namespace ''EternalPainFunctions
Dim test as EternalPainFunctions.Class_TreeManager.P_TreeManager
test = NEW EternalPainFunctions.Class_TreeManager.C_TreeManager
Dim root as EternalPainFunctions.Class_TreeManager.P_TreeManager
'root = NEW EternalPainFunctions.Class_TreeManager.C_TreeManager
Dim testdata_array(0 to 100) as integer
for l as integer=0 to 100
testdata_array(l) = l+1000
if int(rnd*10)=5 and l>0 then
If (test -> AddDown(@testdata_array(l))) then test = test -> GetDown()
else
If (test -> Add(@testdata_array(l))) then
if test -> GetNext() then test = test -> GetNext()
end if
end if
If int(rnd*10)=3 and (test -> GetUp())<>0 then test=test -> GetUp()
next l
'test -> SwapNode(test,test -> GetRoot())
test = test -> GetRoot()
root = test
dim p as string
Dim d as integer
dim b as string
?"First run"
do
if (test -> GetDown()) then p="+" Else P=" "
b=""
for l as integer=0 to d
b+=" |"
next l
?b;p;d;*cast(integer ptr,test -> GetData())
If (test -> GetDown()) Then
test=test -> GetDown():d+=1
Else
If test -> GetNext() = 0 and test -> GetUp() <> 0 Then test = test -> GetUp() : d=d-1
test = test -> GetNext()
End If
if test = 0 then exit Do
loop until multikey(&h01)
''del test
test = root
do
if (test -> GetDown()) then
test = test -> Del()
exit do
else
test = test -> GetNext()
end if
if test = 0 then exit do
loop
test = root
d=0
?"second run"
if test<>0 then
do
if (test -> GetDown()) then p="+" Else P=" "
b=""
for l as integer=0 to d
b+=" |"
next l
if (test -> GetData() <> 0) then
?b;p;d;*cast(integer ptr,test -> GetData())
end if
If (test -> GetDown()) Then
test=test -> GetDown():d+=1
Else
If test -> GetNext() = 0 and test -> GetUp() <> 0 Then test = test -> GetUp() : d=d-1
test = test -> GetNext()
End If
if test = 0 then exit Do
loop until multikey(&h01)
end if
sleep
|
_________________
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
