Drawing3D - Draw-Befehle für 3D-Szenen

Du brauchst Grafiken, gute Programme oder Leute die dir helfen? Frag hier.
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von STARGÅTE »

Ich bin immer noch verwundert, welche Code-Version du nimmst, vor allem woher dieses "IncludeBinary "Image.png"" kommt, aber egal.

Zum Thema VectorDrawing:
Das FillPath() ist natürlich schneller als mein Pixel-Algo, allerdings hast du dann kein Tiefen-Buffer.
Deinen Sachen werden also einfach nach Aufrufszeitpunkt auf die Szene gezeichnet und nicht nach Tiefe und Durchdringungen sind auch nicht möglich.
Daher arbeite ich (immer noch) mit dem "alten" Drawing, weil ich eh alles per-Pixel machen muss.
Zudem werden die Pixel an einem Ort auch noch alle der Tiefe nach sortiert, damit Transparenzen korrekt gezeichnet werden, da haben ja sogar die 3D-Engines ihre Probleme.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von Michael Vogel »

Du hast absolut recht, die ineinander verschachtelten Elemente sind erstens mit mit deinem Ansatz wunderbar gelöst und schauen zweitens saugut aus :D

Ich probiere mich allerdings an einer vereinfachten Version (weil ich halt gerade ein paar Wohnungseinrichtungen plane) - und habe einen komplett neuen Code geschrieben. Wegen meines ziemlich verstaubten Mathematik-Wissens ist das Ergebnis leider nicht nur ziemlich primitiv sondern auch mit wenig perfekter Logik (bezüglich sichtbarer und unsichtbarer Fkächen) ausgestattet.

Bei dem einfachen Beispiel mit vier Würfeln klappt es zwar einigermaßen gut, ersetzt man allerdings DoObjects(1) durch DoObjects(2) sieht man bei etwas komplexeren Elementen die Schwächen meines Programms doch recht deutlich...

Code: Alles auswählen

