
Hab den Parameter glatt übersehen...
Gruß
Scarabol
Code: Alles auswählen
;EnableExplicit
XIncludeFile "3Dto2D.pb"
Structure Dots
p.V3D
c.l
EndStructure
Structure Szbuffer
i.w
j.w
z.f
xs.f
ys.f
EndStructure
Structure tempdot
p.V3D
d.V3D
EndStructure
Procedure LimitVar(Var, Min, Max)
If Var < Min
Var = Min
ElseIf Var > Max
Var = Max
EndIf
ProcedureReturn Var
EndProcedure
Global Width.l = 800, Height.l = 600
Global NewList Dots.Dots()
Define x.l, y.l, z.l, i.l, d.d, m.l, n.l, o.l, R.l, c
Define scaley.f
Define temp.V3D
UsePNGImageDecoder()
InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()
If OpenWindow(0, 0, 0, Width, Height, "3D-to-2D", #PB_Window_ScreenCentered) = 0 : End : EndIf
If OpenWindowedScreen(WindowID(0), 0, 0, Width, Height, 0, 0, 0) = 0 : End : EndIf
If LoadImage(1, #PB_Compiler_Home+"Examples\Sources\Data\Terrain.png")
StartDrawing(ImageOutput(1))
Global w, h
w = ImageWidth(1)/2
h = ImageHeight(1)/2
Global Dim dotar.V3D(w,h)
Global Dim temp.tempdot(w,h)
Dim temp2.V3D(w*h)
For x = 0 To w
For y = 0 To h
dotar(x,y)\x = x
dotar(x,y)\y = 255-Red(Point(x,y))
dotar(x,y)\z = y
Next
Next
StopDrawing()
EndIf
Procedure OnScreen(x,y)
If temp(x,y)\p\x >= 0 And temp(x,y)\p\x < Width And temp(x,y)\p\y >= 0 And temp(x,y)\p\y < Height
ProcedureReturn 1
EndIf
EndProcedure
Procedure AnotherOnScreen(x,y)
For tx = -2 To 2
For ty = -2 To 2
If (tx<>0 Or ty<>0)
a = x+tx
b = y+ty
If a >= 0 And a < w And b >= 0 And b < h
If OnScreen(a,b)
ProcedureReturn 1
EndIf
EndIf
EndIf
Next
Next
EndProcedure
Procedure Distance3D(x1,y1,z1,x2,y2,z2)
dx = x2-x1
dy = y2-y1
dz = z2-z1
ProcedureReturn dx*dx+dy*dy+dz*dz
EndProcedure
Define p.V3D, a.V3D, p2d.V3D, p2d.V3D
Define p_add.d, a_add.d, FOV.d
p_add.d = 1
a_add.d = 1
FOV.d = 45
scaley = 8
#maxdif = 0
Global MaxRange = 50
Define *Camera.Camera
*Camera.Camera = Camera_New()
Camera_Size(*Camera, 0, Width - 1, 0, Height - 1)
For i = 0 To 255
CreateSprite(i, 32, 32, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(i))
Box(0,0,32,32,RGB(i,i,i))
StopDrawing()
CreateSprite3D(i,i)
Next
Repeat
ClearScreen(0)
ExamineKeyboard()
ExamineMouse()
p\x = 0 : p\y = 0 : p\z = 0
a\x + MouseDeltaY() * 0.5
a\y + MouseDeltaX() * 0.5
If a\x < 0 : a\x+360 : ElseIf a\x > 360 : a\x-360 : EndIf
If a\y < 0 : a\y+360 : ElseIf a\y > 360 : a\y-360 : EndIf
If KeyboardPushed(#PB_Key_Up) : p\z + p_add*Cos(a\y*#Deg2Rad) : p\x + p_add*Sin(a\y*#Deg2Rad) : EndIf
If KeyboardPushed(#PB_Key_Down) : p\z - p_add*Cos(a\y*#Deg2Rad) : p\x - p_add*Sin(a\y*#Deg2Rad) : EndIf
If KeyboardPushed(#PB_Key_Left) : p\x - p_add*Cos(a\y*#Deg2Rad) : p\z + p_add*Sin(a\y*#Deg2Rad) : EndIf
If KeyboardPushed(#PB_Key_Right) : p\x + p_add*Cos(a\y*#Deg2Rad) : p\z - p_add*Sin(a\y*#Deg2Rad) : EndIf
If KeyboardReleased(#PB_Key_A) : scaley/2 : EndIf
If KeyboardReleased(#PB_Key_Z) : scaley*2 : EndIf
If KeyboardPushed(#PB_Key_S) : MaxRange+1 : EndIf
If KeyboardPushed(#PB_Key_X) : MaxRange-1 : EndIf
If KeyboardPushed(#PB_Key_D) : FOV - 0.25 : EndIf
If KeyboardPushed(#PB_Key_C) : FOV + 0.25 : EndIf
Camera_FOV(*Camera, FOV)
t.V3D\x = LimitVar(*Camera\p\x+p\x, 0, w)
t.V3D\z = LimitVar(*Camera\p\z+p\z, 0, h)
t.V3D\y = Dotar(Int(*Camera\p\x),Int(*Camera\p\z))\y/scaley-8
Camera_Set(*Camera, t, a)
For x = 0 To w
For y = 0 To h
hy.d = Dotar(x,y)\y/scaley
temp.V3D\x = Dotar(x,y)\x
temp.V3D\y = hy
temp.V3D\z = Dotar(x,y)\z
If Camera_3Dto2D(*Camera, temp, temp(x,y)\p, temp(x,y)\d)
; Circle(temp(x,y)\p\x, temp(x,y)\p\y, 2, #White)
EndIf
If x < w And y < h
temp2(y*h+x)\x = x
temp2(y*h+x)\y = y
temp2(y*h+x)\z = Distance3D(Dotar(x,y)\x, hy, Dotar(x,y)\z, *Camera\p\x, *Camera\p\y, *Camera\p\z)
EndIf
Next
Next
SortStructuredArray(temp2(), 1, OffsetOf(V3D\z), #PB_Sort_Double)
Start3D()
For n = 0 To w*h
x = temp2(n)\x
y = temp2(n)\y
If temp(x,y)\d\z > 0 And temp(x,y)\d\z < MaxRange And (OnScreen(x,y) Or AnotherOnScreen(x,y))
x1 = temp(x,y)\p\x
y1 = temp(x,y)\p\y
x2 = temp(x+1,y)\p\x
y2 = temp(x+1,y)\p\y
x3 = temp(x+1,y+1)\p\x
y3 = temp(x+1,y+1)\p\y
x4 = temp(x,y+1)\p\x
y4 = temp(x,y+1)\p\y
TransformSprite3D(Dotar(x,y)\y,x4,y4,x3,y3,x2,y2,x1,y1)
DisplaySprite3D(Dotar(x,y)\y,0,0,255)
EndIf
Next
Stop3D()
StartDrawing(ScreenOutput())
DrawingMode(1)
FrontColor(#White)
DrawText(10, 10, fps$)
DrawText(10, 30, Str(w*h))
DrawText(10, 50, Str(a\x))
DrawText(10, 70, Str(a\y))
DrawText(10, 100, "CameraX:"+Str(*Camera\p\x))
DrawText(10, 120, "CameraY:"+Str(*Camera\p\y))
DrawText(10, 140, "CameraZ:"+Str(*Camera\p\z))
StopDrawing()
fps + 1
If timer = 0
timer = ElapsedMilliseconds()
ElseIf ElapsedMilliseconds()-timer >= 1000
fps$ = Str(fps)
fps = 0
timer = 0
EndIf
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
GrußDas mit den Sprites ist so nicht zu machen, weil man jeden einzelnen Pixel
umrechnen müsste und außerdem sortieren müsste, damit alles von hinten
nach vorne dargestellt wird und nicht durcheinander. Und dafür gibt es
3D-Grafikkarten.
Code: Alles auswählen
*Camera = AllocateMemory(SizeOf(Camera))
Code: Alles auswählen
Camera_Calc(*Camera)
With *Camera
\MinX = -1
\MaxX = 1
\MinY = -1
\MaxY = 1
\AspX = 1
\AspY = 1
EndWith