NewsForumsCodeLogsGallerySpecsSearch

Code archives/3D Graphics - Maths/Gravity

This code has been declared by its author to be Public Domain code.

Download source code

Gravity by Krischan2015
A simple 3D demo of gravitation in minib3d. Two bodies with different masses affect each other using Newton's law of universal gravitation formula which is F=G*((M1*M2)/rē). Includes a single surface path visualization using quads to see the objects gravitation influence.



In this demo I've used the mass of our sun for the star and the mass of our planet. You can interact with some F-keys and you can use the mouse to rotate and zoom the scene:

F1 = Star's mass multiplied by factor 10
F2 = Planet's mass multiplied by factor 100.000
F3 = new random Planet vector
Arrow keys = change mass of star / planet

In the source, you can play around with the "correction" Constant and different movement speeds in the mxp/myp/mzp variables to get different results.

For understanding the mechanics behind this demo here is a simplified version of it:
SuperStrict

Framework sidesign.minib3d

Graphics3D DesktopWidth(), DesktopHeight(), 32, 1

SeedRnd MilliSecs()

' center mouse
MoveMouse GraphicsWidth() * 0.4, GraphicsHeight() * 0.6



' ------------------------------------------------------------------------------------------------
' Constants
' ------------------------------------------------------------------------------------------------
Const Starmass:Double = 1.9884 * 10 ^ 30
Const PlanetMass:Double = 5.974 * 10 ^ 24
Const g:Double = 6.674 * 10 ^ -11
Const correction:Double = 10 ^ 21

' basic movespeed of star
Global mxs:Double = 0.0
Global mys:Double = 0.0
Global mzs:Double = 0.0

' basic movespeed of planet
Global mxp:Double = 0.0
Global myp:Double = 0.0
Global mzp:Double = 0.1153



' ------------------------------------------------------------------------------------------------
' Variables
' ------------------------------------------------------------------------------------------------
Local vx1:Double
Local vx2:Double
Local vy1:Double
Local vy2:Double
Local vz1:Double
Local vz2:Double

Local massfactor_s:Float = 1.0
Local massfactor_p:Float = 1.0



' ------------------------------------------------------------------------------------------------
' Light
' ------------------------------------------------------------------------------------------------
CreateLight(2)
AmbientLight 32, 32, 32



' ------------------------------------------------------------------------------------------------
' Star
' ------------------------------------------------------------------------------------------------
Local star:TEntity = CreatePivot()
Local star0:TSprite = CreateSprite(star)
Local star1:TSprite = CreateSprite(star)
Local star2:TSprite = CreateSprite(star)
Local star3:TSprite = CreateSprite(star)
ScaleSprite star0, 1, 1
ScaleSprite star1, 2, 2
ScaleSprite star2, 4, 4
ScaleSprite star3, 8, 8
EntityColor star0, 255, 255, 255
EntityColor star1, 255, 192, 128
EntityColor star2, 255, 255, 224
EntityColor star3, 255, 255, 224
EntityAlpha star0, 1
EntityAlpha star1, 1
EntityAlpha star2, 0.75
EntityAlpha star3, 0.5
EntityFX star0, 1
EntityFX star1, 1
EntityFX star2, 1
EntityFX star3, 1
EntityBlend star0, 3
EntityBlend star1, 3
EntityBlend star2, 3
EntityBlend star3, 3
EntityOrder star0, -1
EntityOrder star1, -2
EntityOrder star2, -3
EntityOrder star3, -4
Local startex:TTexture = CreateSunTexture()
EntityTexture star0, startex
EntityTexture star1, startex
EntityTexture star2, startex
EntityTexture star3, startex



' ------------------------------------------------------------------------------------------------
' Planet
' ------------------------------------------------------------------------------------------------
Local planet:TMesh = CreateSphere(32)
EntityFX planet, 2
UpdateMesh(planet, 255, 128, 0)
PositionEntity planet, -25, 0, 0
ScaleEntity planet, 0.5, 0.5, 0.5



' ------------------------------------------------------------------------------------------------
' Camera
' ------------------------------------------------------------------------------------------------
Local campivot:TPivot = CreatePivot(star)
Local cam:TCamera = CreateCamera(campivot)
PositionEntity cam, 0, 0, -40
CameraRange cam, 0.1, 10000