; Define

	EnableExplicit

	#ZoomScale=0.15
	#ZweiPi=#PI+#PI
	#PiHalbe=#PI/2
	#PiTeil=#PI/18
	#PiRadiant=#PI/180
	#PiGrad=180/#PI

	; ------------------------------------------------------------------------------------

	Structure DotType
		x.d;			skaliert
		y.d;			skaliert
		z.d;			skaliert
		_x.i;		2D-Transformation
		_y.i;		2D-Transformation
		;_rb.i;		3D-Punkt-Distanz (rot/blau)
		_distance.q;	Z-Distanz zum Betrachter
	EndStructure

	Structure ObjectType
		Type.i;		Punkt, Linie, Oberfläche (3 oder 4 Punkte)
		Point.i[4];	Punktkoordinaten
		Color.i;		Flächenfarbe
		Outline.i;	Linienfarbe
		Centre.i;		Flächenmittelpunkt
		Visible.i;	sichtbares Segment
	EndStructure

	Structure SorterType
		Object.i
		Distance.q
	EndStructure

	Structure Mat
		x.d[4]
		y.d[4]
		z.d[4]
		t.d[4]
	EndStructure

	Structure SettingType
		ShowOutline.i
		ShowSurface.i
		ShowInformation.i
		ModeRotation.i
		ModeFill.i
		ModeLine.i
		Optimizer.i
		ZoomFactor.i
		ShowThreeD.i;			3D-Darstellung
		ThreeD_Distance.i;		Punktabstand für 3D-Effekt;					-		-		-
		ThreeD_Left.i;			Farbfilter für das linke Auge (rot)				-		-		-
		ThreeD_Right.i;		...rechtes Auge (grün, blau)					-		-		-
	EndStructure

	; ------------------------------------------------------------------------------------

	Global MaxElements=	25000

	Global.Mat Matrix, Calc, RotXMat, RotYMat, RotZMat, Camera, TempMat
	Global Dim Dot.DotType(MaxElements)
	Global Dim Object.ObjectType(MaxElements)
	Global Dim Sorter.SorterType(MaxElements)

	; Bildschirmgröße für Graphikfenster
	Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
	Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)
	Global Screen_X=ScreenX-1
	Global Screen_Y=ScreenY-1
	Global ScreenZ
	Global OffsetX=ScreenX>>1
	Global OffsetY=ScreenY>>1

	; Skalierung für 3D-Transformation
	Global.d ViewX, ViewY, ViewZ, Scale
	Global.d AngleX, AngleY, AngleZ;		Rotationswinkel (per Maus auswählbar)
	Global.d XdivPi=#PI/OffsetX;			Skalierung, um genau eine Drehung nach 'X' zu erlauben
	Global.d YdivPi=#PI/OffsetY;			Skalierung, um genau eine Drehung nach 'Y' zu erlauben
	Global.d RealZoomFactor;				skalierte Vergrößerung

	Global CounterPoints, CounterObjects
	Global OptCamera
	Global OptCameraX, OptCameraY, OptCameraZ

	Global Setting.SettingType

	; ------------------------------------------------------------------------------------

	OptCamera=		500

	With Setting
		\ShowSurface=	1
		\ShowOutline=	0
		\ZoomFactor=	10
		\ModeRotation=	1
		\ModeFill=	1
			\Optimizer=	1
	EndWith

	; ------------------------------------------------------------------------------------

	Enumeration
		#Win
		#Canvas
		;
		#ShiftLeft
		#ShiftRight
		#ShiftUp
		#ShiftDown
		#RotateLeft
		#RotateRight
		#RotateUp
		#RotateDown
		#ToggleRotation
		#ToggleLine
		#ToggleFill
		#ToggleOutline
		#ToggleSurface
		#ToggleInformation
	EndEnumeration

	; ------------------------------------------------------------------------------------

	Macro StrM(value)
		RSet(StrD(value,2),8)
	EndMacro
	Macro CreateLine(p1,p2,outline)

		CreateObject(#ObjectTypeLine,p1,p2,#Null,#Null,#Null,outline)

	EndMacro
	Macro CreateRectangle(p1,p2,p3,p4,color,outline)

		CreateObject(#ObjectTypeRectangle,p1,p2,p3,p4,color,outline)

	EndMacro

; EndDefine

Procedure SetNorm(*m.mat)
	*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
	*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
	*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
	*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetTransformation(*m.mat,x.d,y.d,z.d)
	*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
	*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
	*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
	*m\x[3]=x : *m\y[3]=y : *m\z[3]=z : *m\t[3]=1
EndProcedure
Procedure SetCamera(x,y,z.d)
	OptCameraX=x
	OptCameraY=y
	OptCamera=z
	Camera\x[0]=1 : Camera\y[0]=0 : Camera\z[0]=0 : Camera\t[0]=0
	Camera\x[1]=0 : Camera\y[1]=1 : Camera\z[1]=0 : Camera\t[1]=0
	Camera\x[2]=0 : Camera\y[2]=0 : Camera\z[2]=1 : Camera\t[2]=0
	Camera\x[3]=x : Camera\y[3]=y : Camera\z[3]=z : Camera\t[3]=1
EndProcedure
Procedure SetRotX(*m.mat,angle.d)
	Protected s.d=Sin(angle)
	Protected c.d=Cos(angle)
	*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
	*m\x[1]=0 : *m\y[1]=c : *m\z[1]=s : *m\t[1]=0
	*m\x[2]=0 : *m\y[2]=-s : *m\z[2]=c : *m\t[2]=0
	*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotY(*m.mat,angle.d)
	Protected s.d=Sin(angle)
	Protected c.d=Cos(angle)
	*m\x[0]=c : *m\y[0]=0 : *m\z[0]=s : *m\t[0]=0
	*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
	*m\x[2]=-s : *m\y[2]=0 : *m\z[2]=c : *m\t[2]=0
	*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotZ(*m.mat,angle.d)
	Protected s.d=Sin(angle)
	Protected c.d=Cos(angle)
	*m\x[0]=c : *m\y[0]=s : *m\z[0]=0 : *m\t[0]=0
	*m\x[1]=-s : *m\y[1]=c : *m\z[1]=0 : *m\t[1]=0
	*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
	*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure Multiply(*m.mat,*n.mat,*result.mat)

	TempMat\x[0]=*m\x[0]**n\x[0] + *m\x[1]**n\y[0] + *m\x[2]**n\z[0] + *m\x[3]**n\t[0]
	TempMat\y[0]=*m\y[0]**n\x[0] + *m\y[1]**n\y[0] + *m\y[2]**n\z[0] + *m\y[3]**n\t[0]
	TempMat\z[0]=*m\z[0]**n\x[0] + *m\z[1]**n\y[0] + *m\z[2]**n\z[0] + *m\z[3]**n\t[0]
	TempMat\t[0]=*m\t[0]**n\x[0] + *m\t[1]**n\y[0] + *m\t[2]**n\z[0] + *m\t[3]**n\t[0]

	TempMat\x[1]=*m\x[0]**n\x[1] + *m\x[1]**n\y[1] + *m\x[2]**n\z[1] + *m\x[3]**n\t[1]
	TempMat\y[1]=*m\y[0]**n\x[1] + *m\y[1]**n\y[1] + *m\y[2]**n\z[1] + *m\y[3]**n\t[1]
	TempMat\z[1]=*m\z[0]**n\x[1] + *m\z[1]**n\y[1] + *m\z[2]**n\z[1] + *m\z[3]**n\t[1]
	TempMat\t[1]=*m\t[0]**n\x[1] + *m\t[1]**n\y[1] + *m\t[2]**n\z[1] + *m\t[3]**n\t[1]

	TempMat\x[2]=*m\x[0]**n\x[2] + *m\x[1]**n\y[2] + *m\x[2]**n\z[2] + *m\x[3]**n\t[2]
	TempMat\y[2]=*m\y[0]**n\x[2] + *m\y[1]**n\y[2] + *m\y[2]**n\z[2] + *m\y[3]**n\t[2]
	TempMat\z[2]=*m\z[0]**n\x[2] + *m\z[1]**n\y[2] + *m\z[2]**n\z[2] + *m\z[3]**n\t[2]
	TempMat\t[2]=*m\t[0]**n\x[2] + *m\t[1]**n\y[2] + *m\t[2]**n\z[2] + *m\t[3]**n\t[2]

	TempMat\x[3]=*m\x[0]**n\x[3] + *m\x[1]**n\y[3] + *m\x[2]**n\z[3] + *m\x[3]**n\t[3]
	TempMat\y[3]=*m\y[0]**n\x[3] + *m\y[1]**n\y[3] + *m\y[2]**n\z[3] + *m\y[3]**n\t[3]
	TempMat\z[3]=*m\z[0]**n\x[3] + *m\z[1]**n\y[3] + *m\z[2]**n\z[3] + *m\z[3]**n\t[3]
	TempMat\t[3]=*m\t[0]**n\x[3] + *m\t[1]**n\y[3] + *m\t[2]**n\z[3] + *m\t[3]**n\t[3]

	*result\x[0]=TempMat\x[0]
	*result\x[1]=TempMat\x[1]
	*result\x[2]=TempMat\x[2]
	*result\x[3]=TempMat\x[3]
	*result\y[0]=TempMat\y[0]
	*result\y[1]=TempMat\y[1]
	*result\y[2]=TempMat\y[2]
	*result\y[3]=TempMat\y[3]
	*result\z[0]=TempMat\z[0]
	*result\z[1]=TempMat\z[1]
	*result\z[2]=TempMat\z[2]
	*result\z[3]=TempMat\z[3]
	*result\t[0]=TempMat\t[0]
	*result\t[1]=TempMat\t[1]
	*result\t[2]=TempMat\t[2]
	*result\t[3]=TempMat\t[3]

EndProcedure
Procedure CreatePoint(x.d,y.d,z.d)

	Protected i

	If Setting\Optimizer; 					Punkt in den gespeicherten Punkten suchen...
		i=CounterPoints
		While i
			With Dot(i)
				If \x=x And \y=y And \z=z
					Break
				EndIf
			EndWith
			i-1
		Wend
	EndIf

	If i=0 And CounterPoints<MaxElements;	neuer Punkt
		CounterPoints+1
		i=CounterPoints
	EndIf

	With Dot(i);						Koordinaten setzen
		\x=x
		\y=y
		\z=z
	EndWith

	ProcedureReturn i

EndProcedure
Procedure CreateObject(type,a,b,c,d,color,outline=#Null)

	Enumeration
		#ObjectTypeDot
		#ObjectTypeLine
		#ObjectTypeTriangle
		#ObjectTypeRectangle
	EndEnumeration

	If CounterObjects<MaxElements
		CounterObjects+1

		With Object(CounterObjects)
			\Type=type
			\Point[0]=a
			\Point[1]=b
			\Point[2]=c
			\Point[3]=d
			\Color=color
			\Outline=outline
			Select type
			Case #ObjectTypeLine
				\Centre=CreatePoint((Dot(a)\x+Dot(b)\x)/2,(Dot(a)\y+Dot(b)\y)/2,(Dot(a)\z+Dot(b)\z)/2)
			Case #ObjectTypeRectangle
				\Centre=CreatePoint((Dot(a)\x+Dot(b)\x+Dot(c)\x+Dot(d)\x)/4,(Dot(a)\y+Dot(b)\y+Dot(c)\y+Dot(d)\y)/4,(Dot(a)\z+Dot(b)\z+Dot(c)\z+Dot(d)\z)/4)
			EndSelect
		EndWith

		ProcedureReturn CounterObjects
	EndIf

	ProcedureReturn #Null

EndProcedure
Procedure CreateBox(ax.d,ay.d,az.d, bx.d,by.d,bz.d,color.i,outline.i=#Null)

	Protected p1,p2,p3,p4,p5,p6,p7,p8

	bx+ax
	by+ay
	bz+az

	p1=CreatePoint(ax,ay,az)
	p2=CreatePoint(bx,ay,az)
	p3=CreatePoint(bx,by,az)
	p4=CreatePoint(ax,by,az)

	p5=CreatePoint(ax,ay,bz)
	p6=CreatePoint(bx,ay,bz)
	p7=CreatePoint(bx,by,bz)
	p8=CreatePoint(ax,by,bz)


	If outline
		CreateLine(p1,p2,outline)
		CreateLine(p2,p3,outline)
		CreateLine(p3,p4,outline)
		CreateLine(p4,p1,outline)

		CreateLine(p5,p6,outline)
		CreateLine(p6,p7,outline)
		CreateLine(p7,p8,outline)
		CreateLine(p8,p5,outline)

		CreateLine(p1,p5,outline)
		CreateLine(p2,p6,outline)
		CreateLine(p3,p7,outline)
		CreateLine(p4,p8,outline)
	EndIf

	CreateRectangle(p1,p2,p3,p4,color,outline)
	CreateRectangle(p1,p2,p6,p5,color,outline)
	CreateRectangle(p2,p3,p7,p6,color,outline)
	CreateRectangle(p3,p4,p8,p7,color,outline)
	CreateRectangle(p4,p1,p5,p8,color,outline)
	CreateRectangle(p5,p6,p7,p8,color,outline)


EndProcedure
Procedure Redraw()

	Protected.i i,n
	Protected.d x,y
	Protected.s s

	Protected FillMode
	Protected.d LineMode

	StartVectorDrawing(CanvasVectorOutput(#Canvas))
	VectorFont(FontID(0))
	;VectorSourceColor($C0FFFFFF)
	VectorSourceColor($FFFFFFFF)
	FillVectorOutput()

	FillMode=Setting\ModeFill*$FF000000
	LineMode=Setting\ModeLine+0.8

	If Setting\ShowSurface
		While i<CounterObjects
			i+1
			n=Sorter(i)\Object
			With Object(n)
				Select \type
				Case #ObjectTypeRectangle
					MovePathCursor(Dot(\Point[0])\_x,Dot(\Point[0])\_y)
					AddPathLine(Dot(\Point[1])\_x,Dot(\Point[1])\_y)
					AddPathLine(Dot(\Point[2])\_x,Dot(\Point[2])\_y)
					AddPathLine(Dot(\Point[3])\_x,Dot(\Point[3])\_y)
					ClosePath()
					VectorSourceColor(\Color|FillMode)
					FillPath(#PB_Path_Preserve)
					VectorSourceColor(\Outline)
					StrokePath(LineMode,#PB_Path_RoundCorner)

					If Setting\ShowInformation
						s=Str(i)+" (#"+Str(n)+") "+Str(Dot(\Centre)\_distance)
						Debug s
						MovePathCursor(Dot(\Centre)\_x-VectorTextWidth(s)/2,Dot(\Centre)\_y-VectorTextHeight(s)/2)
						VectorSourceColor($FF000000)
						DrawVectorText(s)
					EndIf

				EndSelect
			EndWith
		Wend
	EndIf

	If Setting\ShowOutline
		LineMode=Setting\ModeLine+1

		n=0
		While n<CounterObjects
			n+1
			With Object(n)
				Select \type
				Case #ObjectTypeLine
					If \Outline
						MovePathCursor(Dot(\Point[0])\_x,Dot(\Point[0])\_y)
						AddPathLine(Dot(\Point[1])\_x,Dot(\Point[1])\_y)
						VectorSourceColor(\Outline)
						StrokePath(LineMode,#PB_Path_RoundEnd)
					EndIf
				EndSelect
			EndWith
		Wend
	EndIf

	StopVectorDrawing()

EndProcedure
Procedure Recalc(mode)

	Protected i

	Multiply(@Camera,@Matrix,@Calc)

	RealZoomFactor=Setting\ZoomFactor * #ZoomScale

	For i=1 To CounterPoints
		With Dot(i)
			ViewX = \x*calc\x[0] + \y*calc\x[1] + \z*calc\x[2] + calc\x[3]
			ViewY = \x*calc\y[0] + \y*calc\y[1] + \z*calc\y[2] + calc\y[3]
			ViewZ = \x*calc\z[0] + \y*calc\z[1] + \z*calc\z[2] + calc\z[3]

			Scale=OptCamera/ViewZ
			\_x=ViewX*Scale*RealZoomFactor+OffsetX
			\_y=ViewY*Scale*RealZoomFactor+OffsetY
			\_distance=Scale*10000000
			;\_distance=Int(Scale*10000000)*10000-(Abs(\_x-OffsetX)+Abs(\_y-OffsetY))/100
			;\_rb=(Opt3DDistance+OptZoomFactor)/(ViewZ+32)
		EndWith
	Next i

	For i=1 To CounterObjects
		With Sorter(i)
			\Object=i
			\Distance=Dot(Object(i)\Centre)\_distance
		EndWith
	Next i
	SortStructuredArray(Sorter(),#PB_Sort_Ascending,OffsetOf(SorterType\Distance),TypeOf(SorterType\Distance),1,CounterObjects)

	If mode
		Redraw()
	EndIf

EndProcedure
Procedure Rotation()

	SetRotX(@RotXMat,AngleY)
	SetRotZ(@RotYMat,AngleX)
	SetRotY(@RotZMat,AngleZ)

	Multiply(@RotXMat,@RotYMat,@Matrix)
	Multiply(@Matrix,@RotZMat,@Matrix)

	Recalc(#True)

EndProcedure

Procedure DoObjects(demo)

	Select demo

	Case 1
		CreateBox(0,0,0, 100,100,100,$E0f0a060,$80000000)
		CreateBox(200,0,0, 100,100,100,$E0f060a0,$80000000)
		CreateBox(0,200,0, 100,100,100,$E0c0a0f0,$80000000)
		CreateBox(0,0,200, 100,100,100,$E0c0f0a0,$80000000)

	Case 2
		#ColorFront=	$C0E0E0F0
		#ColorWood=	$E05090B0
		; unten
		CreateBox(0,0,0, 62,50,60, #ColorFront,$40000000)
		CreateBox(63,0,0, 62,50,60, #ColorFront,$40000000)
		CreateBox(126,0,0, 62,50,60, #ColorFront,$40000000)
		CreateBox(189,0,0, 62,50,40, #ColorFront,$40000000)
		; mittig
		CreateBox(0,51,0, 62,25,60, #ColorFront,$40000000)
		CreateBox(63,51,0, 62,25,60, #ColorFront,$40000000)
		CreateBox(126,51,0, 62,25,60, #ColorFront,$40000000)
		CreateBox(189,51,0, 62,25,40, #ColorFront,$40000000)
		; links/rechts
		CreateBox(0,77,0, 62,130,60, #ColorFront,$40000000)
		CreateBox(189,77,0, 62,130,40, #ColorFront,$40000000)
		; oben
		CreateBox(0,208,0, 62,50,60, #ColorFront,$40000000)
		CreateBox(63,208,0, 62,50,40, #ColorFront,$40000000)
		CreateBox(126,208,0, 62,50,40, #ColorFront,$40000000)
		CreateBox(189,208,0, 62,50,40, #ColorFront,$40000000)
		; Platten
		CreateBox(62,77,0, 1,181,60, #ColorWood,$40000000)
		CreateBox(62,207,0, 125,1,42, #ColorWood,$40000000)
		CreateBox(62,76,0, 125,1,60, #ColorWood,$40000000)
		CreateBox(188,0,40, 1,76,20, #ColorWood,$40000000)
		CreateBox(188,76,0, 1,131,40, #ColorWood,$40000000)

	EndSelect

EndProcedure
Procedure Main()

	#WX=1200
	#WY=800

	LoadFont(0,"Segoe UI",8)

	OpenWindow(#Win,0,0,#WX,#WY,"Tastatur: Cursor-Tasten, +, -     Optionen: O=Linien S=Flächen, F=Füllmodus, L=Linienstärke, R: Rotationswechsel, D:Debugging")
	CanvasGadget(#Canvas,0,0,#WX,#WY)

	AddKeyboardShortcut(#Win,#PB_Shortcut_Left|#PB_Shortcut_Shift,#ShiftLeft)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Right|#PB_Shortcut_Shift,#ShiftRight)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Up|#PB_Shortcut_Shift,#ShiftUp)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Down|#PB_Shortcut_Shift,#ShiftDown)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Left,#RotateLeft)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Right,#RotateRight)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Up,#RotateUp)
	AddKeyboardShortcut(#Win,#PB_Shortcut_Down,#RotateDown)
	AddKeyboardShortcut(#Win,#PB_Shortcut_D,#ToggleInformation)
	AddKeyboardShortcut(#Win,#PB_Shortcut_F,#ToggleFill)
	AddKeyboardShortcut(#Win,#PB_Shortcut_L,#ToggleLine)
	AddKeyboardShortcut(#Win,#PB_Shortcut_O,#ToggleOutline)
	AddKeyboardShortcut(#Win,#PB_Shortcut_R,#ToggleRotation)
	AddKeyboardShortcut(#Win,#PB_Shortcut_S,#ToggleSurface)

	; ------------------------------------------------------------------------------------

	DoObjects(1)
	
	; ------------------------------------------------------------------------------------

	OptCameraX=-200
	OptCameraY=100
	OptCamera=1000
	AngleX=Radian(0)
	AngleY=Radian(-170)
	AngleZ=Radian(20)


	SetCamera(OptCameraX,OptCameraY,OptCamera)
	SetNorm(@Matrix)
	Rotation()

	Repeat
		Select WindowEvent()
		Case #PB_Event_Gadget,#PB_Event_Menu
			Select EventGadget()
			Case #ShiftLeft
				SetCamera(OptCameraX-30,OptCameraY,OptCamera)
				Recalc(#True)
			Case #ShiftRight
				SetCamera(OptCameraX+30,OptCameraY,OptCamera)
				Recalc(#True)
			Case #ShiftUp
				SetCamera(OptCameraX,OptCameraY-30,OptCamera)
				Recalc(#True)
			Case #ShiftDown
				SetCamera(OptCameraX,OptCameraY+30,OptCamera)
				Recalc(#True)
			Case #RotateLeft
				If Setting\ModeRotation
					AngleZ-#PiTeil
					If AngleZ<0 : AngleZ+#ZweiPi : EndIf
				Else
					AngleX-#PiTeil
					If AngleX<0 : AngleX+#ZweiPi : EndIf
				EndIf
				Rotation()
			Case #RotateRight
				If Setting\ModeRotation
					AngleZ+#PiTeil
					If AngleZ>#ZweiPi : AngleZ-#ZweiPi : EndIf
				Else
					AngleX+#PiTeil
					If AngleX>#ZweiPi : AngleX-#ZweiPi : EndIf
				EndIf
				Rotation()
			Case #RotateUp
				AngleY-#PiTeil
				Rotation()
			Case #RotateDown
				AngleY+#PiTeil
				Rotation()
			Case #ToggleOutline
				Setting\ShowOutline!1
				Redraw()
			Case #ToggleSurface
				Setting\ShowSurface!1
				Redraw()
			Case #ToggleInformation
				Setting\ShowInformation!1
				Redraw()
			Case #ToggleFill
				Setting\ModeFill!1
				Redraw()
			Case #ToggleLine
				Setting\ModeLine!1
				Redraw()
			Case #ToggleRotation
				Setting\ModeRotation!1

			EndSelect

		Case #PB_Event_CloseWindow
			End

		Case #WM_CHAR
			Select EventwParam()
			Case '+'
				If OptCamera>300
					SetCamera(OptCameraX,OptCameraY,OptCamera-50)
					Recalc(#True)
				EndIf
			Case '-'
				SetCamera(OptCameraX,OptCameraY,OptCamera+50)
				Recalc(#True)

			EndSelect

		EndSelect
	ForEver

EndProcedure

Main()
End

SMaag
Beiträge: 150
Registriert: 08.05.2022 12:58

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von SMaag »

Ich arbeite gerade immer wieder an einem einheitlichen FrameWork für PureBasic.
Das Ding hier würd ich da gerne aufnehmen. Wäre super, wenn man das gleich
in einem einheitlichen LookAndFeel entwickeln könnte

Bei meiner Arbeit bin ich immer wieder auf das Problem der zu langen Modulnamen gestoßen.
Wenn man die ohne UseModule einbindet, sollten sie möglichst kurz sein, sonst wird der
Code zu unübersichtlich.

Vorschlag:
Modul: D3D oder d3D

Für die Structures hab ich mich jetzt an das System von Delphi angelehnt. Structures / Typen immer mit T vorgestellt.
Das macht absoltut Sinn, da man dann sofort weis, es handelt sich um eine Struct

z.B.
Structure TPixel3D; TPoint3D oder umgekehrt T3DPixel

Ich hab mich für folgende Defintionen entschieden

Code: Alles auswählen

Structure TPoint
  X.d     ; X As Double (64Bit Float)
  Y.d     ; Y As Double (64Bit Float)
EndStructure

Structure TPoint3D
  X.d
  Y.d
  Z.d
EndStructure

Structure TSize
  dX.d    ; dimension, delta X = width
  dY.d    ; dimension, delta Y = height
EndStructure

Structure TSize3D
  dX.d    ; dimension, delta X = width
  dY.d    ; dimension, delta Y = height
  dZ.d    ; dimension, delta Z = depth
EndStructure

Ich hab die erste Version des Framworks jezt mal auf Github hochgeladen.
Aber Achtung: alles nicht fertig und in Beta Statium

https://github.com/Maagic7/PureBasicFrameWork
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von STARGÅTE »

Hallo SMaag,

so eine ähnliche Diskussion zu den (Procedure-) Namen gab es schon am Anfang des Threads.
Es ist hier nicht immer einfach es alles recht zu machen. Ich persönlich finde z.B. deine "kurzen" Namen unübersichtlich. Hinter Abkürzungen wie "FS" (FileSystem) oder "D3D" (Drawing3D) geht halt nicht direkt hervor um was es sich handelt, so ist es für dritte schwer den Code zu lesen. Aber wie gesagt, dass sind ja alles persönliche Meinungen, ähnlich wie die Wahl zwischen Präfix und Suffix Procedure-Namen.

Allerdings sollte man bei der Wahl des Modul-Namen durchaus überlegen, ob das Module tendenziell eher mit UseModule oder ohne verwendet wird:
  • Wird es eigentlich immer mit UseModule eingebunden, sollten die Prozedur-Namen selbst auch Aufschluss über das Module geben
  • Wird es eigentlich immer ohne UseModule, also mit vorangestelltem Modulenamen, dann braucht dieser nicht mehr im Prozedurnamen oder Konstantennamen auftauschen.
Beispiele wären hier in meinem Context: Drawing3D::Box() vs. DrawBox3D()
Beispiel in meinem Kontext wäre: STR::#CharMode vs. #STR_CharMode

Zu dem Satz:
SMaag hat geschrieben: 28.11.2022 15:30 Das Ding hier würd ich da gerne aufnehmen. Wäre super, wenn man das gleich
in einem einheitlichen LookAndFeel entwickeln könnte
Wer ist hier "man". Meinst du mich?

Noch ein paar Anmerkungen zu deinen aktuellen Modulen(, was mir beim drüber scrollen aufgefallen ist):
  • Module_STRING.pb
    PokeS(String, ptrBuffer, #PB_Ascii) in Macro StringToAsciiBuffer(String, ptrBuffer) ist falsch.
    Der dritte Parameter ist immer die Länge, der vierte ist das Flag, also:
    PokeS(String, ptrBuffer, -1, #PB_Ascii)
  • Module_BUFFER.pb
    In der Prozedur SwapBuffers() vertauschst du mit "Swap *hBUF_1, *hBUF_2" einfach nur die beiden Argumente aber nicht die Buffer selbst. Nach außen passiert praktisch nix wenn du das ausführst.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
SMaag
Beiträge: 150
Registriert: 08.05.2022 12:58

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von SMaag »

Allerdings sollte man bei der Wahl des Modul-Namen durchaus überlegen, ob das Module tendenziell eher mit UseModule oder ohne verwendet wird
Wenn man einzelne Module verwendet ist UseModule wohl die bessere Idee. Ich hab etwas rumprobiert, und man kann in PB eben egal wie man es anstellt nur 1 Modul mit UseModule einbinden. In Pascal ist die Modultechnik z.B. Standard und da wird grundsätzlich alles über Module/Units eingebunden.
Wenn ich jetzt, so wie ich das vor habe, ein Framework baue, dann muss am besten alles in Module verpackt werden, sonst hat man immer wieder Zugriffsproblemen mit globalem Code der nicht in Module verpackt ist.

Hier ist es dann besser, möglichst kurze Modulnamen zu haben. Ich hab das im Moment so gelöst, dass der FileName den ausgeschriebenen Namen enthält. Ganz zufrieden bin ich mit der Lösung nicht. Ist halt so in PB.
Das Problem der zu langen Modulnamen liegt hauptsächlich bei den Variablendefinitionen, nicht bei Proceduren.

Bei Pascal hingegen hat man immer das Problem, dass man oft nicht weis, aus welcher Unit nun der Befehl stammt. Das ist in PB mit dem
Modul:: weit einfacher.
Module_BUFFER.pb
In der Prozedur SwapBuffers() vertauschst du mit "Swap *hBUF_1, *hBUF_2" einfach nur die beiden Argumente aber nicht die Buffer selbst. Nach außen passiert praktisch nix wenn du das ausführst.
Genau das ist der Sinn, nur die Zeiger zu vertauschen. Sollte ich evtl. anders benennen.
Aber wie gesagt, im Moment ist das ganze FrameWork noch hautsächlich eine Idee und ein Brainstorming und Teil eines anderen Projekts.

Der Vorteil eines Framworks wäre, dass man einheitliche und am Ende Top ausentwickelte Funktionen hat.
Bezogen auf das 3DDrawing Modul wäre das z.B. die Auslagerung der Color-Funktionen in das Color-Modul.
So wie das mit dem Assembler für die SSE Register optimiert ist, stelle ich mir das für ein FrameWork vor.

Jetzt mal noch ne Frage zur Color4-Struct!
Was ist der Vorteil, wenn man Float für RGBA-verwendet. Wenn das effektiver ist als mit Standard RGBA zu hantieren. Dann gehört, in
meinem Verständnis, das standardmäßig aufbereitet und wäre dann Teil des FramWorks. Unabhängig davon, wie das 3Ddrawing entwickelt wird.
Wie gesagt ich bin noch nicht 100% fit auf PB und stell vielleicht manchmal noch Fragen, die hier längst geklärt sind.
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von STARGÅTE »

SMaag hat geschrieben: 29.11.2022 20:21 Ich hab etwas rumprobiert, und man kann in PB eben egal wie man es anstellt nur 1 Modul mit UseModule einbinden.
Hä? Geht doch:

Code: Alles auswählen

DeclareModule M1
	#C1 = 1
EndDeclareModule
Module M1
EndModule

DeclareModule M2
	#C2 = 2
EndDeclareModule
Module M2
EndModule

UseModule M1
UseModule M2

Debug #C1
Debug #C2
SMaag hat geschrieben: 29.11.2022 20:21
Module_BUFFER.pb
In der Prozedur SwapBuffers() vertauschst du mit "Swap *hBUF_1, *hBUF_2" einfach nur die beiden Argumente aber nicht die Buffer selbst. Nach außen passiert praktisch nix wenn du das ausführst.
Genau das ist der Sinn, nur die Zeiger zu vertauschen. Sollte ich evtl. anders benennen.
Nein, du missverstehst da was. Du übergibst an SwapBuffers() zwei Integer-Werte (Adressen) und diese Werte werden lokal in der Prozedur vertausch. Es passiert nichts mit den Variablen (Adressen) außerhalb.

Code: Alles auswählen

Procedure SwapPointer(*Address1, *Address2)
	Swap *Address1, *Address2
EndProcedure

Define *Buffer1 = 123
Define *Buffer2 = 456
SwapPointer(*Buffer1, *Buffer2)
Debug *Buffer1
Debug *Buffer2
Was du (vielleicht) vorhast wäre sowas hier:

Code: Alles auswählen

Procedure SwapPointer(*Address1.Integer, *Address2.Integer)
	Swap *Address1\i, *Address2\i
EndProcedure

Define *Buffer1 = 123
Define *Buffer2 = 456
SwapPointer(@*Buffer1, @*Buffer2)
Debug *Buffer1
Debug *Buffer2
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
SMaag
Beiträge: 150
Registriert: 08.05.2022 12:58

Re: Drawing3D - Draw-Befehle für 3D-Szenen

Beitrag von SMaag »

@STARGATE
erst mal danke für den Tipp mit dem Swap! Hätt ich wahrscheinlich wieder ewig gesucht.

Hab mit SSE rumprobiert und versucht die SSE-ASM Befehler noch in ein Macro zu verpacken.
War ziemlich wirr, bis das funktioiniert hat. Bringt aber nochmal richtig Speed.
In Procedure : Faktor 5 gegenüber der classic Version
in Macro : Faktor >8 gegenüber der classic Version

hier der Link zum Forum Thread
viewtopic.php?p=363318#p363318
Antworten