In Projekte, Resourcen, Tools ... gibt es mehr Informationen.

http://www.folker-linstedt.de/pureforum/FL3D.zip
Da keiner so richtig wollte, dachte ich mir, mach ich's

Geschafft hat geschrieben: - 3D Engine, basierend auf Sprites und LinkedLists
- Sprites als Texturen verwendbar, 2D-Drawing-Befehle, JPEGs, etc.
- einfaches Erstellen von Würfelgruppen
- Würfel können manipuliert werden
- komplexe Gebilde möglich
- Bewegung und Rotation von Objekten/Würfel/Meshes
- gesamte Engine ~ 300 Zeilen groß
- komplette Spiele ab EXE ~ 45 kByte möglich
Hier der QuellCode:geht noch nicht, Hilfe wäre nicht schlecht hat geschrieben: - Darstellungsfehler beim Z-Buffer
- Verzerrung der Texturen, wegen ohne Z-Angaben bei Transformsprite3D
- globale Kamera Bewegung fehlt
- Rotation von Objekten erstmal nur für Y-Achse integriert
- keine Kollisionsabfrage
- Ansteuerung von Punkten und Meshes erfolgt über IDs, diese werden jedoch noch nicht absolut berücksichtig
FL3D ENGINE
Code: Alles auswählen
;/ Autor: (c) Folker Linstedt aka xaby
;/ simple 3D-Engine, basiert auf Sprite3D und LinkedLists (dynamisch, aber langsam, schneller feste Arrays/Dim)
;/ 2008-03-07, 200-03-08
;/ Programmiert an zwei Tagen
EnableExplicit
;############### FL3D Enigne ##################################
Structure FL3D_Point3D
x.f[3]; Punkt im Raum, x1=x, x2=y, x3=z
x2D.l
y2D.l
z2D.l ; für Sprite 3D ohne Verzerrung
PID.l ;/ Zur Sicherheit, falls Reihenfolge vertauscht wird
EndStructure
Structure FL3D_Mesh
MID.l ; MeshID
Name.s ; Name des Meshes
PID$ ; eine NewList oder ein dinamisches Array wären angebracht
MPID.l ; Mesh-Bezugspunkt für Rotation und GrößenÄnderung, Punkt
EndStructure
Structure FL3D_Texture
Sprite3DID.l ; Referenz auf das Sprite3D
Transparens.l ; Transparen
PIDs.l[4] ; PointID, immer 4 Punkte
TID.l ; TextureID
Z.f ; Maximaler-Z-Wert
EndStructure
Global NewList FL3DP.FL3D_Point3D()
Global NewList FL3DM.FL3D_Mesh()
Global NewList FL3DT.FL3D_Texture()
Global FL3D_PID$
Procedure.l FL3D_AddPoint(x.f,y.f,z.f)
Protected ID.l
; #PB_Any
ID=CountList(FL3DP())
AddElement(FL3DP())
FL3DP()\x[0]=x : FL3DP()\x[1]=y: FL3DP()\x[2]=z
FL3DP()\PID=ID
;/ FL3D_PID$
FL3D_PID$+Str(ID)+","
ProcedureReturn ID
EndProcedure
Procedure FL3D_AddPoints(x.f,y.f,z.f,xl.f,yl.f,zl.f)
;/ Zum Erstellen von Linien, Rechtecken, Quadern, ... alle parallel zu den Achsen
Protected xm.f=xl/2, ym.f=yl/2, zm.f=zl/2
;/ Überprüfung, ob Punkte doppelt sind, fehlt noch
FL3D_AddPoint(x-xm,y-ym,z-zm)
FL3D_AddPoint(x+xm,y-ym,z-zm)
FL3D_AddPoint(x+xm,y+ym,z-zm)
FL3D_AddPoint(x-xm,y+ym,z-zm)
FL3D_AddPoint(x-xm,y-ym,z+zm)
FL3D_AddPoint(x+xm,y-ym,z+zm)
FL3D_AddPoint(x+xm,y+ym,z+zm)
FL3D_AddPoint(x-xm,y+ym,z+zm)
EndProcedure
;/ Woher weiß ich die PunktIDs?
;/ PunktIDs werden in FL3D_PID$ geschrieben
Procedure FL3D_AddTexture(Sprite3DID,P1,P2,P3,P4)
Protected ID
ID=CountList(FL3DT())
AddElement(FL3DT())
FL3DT()\PIDs[0]=P1
FL3DT()\PIDs[1]=P2
FL3DT()\PIDs[2]=P3
FL3DT()\PIDs[3]=P4
FL3DT()\Sprite3DID=Sprite3DID
FL3DT()\TID=ID
EndProcedure
Procedure FL3D_Camera(ViewAngleX.f,ViewAngleY.f,ViewAngleZ.f,ViewDistanz.f)
EndProcedure
Procedure FL3D_3Dto2D(PID.l=0,ScaleFactor.f=1); PID wird nicht berücksichtigt
;/ Berechnet aus x() die 2D-Koordinaten + Z
;/ Rotation der Kamera fehlt
With FL3DP()
\x2D=(\x[0]/(1+((\x[2]*ScaleFactor)/500)))+400; ;/ MittelPunkt je nach Auflösung
\y2D=(\x[1]/(1+((\x[2]*ScaleFactor)/500)))+300; ;/ Muss noch auf Ausgabegröße skaliert werden
\z2D=\x[2]
EndWith
EndProcedure
Procedure FL3D_UpDatePoints()
ForEach FL3DP()
FL3D_3Dto2D()
Next
EndProcedure
Procedure.f FL3D_Angle(x.f,z.f) ;/ Siehe Tafelwerk Volk und Wissen S. 26 ff, oder MandalaProjekt, Stargate
Protected Angle.f
If x = 0
If z < 0 : Angle = -90 : EndIf
If z >= 0 : Angle = 90 : EndIf
Else
Angle = ATan(z/x)/#PI*180
If x < 0 : Angle + 180 : EndIf
EndIf
ProcedureReturn Angle
EndProcedure
Procedure.f FL3D_Distance(Nx.f, Nz.f, x.f, z.f) ;/ Siehe Tafelwerk Volk und Wissen S. 26 ff
Protected Hypothenuse.f
Hypothenuse = Sqr(Pow(x-Nx,2)+Pow(z-Nz,2))
ProcedureReturn Hypothenuse
EndProcedure
Procedure FL3D_MoveMeshByID(ID,plusx.f,plusy.f,plusz.f,Task=1,Rx.f=0,Ry.f=0,Rz.f=0)
;/ SelectElement und StringOperationen sind langsam ...
Protected points, i,x=0,y=0,z=0, RxP.f, RyP.f, RzP.f, StartAngleY.f, RadiusY.f, DAngleY.f
SelectElement(FL3DM(),ID)
If Task<10
If Task=2 ;/ Mesh-MittelPunkt
SelectElement(FL3DP(),FL3DM()\MPID)
RxP=FL3DP()\x[0]
RyP=FL3DP()\x[1]
RzP=FL3DP()\x[2]
ElseIf Task=3 ;/ RotationsPunkt
RxP=Rx
RyP=Ry
RzP=Rz
EndIf
points=CountString(FL3DM()\PID$,",")
If points
For i=1 To points
SelectElement(FL3DP(),Val(StringField(FL3DM()\PID$,i,",")))
If Task=1 ;/ Move
FL3DP()\x[0]+plusx
FL3DP()\x[1]+plusy
FL3DP()\x[2]+plusz
ElseIf Task=2 Or Task=3;/ Rotate, Rotation aller Punkte um Mesh-MittelPunkt ;/ Rotation um Rotationspunkt
;/ plusY gibt Winkel an, um wieviel gedreht werden soll
;/ Drehung um Y-Achse, Y bleibt unberührt
StartAngleY = FL3D_Angle(FL3DP()\x[0]-RxP,FL3DP()\x[2]-RzP)
RadiusY=FL3D_Distance(RxP,RzP,FL3DP()\x[0],FL3DP()\x[2])
DAngleY=StartAngleY+PlusY
FL3DP()\x[0]=RadiusY * Cos(DAngleY*(2*3.1415/360)) + RxP
FL3DP()\x[2]=RadiusY * Sin(DAngleY*(2*3.1415/360)) + RzP
;/ für rollende Würfel ...
;/ Drehung um X-Achse, X bleibt unberührt
;/ Drehung um Z-Achse, Z bleibt unberührt
ElseIf Task=4 ;/ Mesh-MittelPunkt bestimmen. Alle x-Werte Addieren / Anzahl. Für Y und Z ebenfalls
If FL3DP()\PID<>FL3DM()\MPID
x+FL3DP()\x[0]
y+FL3DP()\x[1]
z+FL3DP()\x[2]
EndIf
;/ Ein Task könnte die Vergrößerung, Verkleinerung des Meshes sein
;/ Dimensions, Ausdehnung, Größen-Änderung, Mesh-Mittelpunkt wird benötigt ...
EndIf
Next
EndIf
If Task=4 ;/ Ermitteln des Mesh-MittelPunktes und Erstellen des ZusatzPunktes mit der MPID
Task=10
plusX=x/(points-1)
PlusY=y/(points-1)
PlusZ=z/(points-1)
EndIf
EndIf
If Task=10 ;/ Mesh-MittelPunkt festlegen
SelectElement(FL3DP(),FL3DM()\MPID)
FL3DP()\x[0]=plusx
FL3DP()\x[1]=plusy
FL3DP()\x[2]=plusz
EndIf
EndProcedure
Procedure.l FL3D_MoveMesh(Name$,plusx,plusy,plusz,Task=1,Rx.f=0,Ry.f=0,Rz.f=0)
Protected ID, Result=0
ID=-1
ForEach FL3DM()
If FL3DM()\Name=Name$
ID=FL3DM()\MID
Break
EndIf
Next
If ID<>-1
FL3D_MoveMeshByID(ID,plusx,plusy,plusz,Task,Rx,Ry,Rz)
Result=1
Else
Result=0
EndIf
ProcedureReturn Result
EndProcedure
Procedure FL3D_StartMesh(Name$)
Protected ID
; #PB_Any
ID=CountList(FL3DM())
FL3D_PID$=""
AddElement(FL3DM())
FL3DM()\Name=Name$
FL3DM()\MID=ID
EndProcedure
Procedure FL3D_StopMesh()
FL3D_AddPoint(0,0,0) ; Wird für MPID (Mesh-MittelPunkt-PunktID) benötigt
FL3DM()\PID$=FL3D_PID$
FL3DM()\MPID=Val(StringField(FL3DM()\PID$,CountString(FL3DM()\PID$,","),","))
FL3D_MoveMeshByID(FL3DM()\MID,0,0,0,4) ;/ Mesh-MittelPunkt berechnen, Mit Task=10, kann er selbst festgelegt werden
EndProcedure
Procedure FL3D_DrawLines(TID)
Protected Dim x.f(3),Dim y.f(3),i
;/ ACHTUNG Select funktioniert nur, wenn auch TID existiert
SelectElement(FL3DT(),TID)
For i=0 To 3
SelectElement(FL3DP(),FL3DT()\PIDs[i])
x(i)=FL3DP()\x2D
y(i)=FL3DP()\y2D
Next
For i=0 To 2
LineXY(x(i),y(i),x(1+i),y(1+i),RGB(255,0,0))
Circle(x(i),y(i),3,RGB(255,0,0))
Next
LineXY(x(0),y(0),x(3),y(3),RGB(255,0,0))
EndProcedure
Procedure FL3D_ZBuffering() ;/ Berücksichtigt keine KameraDrehung, aber die ist ja auch erstmal noch fest
Protected Dim z(3), i
ForEach FL3DT()
For i=0 To 3
SelectElement(FL3DP(),FL3DT()\PIDs[i])
z(i)=FL3DP()\x[2]
Next
SortArray(Z(),1)
FL3DT()\Z=Z(0)
Next
SortStructuredList(FL3DT(),1,OffsetOf(FL3D_Texture\Z),#PB_Sort_Float)
EndProcedure
Procedure FL3D_DrawTextures()
Protected Dim x(3), Dim y(3), Dim z(3), i
;/ Z-Buffer muss vorher berechnet werden, dieser Abschnitt ist bestimmt wieder sehr langsam, da SelectElement() genutzt wird
FL3D_ZBuffering() ;/ sortiert die Darstellungstexturen nach Anzeige-Reihenfolge
ForEach FL3DT()
For i=0 To 3
SelectElement(FL3DP(),FL3DT()\PIDs[i])
x(i)=FL3DP()\x2D
y(i)=FL3DP()\y2D
z(i)=FL3DP()\z2D
Next
;/ Ohne Z-Koordinate mit Darstellungsfehlern, aber erfüllt erstmal seinen Zweck
TransformSprite3D(FL3DT()\Sprite3DID, 0,0,x(1)-x(0),y(1)-y(0),x(2)-x(0),y(2)-y(0),x(3)-x(0),y(3)-y(0))
DisplaySprite3D(FL3DT()\Sprite3DID,x(0),y(0))
;/ Transparens stimmt nur bedingt, da falschrum gedrehte Flächen nicht angezeigt werden
Next
EndProcedure
Procedure FL3D_DrawWiredTextures()
Protected MaxID, ID
MaxID=CountList(FL3DT())
For ID=0 To MaxID-1
FL3D_DrawLines(ID)
Next
ForEach FL3DP()
Circle(FL3DP()\x2D,FL3DP()\y2D,3,RGB(0,255,0))
Next
EndProcedure
Procedure FL3D_MovePoint(PID.l,plusX.f,plusY.f,plusZ.f)
SelectElement(FL3DP(),PID)
With FL3DP()
\x[0]+plusX
\x[1]+plusY
\x[2]+plusZ
EndWith
EndProcedure
;/ ################## ENDE 3D Engine ##########################
Code: Alles auswählen
;/ ################################ TEXTUREN ################################
Procedure ZeichneTextur(u)
Protected a,c,b,d,e,x,y,w,h,i
CreateSprite(u,128,128,#PB_Sprite_Texture)
h=SpriteHeight(u)
w=SpriteWidth(u)
StartDrawing(SpriteOutput(u))
Box(0,0,h,w,RGB(1,0,0))
RandomSeed(50)
For i=0 To 8
b=0
Box(16*i,0,15,h,RGB(150,80,10))
While b<14
;/ c = ... die HOLZ-KANTE, Abschluss ist zu regelmäßig
While a<h
Box(16*i+b,a,1,c,RGB((b/2+c+12)*4.8,(c+15)*2.3,20+c/2))
;/ HIER WIRD DIE MASERUNG BESTIMMT
c=(Random(6)+1)*1.2+4 ;4+6 ;/ ES IST WICHTIG, ob vor oder nach BOX
; DIESE ZEILE MACHT GLATTERES HOLZ
If u%2
Box(16*i+b,a,1,c,RGB((c+12)*4.8,(c+15)*2.3,20+c/2))
EndIf
a+c
Wend
a=-5
b+1
Wend
Next
StopDrawing()
EndProcedure
Procedure FL3D_6Textures(PID$,Sprite3DID$)
Protected i, l, Dim PID(7), Dim S3DID(5)
For i=0 To 7
PID(i)=Val(StringField(PID$,i+1,","))
Next
For i=0 To 5
S3DID(i)=Val(StringField(Sprite3DID$,i+1,","))
Next
FL3D_AddTexture(S3DID(0),PID(0),PID(1),PID(2),PID(3)) ;/ Vorn
FL3D_AddTexture(S3DID(1),PID(4),PID(5),PID(1),PID(0)) ;/ Oben
FL3D_AddTexture(S3DID(2),PID(1),PID(5),PID(6),PID(2)) ;/ Rechts
FL3D_AddTexture(S3DID(3),PID(4),PID(0),PID(3),PID(7)) ;/ Links
FL3D_AddTexture(S3DID(4),PID(3),PID(2),PID(6),PID(7)) ;/ Unten
FL3D_AddTexture(S3DID(5),PID(5),PID(4),PID(7),PID(6)) ;/ Hinten
EndProcedure
;#################################################
;/ HAUPTPROGRAMM
InitMouse()
InitKeyboard()
InitSprite()
InitSprite3D()
OpenScreen(800,600,32,"FL3D")
Define i, i2
For i=0 To 5
CreateSprite(i,64,64,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(i))
Box(0,0,64,64,RGB(Random(255),Random(255),Random(255)))
LineXY(0,0,64,64,RGB(255,255,255))
StopDrawing()
CreateSprite3D(i,i)
Next
ZeichneTextur(6) ;/ Holz
CreateSprite3D(6,6)
CreateSprite(7,256,256,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(7))
Box(0,0,256,256,RGB(1,1,1))
Box(3,3,250,250,RGB(200,200,200))
For i=0 To 10
LineXY(0,25*i,256,25*i,RGB(80,80,80))
Next
Box(120,120,50,136,RGB(1,1,1))
StopDrawing()
CreateSprite3D(7,7)
CreateSprite(8,256,256,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(8))
Box(0,0,256,256,RGB(1,1,1))
Box(3,3,250,250,RGB(185,50,40))
StopDrawing()
CreateSprite3D(8,8)
CreateSprite(9,512,512,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(9))
Box(0,0,512,512,RGB(40,200,40))
For i=0 To 100
Box(Random(500),Random(500),Random(20),Random(20),RGB(Random(30)+20,Random(80)+170,Random(40)+20))
Next
StopDrawing()
CreateSprite3D(9,9)
;/ Mesh erstellen, Auto
FL3D_StartMesh("Auto")
FL3D_AddPoints(80,0,0,100,50,50)
FL3D_StopMesh()
;/ Mesh erstellen, Säule / Balken wegen ohne Umlaut
FL3D_StartMesh("Balken")
FL3D_AddPoints(0,0,0, 20,300,20) ;/ Stamm
FL3D_AddPoints(0,150,0,200,10,200) ;/ Plattform
FL3D_StopMesh()
;/ Mesh erstellen, Haus aus Dach und Rumf
FL3D_StartMesh("Haus")
FL3D_AddPoints(-200,0,200, 150,180,250) ;/ weißes Haus
FL3D_AddPoints(-200,-130,200,200,80,300) ;/ rotes Dach
FL3D_AddPoints(-100,-200,200,20,40,20) ;/ Schornstein
FL3D_StopMesh()
;/ Grüner Boden
FL3D_StartMesh("Boden")
FL3D_AddPoints(0,75,0,800,2,800) ;/ Platte unten
FL3D_StopMesh()
;/ Seiten des Würfels festlegen
FL3D_6Textures("0,1,2,3,4,5,6,7","0,1,2,3,4,5") ;/ Texturfestlegung Bewegungsteil
FL3D_6Textures("9,10,11,12,13,14,15,16","6,6,6,6,6,6") ;/ Stamm
FL3D_6Textures("17,18,19,20,21,22,23,24","6,6,6,6,6,6") ;/ Platte
FL3D_6Textures("26,27,28,29,30,31,32,33","7,7,7,7,7,7") ;/ Haus
FL3D_6Textures("34,35,36,37,38,39,40,41","8,8,8,8,8,8") ;/ Dach
;/ Dach Modifikation
FL3D_MovePoint(34,70,0,70)
FL3D_MovePoint(35,-70,0,70)
FL3D_MovePoint(38, 70,0,-70)
FL3D_MovePoint(39,-70,0,-70)
FL3D_6Textures("42,43,44,45,46,47,48,49","8,8,8,8,8,8") ;/ Schornstein
FL3D_6Textures("51,52,53,54,55,56,57,58","9,9,9,9,9,9") ;/ Rasen, Boden
;/ ACHTUNG, Modifikationen sind einfacher, wenn man die Meshes noch nicht gedreht hat
FL3D_MoveMesh("Haus",0,45,0,2)
Define Wire=0, Texi=1, Quali=1
Sprite3DQuality(Quali) ;/ Smooth oder nicht Smooth
Repeat
ClearScreen(RGB(100,100,255)) ;/ HellBlau
FL3D_UpDatePoints() ;/ Berechnung der neuen Koordinaten im Raum
Start3D()
If Texi
FL3D_DrawTextures()
EndIf
Stop3D()
StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(10,10," WASD,UP,DOWN to move, Q, E rotate ... LEFT, RIGHT, rotate wood, .... 1 wired, 2 textured, 3 quality (c) Folker Linstedt")
If Wire Or Not Texi
FL3D_DrawWiredTextures() ; Zeichnet Außenkannten von Texturen und Punkte
EndIf
StopDrawing()
ExamineKeyboard()
;/ Qualität, Drahtgittermodel, Texturiert
If KeyboardReleased(#PB_Key_1)
Wire=1-Wire%2
EndIf
If KeyboardReleased(#PB_Key_2)
Texi=1-Texi%2
EndIf
If KeyboardReleased(#PB_Key_3)
Quali=1-Quali%2
Texi=1
Sprite3DQuality(Quali)
EndIf
;/ Bewegung der Meshes
If KeyboardPushed(#PB_Key_A)
FL3D_MoveMesh("Auto",-3,0,0)
EndIf
If KeyboardPushed(#PB_Key_D)
FL3D_MoveMesh("Auto",3,0,0)
EndIf
If KeyboardPushed(#PB_Key_S)
FL3D_MoveMesh("Auto",0,3,0)
EndIf
If KeyboardPushed(#PB_Key_W)
FL3D_MoveMesh("Auto",0,-3,0)
EndIf
If KeyboardPushed(#PB_Key_PageUp) Or KeyboardPushed(#PB_Key_Up)
FL3D_MoveMesh("Auto",0,0,3)
EndIf
If KeyboardPushed(#PB_Key_PageDown) Or KeyboardPushed(#PB_Key_Down)
FL3D_MoveMesh("Auto",0,0,-3)
EndIf
;/ Rotation
If KeyboardPushed(#PB_Key_Q) ;/ Drehung um Y-Achse, um eigenen MittelPunkt
FL3D_MoveMesh("Auto",0,-5,0,2) ; um 5 Grad drehen
EndIf
If KeyboardPushed(#PB_Key_E) ;/ Drehung um Y-Achse, um eigenen MittelPunkt
FL3D_MoveMesh("Auto",0,5,0,2) ; um 5 Grad drehen
EndIf
If KeyboardPushed(#PB_Key_Left) ;/ Drehung um Y-Achse, um NullPunkt/frei definierbarer Punkt
FL3D_MoveMesh("Auto",0,-5,0,3,0,0,0) ; um 5 Grad drehen
FL3D_MoveMesh("Balken",0,-5,0,2)
EndIf
If KeyboardPushed(#PB_Key_Right) ;/ Drehung um Y-Achse, um NullPunkt/frei definierbarer Punkt
FL3D_MoveMesh("Auto",0,5,0,3,0,0,0) ; um 5 Grad drehen
FL3D_MoveMesh("Balken",0,5,0,2)
EndIf
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
Oberer Teil könnte man später als Include machen.
TexturGenerator nur für Holz benutzt, und könnte noch ausgereifter sein.
Hintergrund-Musik und so etwas fehlt natürlich auch alles noch.
Aber schnelle Würfel gehen, aus denen man sogar mehr machen kann.

Verwandte Themen:
3D-Würfel ohne Ogre:
http://www.purebasic.fr/german/viewtopic.php?t=15807
Textur-Generator:
http://www.purebasic.fr/german/viewtopic.php?t=15743
PureBasic-Spiele:
http://www.purebasic.fr/german/viewtopic.php?t=15776
PureBasic-Projekt-Thread
http://www.purebasic.fr/german/viewtopic.php?t=15857
Die könnte als Werkzeug dienen.
Ein Adventure oder 3D-Spiel sollte nun nicht mehr so das Problem sein und wir können uns über Story, GamePlay etc. Gedanken machen.
Mein Code ist sicherlich sch**ß* langsam.
Aber für ein paar Würfel reicht es. Und wenn jemand weiß, wie man die Transformsprite-Zeile ersetzt, damit die Texturfehler weg gehen, wäre ich auch dankbar.
Hatte das zwar schon mal gepostet und Kaeru hat ausch eine gute Antwort geschrieben. Aber ich bin trotzdem kein Stück schlauer.
Die PureBasic-Hilfe sagt leider über die Z-Koordinaten-Angabe auch nichts aus.

Lasst die Spiele beginnen