' ------------------------------------------------------------------------------------------------
' Star Ecliptic
' ------------------------------------------------------------------------------------------------
Local ecliptic:TEntity = CreateCube(star)
EntityFX ecliptic, 1 + 16
EntityAlpha ecliptic, 0.25
EntityColor ecliptic, 0, 0, 255
ScaleEntity ecliptic, 50, 10 ^ -10, 50
Local raster:TTexture = CreateRasterTexture()
EntityTexture ecliptic, raster
ScaleTexture raster, 1.0 / 50, 1.0 / 50
PositionTexture raster, 0.5, 0.5
EntityBlend ecliptic, 3



' ------------------------------------------------------------------------------------------------
' Path
' ------------------------------------------------------------------------------------------------
Global path:TMesh = CreateMesh()
Global surf:TSurface = CreateSurface(path)
EntityFX path, 1 + 2



' ------------------------------------------------------------------------------------------------
' Main loop
' ------------------------------------------------------------------------------------------------
While Not AppTerminate()

	If KeyHit(KEY_ESCAPE) Then End
	
	If KeyHit(KEY_F1) Then massfactor_s = 10.0
	If KeyHit(KEY_F2) Then massfactor_p = 100000.0
	
	If KeyHit(KEY_F3) Then
	
		mxp = Rnd(-0.1, 0.1)
		myp = Rnd(-0.1, 0.1)
		mzp = Rnd(-0.1, 0.1)
		
		For Local P:TQuad = EachIn TQuad.List
	
			P.Remove
		
		Next
		
		FreeEntity path
		path = CreateMesh()
		surf = CreateSurface(path)
		EntityFX path, 1 + 2

	EndIf
		
	
	massfactor_s:+((KeyDown(KEY_UP) - KeyDown(KEY_DOWN)) / 100.0)
	massfactor_p:+((KeyDown(KEY_RIGHT) - KeyDown(KEY_LEFT)) * 1000.0)
	
	' calc distance
	Local d:Double = EntityDistance(planet, star)
	
	' calc gravitational force using newtons formula
	Local F:Double = (g * starmass * massfactor_s * planetmass * massfactor_p) / (d * d)
	
	' adjust force to scene
	F:/correction
	
	' get coordinates of objects
	Local x1:Double = EntityX(star)
	Local x2:Double = EntityX(planet)
	Local y1:Double = EntityY(star)
	Local y2:Double = EntityY(planet)
	Local z1:Double = EntityZ(star)
	Local z2:Double = EntityZ(planet)
		
	' delta position
	Local dx:Double = x1 - x2
	Local dy:Double = y1 - y2
	Local dz:Double = z1 - z2
	
	' delta vector
	Local dv1:Double = F / (starmass * massfactor_s)
	Local dv2:Double = F / (planetmass * massfactor_p)
	
	' new vector
	vx1 = vx1 - dv1 * dx
	vx2 = vx2 + dv2 * dx
	vy1 = vy1 - dv1 * dy
	vy2 = vy2 + dv2 * dy
	vz1 = vz1 - dv1 * dz
	vz2 = vz2 + dv2 * dz
					
	' move star
	MoveEntity star, mxs + vx1, mys + vy1, mzs + vz1
	
	' move planet
	MoveEntity planet, mxp + vx2, myp + vy2, mzp + vz2
	
	' camera movement
	If EntityDistance(cam, star) > 10 Then TranslateEntity cam, 0, 0, MouseDown(1) - MouseDown(2) Else TranslateEntity cam, 0, 0, -1
	RotateEntity campivot, Normalize(MouseY(), 0, GraphicsHeight() - 1, -90, 90), Normalize(MouseX(), 0, GraphicsWidth() - 1, 180, -180), 0
	PointEntity cam, campivot
		
	' add star path quads
	Local P:TQuad
	P = New TQuad
	P.x = EntityX(star)
	P.y = EntityY(star)
	P.z = EntityZ(star)
	P.scalex = 0.05
	P.scaley = 0.05
	P.RGB = [255, 255, 0]
	P.mesh = path
	P.surf = surf
	P.add()
	
	' add planet path quads
	P = New TQuad
	P.x = EntityX(planet)
	P.y = EntityY(planet)
	P.z = EntityZ(planet)
	P.scalex = 0.05
	P.scaley = 0.05
	P.RGB = [255, 128, 0]
	P.mesh = path
	P.surf = surf
	P.add()
	
	' face all path quads to cam
	For P:TQuad = EachIn TQuad.List
	
		P.Update(cam)
	
	Next
			
	RenderWorld
	
	' 2D output
	BeginMax2D()
	
		DrawText "Distance..........: " + d, 0, 0
		DrawText "Force.............: " + F, 0, 15
		DrawText "Force Star........: " + dv1, 0, 30
		DrawText "Force Planet......: " + dv2, 0, 45
		DrawText "Move X............: " + vx2, 0, 60
		DrawText "Move Y............: " + vy2, 0, 75
		DrawText "Star Mass Factor..: " + massfactor_s, 0, 90
		DrawText "Planet Mass Factor: " + massfactor_p, 0, 105

	EndMax2D()
	
	Flip

Wend

End



' ------------------------------------------------------------------------------------------------
' Normalize value
' ------------------------------------------------------------------------------------------------
Function Normalize:Float(value:Float = 128.0, value_min:Float = 0.0, value_max:Float = 255.0, norm_min:Float = 0.0, norm_max:Float = 1.0, limit:Int = False)

	' normalize	
	Local result:Float=((value-value_min)/(value_max-value_min))*(norm_max-norm_min)+norm_min

	' limit	
	If value>norm_max Then value=norm_max Else If value<norm_min Then value=norm_min

	Return result
	
End Function



' ------------------------------------------------------------------------------------------------
' Create Raster Texture
' ------------------------------------------------------------------------------------------------
Function CreateRasterTexture:TTexture()
	
	Local tex:TTexture = CreateTexture(64, 64, 1)
	
	BeginMax2D()
	Cls
	SetColor 64, 64, 64
	DrawRect 0, 0, 63, 63
	
	SetColor 255, 255, 255
	DrawLine 0, 0, 63, 0
	DrawLine 0, 0, 0, 63
	DrawLine 0, 63, 63, 63
	DrawLine 63, 63, 63, 0
	
	EndMax2D()

	BackBufferToTex(tex, 0)
	
	Return tex

End Function



' ------------------------------------------------------------------------------------------------
' Create Sun Texture
' ------------------------------------------------------------------------------------------------
Function CreateSunTexture:TTexture()

	Local pixmap:TPixmap = CreatePixmap(256, 256, PF_RGBA8888)
	
	Local i:Float, j:Int, col:Int, rgb:Int
	
	For j = 0 To 255
		
		col=255-j
		If col > 255 Then col = 255
		rgb=col*$1000000+col*$10000+col*$100+col
		
		For i=0 To 360 Step 0.1
			
			WritePixel(pixmap, 128 + (Sin(i) * j * 0.5), 128 + (Cos(i) * j * 0.5), rgb)
			
		Next
		
	Next
	
	Local tex:TTexture = LoadTexturePixmap(pixmap, 2)
	
	Return tex

End Function



' ------------------------------------------------------------------------------------------------
' Colorize mesh vertex colors
' ------------------------------------------------------------------------------------------------
Function UpdateMesh(mesh:TMesh, r:Int = 255, g:Int = 255, b:Int = 255, a:Float = 1.0)
	
	Local surf:TSurface = GetSurface(mesh, 1)
		
	For Local v:Int = 0 To CountVertices(surf) - 1
	
		VertexColor surf, v, r, g, b, a
		
	Next
	
End Function



' ------------------------------------------------------------------------------------------------
' Quad Type Library
' ------------------------------------------------------------------------------------------------
Type TQuad

	Field x:Float = 0.0										' position x
	Field y:Float = 0.0										' position y
	Field z:Float = 0.0										' position z
	
	Field scalex:Float = 1.0								' current size X
	Field scaley:Float = 1.0								' current size Y
	
	Field RGB:Int[] = [255, 255, 255, 255]					' star vertex color
	Field Alpha:Float = 1.0									' vertex alpha

	Field v:Int = 0											' vertex counter
	Field mesh:TMesh = Null									' mesh pointer
	Field surf:TSurface = Null								' surface pointer
				
	Global List:TList = CreateList()



	' --------------------------------------------------------------------------------------------
	' METHOD: Create new Object in TList
	' --------------------------------------------------------------------------------------------
	Method New()

		ListAddLast(List, Self)

	End Method

	
	
	' --------------------------------------------------------------------------------------------
	' METHOD: Remove Object in TList
	' --------------------------------------------------------------------------------------------
	Method Remove()

		ListRemove(List, Self)
		

	End Method

	' --------------------------------------------------------------------------------------------
	' METHOD: Add new Quad
	' --------------------------------------------------------------------------------------------
	Method Add(col:Int = 0, row:Int = 0)

		' surface setup
		If surf = Null Then surf = surf
		If v + 4 > 32768 Then
			v = 0
			surf = CreateSurface(mesh)
		EndIf

		' add Vertices
		Local V0:Int = AddVertex(surf, 0, 0, 0, 1, 0)
		Local V1:Int = AddVertex(surf, 0, 0, 0, 1, 1)
		Local V2:Int = AddVertex(surf, 0, 0, 0, 0, 1)
		Local V3:Int = AddVertex(surf, 0, 0, 0, 0, 0)

		' color vertices
		VertexColor surf, V0, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, V1, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, V2, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, V3, RGB[0], RGB[1], RGB[2], Alpha

		' connect triangles
		AddTriangle surf, V0, V1, V2
		AddTriangle surf, V0, V2, V3
		
		VertexTexCoords surf, V0, col + 1, row
		VertexTexCoords surf, V1, col + 1, row + 1
		VertexTexCoords surf, V2, col, row + 1
		VertexTexCoords surf, V3, col, row

		' increase vertex counter
		If v >= 4 Then v = V0 + 4 Else v = V0

	End Method

	' --------------------------------------------------------------------------------------------
	' METHOD: Update a Quad
	' --------------------------------------------------------------------------------------------
	Method Update(target:TEntity)
	
		TFormVector scalex, 0, 0, target, Null
		Local X1:Float = TFormedX()
		Local Y1:Float = TFormedY()
		Local Z1:Float = TFormedZ()
    
		TFormVector 0, scaley, 0, target, Null
		Local X2:Float = TFormedX()
		Local Y2:Float = TFormedY()
		Local Z2:Float = TFormedZ()
		
		' set vertices
		VertexCoords surf, v + 0, x - x1 - x2, y - y1 - y2, z - z1 - z2
		VertexCoords surf, v + 1, x - x1 + x2, y - y1 + y2, z - z1 + z2
		VertexCoords surf, v + 2, x + x1 + x2, y + y1 + y2, z + z1 + z2
		VertexCoords surf, v + 3, x + x1 - x2, y + y1 - y2, z + z1 - z2
	
		' set colors
		VertexColor surf, v + 0, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, v + 1, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, v + 2, RGB[0], RGB[1], RGB[2], Alpha
		VertexColor surf, v + 3, RGB[0], RGB[1], RGB[2], Alpha
						
	End Method

End Type



' ----------------------------------------------------------------------------
' Load a pixmap to a brush
' ----------------------------------------------------------------------------
Function LoadBrushPixmap:TBrush(pixmapin:TPixmap,flags:Int=1,u_scale:Float=1.0,v_scale:Float=1.0)

	Return PixTBrush.LoadBrushPixmap(pixmapin,flags,u_scale,v_scale)
	
End Function



' ----------------------------------------------------------------------------
' Load a pixmap to a texture
' ----------------------------------------------------------------------------
Function LoadTexturePixmap:TTexture(pixmapin:TPixmap,flags:Int=1)

	Return PixTTexture.LoadTexturePixmap(pixmapin,flags)
	
End Function

Type PixTBrush Extends TBrush

	Function LoadBrushPixmap:TBrush(pixmapin:TPixmap,flags:Int=1,u_scale:Float=1.0,v_scale:Float=1.0)
	
		Local brush:TBrush=New TBrush
		
		brush.tex[0]=PixTTexture.LoadTexturePixmap:TTexture(pixmapin,flags)
		brush.no_texs=1
		
		brush.tex[0].u_scale#=u_scale#
		brush.tex[0].v_scale#=v_scale#
				
		Return brush
		
	End Function
	
End Type

Type PixTTexture Extends TTexture

	Function LoadTexturePixMap:TTexture(pixmapin:TPixmap,flags:Int=1,tex:TTexture=Null)
	
		Return LoadAnimTexturePixMap:TTexture(pixmapin,flags,0,0,0,1,tex)
		
	End Function

	Function LoadAnimTexturePixMap:TTexture(pixmapin:TPixmap,flags:Int,frame_width:Int,frame_height:Int,first_frame:Int,frame_count:Int,tex:TTexture=Null)
	
		Local pixmapFileName:String="pixmap"+MilliSecs()+Rnd()
		
		If flags&128 Then Return LoadCubeMapTexture(pixmapFileName$,flags,tex)
	
		If tex = Null Then tex:TTexture = New TTexture
		
		tex.file:String=pixmapFileName
		tex.file_abs:String=pixmapFileName
		
		' set tex.flags before TexInList
		tex.flags=flags
		tex.FilterFlags()
		
		' check to see if texture with same properties exists already, if so return existing texture
		Local old_tex:TTexture
		old_tex=tex.TexInList()
		If old_tex<>Null And old_tex<>tex
			Return old_tex
		Else
			If old_tex<>tex
				ListAddLast(tex_list,tex)
			EndIf
		EndIf
	
		' load pixmap
		tex.pixmap = CopyPixmap(pixmapin)
		
		' check to see if pixmap contain alpha layer, set alpha_present to true if so (do this before converting)
		Local alpha_present:Int=False
		If tex.pixmap.format=PF_RGBA8888 Or tex.pixmap.format=PF_BGRA8888 Or tex.pixmap.format=PF_A8 Then alpha_present=True
	
		' convert pixmap to appropriate format
		If tex.pixmap.format<>PF_RGBA8888
			tex.pixmap=tex.pixmap.Convert(PF_RGBA8888)
		EndIf
		
		' if alpha flag is true and pixmap doesn't contain alpha info, apply alpha based on color values
		If tex.flags&2 And alpha_present=False
			tex.pixmap=ApplyAlpha(tex.pixmap)
		EndIf		
	
		' if mask flag is true, mask pixmap
		If tex.flags&4
			tex.pixmap=MaskPixmap(tex.pixmap,0,0,0)
		EndIf
		
		' ---
		
		' if tex not anim tex, get frame width and height
		If frame_width=0 And frame_height=0
			frame_width=tex.pixmap.width
			frame_height=tex.pixmap.height
		EndIf
	
		' ---
		
		tex.no_frames=frame_count
		tex.gltex=tex.gltex[..tex.no_frames]
	
		' ---
		
		' pixmap -> tex
	
		Local xframes:Int=tex.pixmap.width/frame_width
		Local yframes:Int=tex.pixmap.height/frame_height
			
		Local startx:Int=first_frame Mod xframes
		Local starty:Int=(first_frame/yframes) Mod yframes
			
		Local x:Int=startx
		Local y:Int=starty
	
		Local pixmap:TPixmap
	
		For Local i:Int=0 To tex.no_frames-1
	
			' get static pixmap window. when resize pixmap is called new pixmap will be returned.
			pixmap=tex.pixmap.Window(x*frame_width,y*frame_height,frame_width,frame_height)
			x=x+1
			If x>=xframes
				x=0
				y=y+1
			EndIf
		
			' ---
		
			pixmap=AdjustPixmap(pixmap)
			tex.width=pixmap.width
			tex.height=pixmap.height
			Local width:Int=pixmap.width
			Local height:Int=pixmap.height
	
			Local name:Int
			glGenTextures 1,Varptr name
			glBindtexture GL_TEXTURE_2D,name
	
			Local mipmap:Int
			If tex.flags&8 Then mipmap=True
			Local mip_level:Int=0
			Repeat
				glPixelStorei GL_UNPACK_ROW_LENGTH,pixmap.pitch/BytesPerPixel[pixmap.format]
				glTexImage2D GL_TEXTURE_2D,mip_level,GL_RGBA8,width,height,0,GL_RGBA,GL_UNSIGNED_BYTE,pixmap.pixels
				If Not mipmap Then Exit
				If width=1 And height=1 Exit
				If width>1 width:/2
				If height>1 height:/2
	
				pixmap=ResizePixmap(pixmap,width,height)
				mip_level:+1
			Forever
			tex.no_mipmaps=mip_level
	
			tex.gltex[i]=name
	
		Next
				
		Return tex
		
	End Function
	
End Type

Comments

None.

Code Archives Forum