"Another" 3d engine Xors3D (abandoned)

jepalza · Post by **jepalza** » Apr 12, 2020 9:03

(note: using google translate from spanish)
This 3d engine has been abandoned for a long time. In the FB forum some thread has already been written about it, but everything has been abandoned and the links no longer work.
It is not a great library, but it does its job. I have rewritten calls to FB format from PB. I have not been able to try them all, it is something impossible to do, they are more than 1000 routines !!!!

But for a few examples it has enough to check its operation.

Original Files And Examples:
https://github.com/Guevara-chan/Xors3D-for-PB

Update April-22:
I have fixed many bugs in the "include" files and have included a few examples to see how they work.

Download:
https://drive.google.com/file/d/1KH3zrR ... sp=sharing

jepalza · Post by **jepalza** » Apr 12, 2020 9:07

Deleted. See first post

jepalza · Post by **jepalza** » Apr 12, 2020 9:08

Deleted. See first post

jepalza · Post by **jepalza** » Apr 12, 2020 9:09

Deleted. See first post

Dr_D · Post by **Dr_D** » Jun 06, 2020 20:41

Hi. I'm always interested in 3D engines. Do you happen to have a version of this in zip format?

ShawnLG · Post by **ShawnLG** » Jun 08, 2020 2:36

Dr_D wrote:Hi. I'm always interested in 3D engines.

You might like Genesis3D SDK. It is also abandonware. I remember playing the demo in the late 90s. It has that nastalgec Quake feel to it. The source is in C for version 1.2, so it can be translated to FB.

https://www.genesis3d.com/

jepalza · Post by **jepalza** » Apr 09, 2022 13:43

Dr_D wrote: ↑Jun 06, 2020 20:41 Hi. I'm always interested in 3D engines. Do you happen to have a version of this in zip format?

In Spain we say:
mas vale tarde que nunca!!
(Better late than never!!)

See First Post

antarman · Post by **antarman** » Apr 09, 2022 16:23

Thank you very much! Great work!

jepalza · Post by **jepalza** » Apr 09, 2022 20:19

antarman wrote: ↑Apr 09, 2022 16:23 Thank you very much! Great work!

Another Example, with "Physics". You need DLL "xPhysics.dll". Get it from original Github Files:
https://github.com/Guevara-chan/Xors3D- ... master/DLL

(sorry: missing "logo.jpg" from "textures". Get it from github!!)

Code

Code: Select all

#Include ".\include\Xors3d.bi"

' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
' Xors3D legacy sample: 'Physics'
' Original source from Xors3D Team (C)
' Converted in 2012 by Guevara-chan.
' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*


#Define impulse 50

Declare Function CurveValue(newvalue  As Single , oldvalue  As Single , increments As integer) As Single
Declare Sub ShootSphere(camera As Integer)
Declare Sub ResetWall()

xCreateLog()

' setup maximum supported AntiAlias Type
xSetAntiAliasType(xGetMaxAntiAlias())

' set application window caption
xAppTitle("Physics sample")

' initialize graphics mode
xGraphics3D(800, 600, 32,  FALSE ,  TRUE )

' hide mouse pointer
xHidePointer()

' enable antialiasing
xAntiAlias( True)

' create camera
Var camera = xCreateCamera()

' position camera
'xPositionEntity camera, 0, 60, -200
xPositionEntity(camera, 0, 20, -100)

' create ground
Var ground = xCreateCube()
xPointEntity(camera, ground)
xScaleEntity(ground, 100, 1, 100)
xEntityAddBoxShape(ground, 0.0)

' loading logo from file
Var logoTexture = xLoadTexture(".\media\textures\logo.jpg")

' texture cube
xEntityTexture(ground, logoTexture)

' create wall
 #Define wallSize 4
 Dim As Integer x,y,z
 Dim Shared As Integer wallBlocks( wallSize,  wallSize,  wallSize)
 For x = 0 To  wallSize
	For y = 0 To  wallSize
		For z = 0 To  wallSize
		  If x = 0 And y = 0 And z = 0 Then
				wallBlocks(x, y, z) = xCreateCube()
			Else
				wallBlocks(x, y, z) = xCopyEntity(wallBlocks(0, 0, 0))
			EndIf
			xPositionEntity(wallBlocks(x, y, z), (x -  wallSize / 2) * 2.0, 2 + y * 2.0, (z -  wallSize / 2) * 2.0)
			xEntityAddBoxShape(wallBlocks(x, y, z), 1.0)
			xEntityTexture(wallBlocks(x, y, z), logoTexture)
		Next
	Next
 Next

' for mouse look
xMoveMouse(xGraphicsWidth() / 2, xGraphicsHeight() / 2)
Var mousespeed         = 0.5 
Var camerasmoothness   = 4.5

' create light
Var light = xCreateLight()
xRotateEntity(light, 45, 0, 0)

' main program loop
Dim As Single camya, camxa, mxs, mys
Dim As integer fix_
While xKeyDown( KEY_ESCAPE)=FALSE 

	' camera control
	If xKeyDown( KEY_W)  Then  xMoveEntity(camera,  0,  0,  1)
	If xKeyDown( KEY_S)  Then  xMoveEntity(camera,  0,  0, -1)
	If xKeyDown( KEY_A)  Then  xMoveEntity(camera, -1,  0,  0)
	If xKeyDown( KEY_D)  Then  xMoveEntity(camera,  1,  0,  0)
	
	mxs   = CurveValue(xMouseXSpeed() * mousespeed, mxs, camerasmoothness)
	mys   = CurveValue(xMouseYSpeed() * mousespeed, mys, camerasmoothness)
	
	Fix_ = Int(mxs) Mod 360 + (mxs - Int(mxs))
	
	camxa   = camxa - fix_
	camya   = camya + mys
	
	If camya < -89  Then  camya = -89 
	If camya >  89  Then  camya =  89 
	
	xMoveMouse(xGraphicsWidth() / 2, xGraphicsHeight() / 2)
	xRotateEntity(camera, camya, camxa, 0.0)
	
	' shoot sphere
	If xMouseHit(1) Then ShootSphere(camera) 
	If xMouseHit(2) Then  
		xEntityApplyTorqueImpulse(wallBlocks(Rnd(1)*( wallSize), Rnd(1)*( wallSize), Rnd(1)*( wallSize)), 0.0, Rnd(1)*(100), 0.0) 
   EndIf
	
	' reset wall
	If xKeyHit( KEY_SPACE) Then ResetWall() 
	
	' render scene
	xUpdateWorld()
	xRenderWorld()
	
	' FPS & rendered triangles counters
	xText(10, 10, "FPS: " + Str(xGetFPS()))
	xText(10, 30, "TrisRendered: " + Str(xTrisRendered()))
	xText(10, 50, "Left mouse button to shoot, right mouse button to add torque for random cube, space to reset wall")
	
	' switch back buffer
	xFlip()
	
Wend

' function to reset cubes positions
sub  ResetWall()
	Dim As Integer x,y,z
	For x = 0 To  wallSize
		For y = 0 To  wallSize
			For z = 0 To  wallSize
				xPositionEntity(wallBlocks(x, y, z), (x - wallSize / 2) * 2.0, 2 + y * 2.0, (z -  wallSize / 2) * 2.0)
				xRotateEntity(wallBlocks(x, y, z), 0.0, 0.0, 0.0)
				xEntityReleaseForces(wallBlocks(x, y, z))
			Next
		Next
	Next
End Sub

' As Desconocido Procedure to shoot spher
Sub  ShootSphere(camera As Integer)
	Var sphere = xCreateSphere()
	xPositionEntity(sphere, xEntityX(camera,TRUE ), xEntityY(camera,TRUE ), xEntityZ(camera,TRUE ))
	xEntityColor(sphere, 255, 0, 0)
	xEntityAddSphereShape(sphere, 1.0, 1.0)
	xTFormNormal(0.0, 0.0, 1.0, camera, 0)
	xEntityApplyCentralImpulse(sphere, xTFormedX() * impulse, xTFormedY() * impulse, xTFormedZ() * impulse)
End Sub

' for camera mouse look
Function  CurveValue(newvalue As Single, oldvalue As Single, increments As Integer) As Single
	If increments >  1  Then  oldvalue   = oldvalue   - (oldvalue   - newvalue  ) / increments 
	If increments <= 1  Then  oldvalue   = newvalue   
	Return oldvalue   
End Function

antarman · Post by **antarman** » Apr 10, 2022 16:46

Excellent! Keep going!

antarman · Post by **antarman** » Apr 11, 2022 6:55

PerPixel Light.

Code: Select all

#Include ".\include\Xors3d.bi"

' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
' Xors3D shading sample: 'PerPixel Light'
' Original source from MoKa (Maxim Miheyev)
' Converted in 2012 by Guevara-chan.
' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*

Declare Sub UpdateInput()
Declare Sub UpdateCamera(ByVal Camera As Integer, ByVal ViewSensivity As Single, ByVal MoveSensivity As Single)

'====================================


'====================================
' Window
xGraphics3D(800,600,32,0,1)
xSetTextureFiltering(TF_ANISOTROPIC)
'====================================


'====================================
' Font
Dim As Integer Font
Font=xLoadFont("Tahoma",10)
xSetFont(Font)
'====================================


'====================================
' Varriables
Dim Shared As Integer mXSp,mYSp
Dim Shared As Integer IKdQ,IKdW,IKdE,IKdA,IKdS,IKdD
'====================================


'====================================
' Camera
Dim Shared As Integer gCamera
gCamera=xCreateCamera()
xCameraZoom(gCamera,0.8)
xCameraClsColor(gCamera,50,50,50)
xRotateEntity(gCamera,20,45,0)
xMoveEntity(gCamera,0,10,-100)
'====================================


'====================================
' LightSphere
Dim As Integer tLightSpr
tLightSpr=xCreateSphere(8)
xEntityFX(tLightSpr,1)
xPositionEntity(tLightSpr,30,30,30)
'====================================


'====================================
' Shader
Dim As Integer tShader
tShader=xLoadFXFile("Media\Materials\PerPixel Light.fx")
'====================================


'====================================
' Model
Dim As Integer tModel
tModel=xLoadMesh("Media\Extra media\Teapot.b3d")

Dim As Integer tTextureDiffuse
tTextureDiffuse=xLoadTexture("Media\Extra media\Rockwall_Diffuse.jpg")

xSetEntityEffect(tModel,tShader)
xSetEffectTechnique(tModel,"Directional")
xSetEffectMatrixSemantic(tModel,"MatWorldViewProj",WORLDVIEWPROJ)
xSetEffectMatrixSemantic(tModel,"MatWorld",WORLD)
'		Shader Varriables
xSetEffectVector(tModel,	"AmbientClr",0.25,0.3,0.35)
xSetEffectVector(tModel,	"LightClr",1,0.8,0.6)
xSetEffectFloat(tModel,		"LightInt",2)
xSetEffectFloat(tModel,		"RngLight",40)
xSetEffectTexture(tModel,	"tDiffuse",tTextureDiffuse)
'====================================



'====================================
' Main Cycle
xMoveMouse(400,300)

Do

	UpdateInput()
	UpdateCamera(gCamera,0.1,1)

	'====================================
	If xKeyHit(KEY_1) Then : xSetEffectTechnique(tModel,"Directional") : EndIf
	If xKeyHit(KEY_2) Then : xSetEffectTechnique(tModel,"Point") : EndIf
	If xKeyHit(KEY_3) Then : xSetEffectTechnique(tModel,"PointDistance") : EndIf

	xPositionEntity(tLightSpr,Sin(Timer()*0.5)*30,Abs(Sin(Timer()*0.6)*25)+5,Sin(Timer()*0.4)*30)
	'====================================

	If xKeyHit(KEY_ESCAPE) Then Exit Do

	xSetEffectVector(tModel,	"PosLight",xEntityX(tLightSpr),xEntityY(tLightSpr),xEntityZ(tLightSpr))
	xSetEffectFloat(tModel,		"DotLight",Sin(Timer()*0.4)*0.5+1.2)

	xRenderWorld()

	xText(10,10,"TrisRendered: "+Str(xTrisRendered()))
	xText(10,25,"FPS: "+Str(xGetFPS()))
	xText(10,580,"Press 1,2,3 to Change Light Type (Directional, Point, Point+Distance)")

	xFlip()
Loop
'====================================



'====================================
' Functions
Sub UpdateInput()
	xMoveMouse(400,300)
	mXSp=xMouseXSpeed() : mYSp=xMouseYSpeed()
	IKdQ=xKeyDown(KEY_Q) : IKdW=xKeyDown(KEY_W)
	IKdE=xKeyDown(KEY_E) : IKdA=xKeyDown(KEY_A)
	IKdS=xKeyDown(KEY_S) : IKdD=xKeyDown(KEY_D)
End Sub

Function SgnF(ByVal Value As Single) As Single ' Returns sign of value.
	If Value > 0 Then
		Return 1
	ElseIf Value < 0 Then
		Return -1
	EndIf
End Function

Sub UpdateCamera(ByVal Camera As Integer, ByVal ViewSensivity As Single, ByVal MoveSensivity As Single)
	Dim CamP As Single=xEntityPitch(gCamera)+mYSp*ViewSensivity
	If Abs(CamP)>80 Then : CamP=80*SgnF(CamP) : EndIf
	xTurnEntity(Camera,0,-mXSp*ViewSensivity,0)
	xRotateEntity(Camera,CamP,xEntityYaw(gCamera),0)
	xMoveEntity(Camera,(IKdD-IKdA)*MoveSensivity,(IKdE-IKdQ)*MoveSensivity,(IKdW-IKdS)*MoveSensivity)
End Sub
'====================================

antarman · Post by **antarman** » Apr 11, 2022 6:57

Water.

Code: Select all

' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
' Xors3D legacy sample: 'Water'
' Original source from Xors3D Team (C)
' Converted in 2012 by Guevara-chan.
' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*

#Include ".\include\Xors3d.bi"

Declare Function CurveValue(newvalue As Single, oldvalue As Single, increments As Integer) As Single
Declare Sub UpdateCubemap(tex As Integer, camera As Integer, entity As Integer, view_cam As Integer)

'initialization
xAppTitle("Water")
xGraphics3D(1366, 768, 32, FALSE, TRUE)
xCreateDSS(1024, 1024)
Dim Shared As Integer frame
frame = 0

'camera creating
Var cam = xCreateCamera()
xPositionEntity(cam, 0, 10, -50)
xRotateEntity(cam, 0, 180, 0)
xCameraClsColor(cam, 192, 192, 192)
Var cube_cam = xCreateCamera()
xHideEntity(cube_cam)
xCameraClsMode(cube_cam, FALSE, TRUE)
xCameraZoom(cube_cam, 0)

'enabling antialiasing
xAntiAlias(TRUE)

'objects loading
Var water = xLoadMesh("media/meshes/water.b3d")
xPositionEntity(water, 0, -5, -200)
Var scene = xLoadMesh("media/meshes/level.b3d")

'creating the light source
Var light = xCreateLight()
xRotateEntity(light, -45, 0, 0)

'loading the effect from file
Var waterFX = xLoadFXFile("media/shaders/water.fx")

'checking if this technique is supported by hardware
If xValidateEffectTechnique(waterFX, "Water") = FALSE Then
	Print("Runtime error: Technique does not supported!")
	xWaitKey
	End
EndIf

'loading the textures
Var texEnv = xCreateTexture(512, 512, 128 + 48)
Var noise  = xLoadTexture("media/textures/noise.dds", 1 + 512)

'setting the effect and constants
xSetEntityEffect(water, waterFX)
xSetEffectTechnique(water, "Water")
xSetEffectMatrixSemantic(water, "world_matrix", WORLD)
xSetEffectMatrixSemantic(water, "view_proj_matrix", VIEWPROJ)
xSetEffectTexture(water, "Noise_Tex", noise)
xSetEffectTexture(water, "envBox_Tex", texEnv)
Dim As Double startTime
startTime = Timer()
xAmbientLight(150, 150, 150)
xEntityAlpha(water, 0.9)

' for mouse look
xMoveMouse(xGraphicsWidth() / 2, xGraphicsHeight() / 2)
Dim As Single mousespeed,camerasmoothness,mxs,mys,camxa,camya,time_0_X
mousespeed       = 0.5
camerasmoothness = 4.5

While xKeyDown(1)=0

	' camera control
	If xKeyDown(KEY_W) Then : xMoveEntity(cam,  0,  0,  1): EndIf
	If xKeyDown(KEY_S) Then : xMoveEntity(cam,  0,  0, -1): EndIf
	If xKeyDown(KEY_A) Then : xMoveEntity(cam, -1,  0,  0): EndIf
	If xKeyDown(KEY_D) Then : xMoveEntity(cam,  1,  0,  0): EndIf
	mxs = CurveValue(xMouseXSpeed() * mousespeed, mxs, camerasmoothness)
	mys = CurveValue(xMouseYSpeed() * mousespeed, mys, camerasmoothness)
	Dim As Integer Fixx = Int(mxs) Mod 360 + (mxs - Int(mxs))
	camxa = camxa - Fixx
	camya = camya + mys
	If camya < -89 Then : camya = -89 : EndIf
	If camya >  89 Then : camya =  89 : EndIf
	xMoveMouse(xGraphicsWidth() / 2, xGraphicsHeight() / 2)
	xRotateEntity(cam, camya, camxa, 0.0)

	'if we can't see water then we won't update its texture
	If xEntityInView(water, cam) Then
		'updating the texture
		UpdateCubemap(texEnv, cube_cam, water, cam)
	EndIf

	'setting the constants
	time_0_X = (Timer() - startTime) / 10.0
	xSetEffectFloat(water, "time_0_X", time_0_X)
	xSetEffectFloat(water, "freq", Timer())
	xSetEffectVector(water, "view_position", xEntityX(cam, TRUE), 2, xEntityZ(cam, TRUE))

	'rendering the world
	xRenderWorld()

	'fps output
	xText(10, 10, "FPS: " + Str(xGetFPS()))
	xText(10, 30, "TrisRendered: " + Str(xTrisRendered()))

	'drawing the scene
	xFlip()

Wend

' for camera mouse look
Function CurveValue(newvalue As Single, oldvalue As Single, increments As Integer) As Single
	If increments >  1 Then : oldvalue = oldvalue - (oldvalue - newvalue) / increments : EndIf
	If increments <= 1 Then : oldvalue = newvalue : EndIf
	Return oldvalue
End Function

'function of texture updating
Sub UpdateCubemap(tex As Integer, camera As Integer, entity As Integer, view_cam As Integer)

	'turning the main camera off
	xHideEntity(view_cam)

	'getting size of the texture
	Var tex_sz = xTextureWidth(tex)

	'turning the camera on
	xShowEntity(camera)

	'hiding the object so it won't be rendered to the texture
	xHideEntity(entity)

	'moving camera to the position of the object
	xPositionEntity(camera, xEntityX(view_cam, TRUE), xEntityY(entity, TRUE) + 2, xEntityZ(view_cam, TRUE))
	frame = 1 - frame

	'rendering to the texture
	If frame Then
		'left plane
		xSetCubeFace(tex, 0)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, 0, 90, 0)
		xRenderWorld()

		'front plane
		xSetCubeFace(tex, 1)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, 0, 0, 0)
		xRenderWorld()

		'right plane
		xSetCubeFace(tex, 2)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, 0, -90, 0)
		xRenderWorld()
	Else
		'back plane
		xSetCubeFace(tex, 3)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, 0, 180, 0)
		xRenderWorld()

		'top plane
		xSetCubeFace(tex, 4)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, -90, 0, 0)
		xRenderWorld()

		'bottom plane
		xSetCubeFace(tex, 5)
		xSetBuffer(xTextureBuffer(tex))
		xCameraViewport(camera, 0, 0, tex_sz, tex_sz)
		xRotateEntity(camera, 90, 0, 0)
		xRenderWorld()
	EndIf
	'unhiding the object
	xShowEntity(entity)

	'turning the camera off
	xHideEntity(camera)

	'setting the render to backbuffer
	xSetBuffer(xBackBuffer())

	'turning the main camera on
	xShowEntity(view_cam)

End Sub

antarman · Post by **antarman** » Apr 11, 2022 6:57

Light + Bump Specular + FallOff

Code: Select all

' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
' Xors3D shading sample: 'Light + Bump Specular + FallOff'
' Original source from MoKa (Maxim Miheyev)
' Converted in 2012 by Guevara-chan.
' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*

#Include ".\include\Xors3d.bi"

Declare Sub UpdateInput()
Declare Sub UpdateCamera(Camera As Integer,ViewSensivity As Single,MoveSensivity As Single)
'====================================

'====================================
' Window
xGraphics3D(800,600,32,0,1)
xSetTextureFiltering(TF_ANISOTROPIC)
'====================================


'====================================
' *Font
Var Font=xLoadFont("Tahoma",10)
xSetFont(Font)
'====================================


'====================================
' Varriables
Dim Shared As Integer mXSp,mYSp
Dim Shared As Integer IKdQ,IKdW,IKdE,IKdA,IKdS,IKdD
'====================================


'====================================
' Camera
Dim Shared As Integer gCamera
gCamera=xCreateCamera()
xCameraZoom(gCamera,0.8)
xCameraClsColor(gCamera,50,50,50)
xRotateEntity(gCamera,20,45,0)
xMoveEntity(gCamera,0,10,-100)
'====================================


'====================================
' LightSphere
Var tLightSpr=xCreateSphere(8)
xEntityFX(tLightSpr,1)
xPositionEntity(tLightSpr,30,30,30)
'====================================


'====================================
' Shader
Var tShader=xLoadFXFile("Media\Materials\Bump Light + Bump Specular + FallOff.fx")
'====================================


'====================================
' Model
Var tModel=xLoadMesh("Media\Extra media\Teapot.b3d")

Var tTextureDiffuse=xLoadTexture("Media\Extra media\Rockwall_Diffuse.jpg")
Var tTextureSpecular=xLoadTexture("Media\Extra media\Rockwall_Specular.png")
Var tTextureNormal=xLoadTexture("Media\Extra media\Rockwall_Normal.png")

xSetEntityEffect(tModel,tShader)
xSetEffectTechnique(tModel,"Directional")
xSetEffectMatrixSemantic(tModel,"MatWorldViewProj",WORLDVIEWPROJ)
xSetEffectMatrixSemantic(tModel,"MatWorld",WORLD)
'		Shader Varriables
xSetEffectVector(tModel,	"AmbientClr",0.25,0.3,0.035)
xSetEffectVector(tModel,	"LightClr",1,0.8,0.06)
xSetEffectFloat(tModel,		"LightInt",1.5)
xSetEffectFloat(tModel,		"LightDot",2)
xSetEffectFloat(tModel,		"RngLight",100)
xSetEffectVector(tModel,	"FallOffClr",1,0.5,0.0)
xSetEffectFloat(tModel,		"FallOffInt",2)
xSetEffectFloat(tModel,		"FallOffSoft",2)
xSetEffectVector(tModel,	"SpecClr",1,0.8,0.6)
xSetEffectFloat(tModel,		"SpecInt",8)
xSetEffectFloat(tModel,		"SpecDot",2)
xSetEffectFloat(tModel,		"SpecRng",8)
xSetEffectTexture(tModel,	"tDiffuse",tTextureDiffuse)
xSetEffectTexture(tModel,	"tSpecular",tTextureSpecular)
xSetEffectTexture(tModel,	"tNormal",tTextureNormal)
'====================================



'====================================
' Main Cycle
xMoveMouse(400,300)

Do
	UpdateInput()
	UpdateCamera(gCamera,0.1,1)

	'====================================
	xTurnEntity(tModel,0,0.1,0)

	If xKeyHit(KEY_1) Then : xSetEffectTechnique(tModel,"Directional") : EndIf
	If xKeyHit(KEY_2) Then : xSetEffectTechnique(tModel,"Point") : EndIf
	If xKeyHit(KEY_3) Then : xSetEffectTechnique(tModel,"PointDistance") : EndIf

	xPositionEntity(tLightSpr,Sin(Timer*0.5)*30,Abs(Sin(Timer*0.4)*25)+5,Sin(Timer*0.5)*30)
	'====================================

	If xKeyHit(KEY_ESCAPE) Then : Exit Do : EndIf

	xSetEffectVector(tModel,	"PosLight",xEntityX(tLightSpr),xEntityY(tLightSpr),xEntityZ(tLightSpr))
	xSetEffectVector(tModel,	"PosCam",xEntityX(gCamera),xEntityY(gCamera),xEntityZ(gCamera))

	xRenderWorld()

	xText(10,10,"TrisRendered: "+Str(xTrisRendered()))
	xText(10,25,"FPS: "+Str(xGetFPS()))
	xText(10,580,"Press 1,2,3 to Change Light Type (Directional, Point, Point+Distance)")

	xFlip()
Loop
'====================================



'====================================
' Procedures
Sub UpdateInput()
	xMoveMouse(400,300)
	mXSp=xMouseXSpeed() : mYSp=xMouseYSpeed()
	IKdQ=xKeyDown(KEY_Q) : IKdW=xKeyDown(KEY_W)
	IKdE=xKeyDown(KEY_E) : IKdA=xKeyDown(KEY_A)
	IKdS=xKeyDown(KEY_S) : IKdD=xKeyDown(KEY_D)
End Sub

Function SgnF(Value As Single) As Single ' Returns sign of value.
	If Value > 0 Then
		Return 1
	ElseIf Value < 0 Then
		Return -1
	EndIf
End Function

Sub UpdateCamera(Camera As Integer,ViewSensivity As Single,MoveSensivity As Single)
	Dim CamP As Single=xEntityPitch(gCamera)+mYSp*ViewSensivity
	If Abs(CamP)>80 Then : CamP=80*SgnF(CamP) : EndIf
	xTurnEntity(Camera,0,-mXSp*ViewSensivity,0)
	xRotateEntity(Camera,CamP,xEntityYaw(gCamera),0)

	xMoveEntity(Camera,(IKdD-IKdA)*MoveSensivity,(IKdE-IKdQ)*MoveSensivity,(IKdW-IKdS)*MoveSensivity)
End Sub
'====================================

antarman · Post by **antarman** » Apr 11, 2022 6:59

Refraction.

Code: Select all

' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
' Xors3D shading sample: 'Refraction'
' Original source from MoKa (Maxim Miheyev)
' Converted in 2012 by Guevara-chan.
' *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*

#Include ".\include\Xors3d.bi"

Declare Sub UpdateInput()
Declare Sub UpdateCamera(Camera As Integer,ViewSensivity As Single,MoveSensivity As Single)
Declare Function mLoadSkyBox(d As String,t As String="jpg") As Integer
'====================================


'====================================
' Window
xGraphics3D(800,600,32,0,0)
xSetTextureFiltering(TF_ANISOTROPIC)
'====================================


'====================================
' Font
Var Font=xLoadFont("Tahoma",10)
xSetFont(Font)
'====================================


'====================================
' Varriables
Dim Shared As Integer mXSp,mYSp
Dim Shared As Integer IKdQ,IKdW,IKdE,IKdA,IKdS,IKdD
Dim Shared As Integer IKhF1,EffRefractionNM=TRUE
'====================================


'====================================
' Camera
Dim Shared As Integer gCamera
gCamera=xCreateCamera()
xCameraZoom(gCamera,0.8)
xCameraClsColor(gCamera,0,0,0)
xRotateEntity(gCamera,-20,45,0)
xMoveEntity(gCamera,0,10,-100)
xCameraRange(gCamera,1,6000)
'====================================


'====================================
' SkyBox
Dim Shared As Integer SkyBox
SkyBox=mLoadSkyBox("Media\Extra media\SkyBox\Sky1")
xPositionMesh(SkyBox,0,1,0)
xScaleEntity(SkyBox,3000,1500,3000)
'====================================


'====================================
' Shader
Var tShader=xLoadFXFile("Media\Materials\Refraction.fx")
'====================================


'====================================
' Model
Var tModel=xLoadMesh("Media\Extra media\HellKnight.b3d")
xUpdateNormals(tModel)

Var tTextureNormal=xLoadTexture("Media\Extra media\HellKnight_Normal.jpg")
Var tTextureScreen=xCreateTexture(256,192)

xSetEntityEffect(tModel,tShader)
xSetEffectTechnique(tModel,"RefractionNM")
xSetEffectMatrixSemantic(tModel,"MatWorldViewProj",WORLDVIEWPROJ)
xSetEffectMatrixSemantic(tModel,"MatWorld",WORLD)
'		Shader Varriables
xSetEffectTexture(tModel,	"tNormal",tTextureNormal)
xSetEffectTexture(tModel,	"tScreen",tTextureScreen)
xSetEffectFloat(tModel,		"FallOffInt",0.2)
xSetEffectVector(tModel,	"FallOffClr",0,0.6,0.8)
xSetEffectFloat(tModel,		"FallOffSoft",4)
xSetEffectFloat(tModel,		"Refract",0.1)
'====================================





'====================================
' Main Cycle
xMoveMouse(400,300)

Do

	UpdateInput()
	UpdateCamera(gCamera,0.1,1)
	xPositionEntity(SkyBox,xEntityX(gCamera),xEntityY(gCamera),xEntityZ(gCamera))

	'====================================
	xTurnEntity(tModel,0,0.2,0)

	If IKhF1 Then
		EffRefractionNM = EffRefractionNM Xor 1
		If EffRefractionNM Then
			xSetEffectTechnique(tModel,"RefractionNM")
		Else
			xSetEffectTechnique(tModel,"Refraction")
		EndIf
	EndIf
	'====================================

	If xKeyHit(KEY_ESCAPE) Then : Exit Do : EndIf

	'====================================
	' Render Refraction
	xHideEntity(tModel)
	xCameraViewport(gCamera,0,0,256,192)
	xSetBuffer(xTextureBuffer(tTextureScreen))
	xRenderWorld()
	xSetBuffer(xBackBuffer())
	xCameraViewport(gCamera,0,0,800,600)
	xShowEntity(tModel)
	'====================================
	' Setting Parameters
	xSetEffectVector(tModel,	"PosCamera",xEntityX(gCamera),xEntityY(gCamera),xEntityZ(gCamera))
	'====================================
	xRenderWorld()
	'====================================


	'====================================
	xText(10,10,"TrisRendered: "+Str(xTrisRendered()))
	xText(10,25,"FPS: "+Str(xGetFPS()))
	'====================================
	If EffRefractionNM Then
		xText(10,575,"Press F1 to Change Refraction Mode to Simple")
	Else
		xText(10,575,"Press F1 to Change Refraction Mode to Normal Mapped")
	EndIf
	'====================================
	xFlip()
Loop
'====================================






'====================================
' Functions
Sub UpdateInput()
	xMoveMouse(400,300)
	mXSp=xMouseXSpeed() : mYSp=xMouseYSpeed()
	IKdQ=xKeyDown(KEY_Q) : IKdW=xKeyDown(KEY_W)
	IKdE=xKeyDown(KEY_E) : IKdA=xKeyDown(KEY_A)
	IKdS=xKeyDown(KEY_S) : IKdD=xKeyDown(KEY_D)
	IKhF1=xKeyHit(KEY_F1)
End Sub

Function SgnF(Value As Single) As Single' Returns sign of value.
	If Value > 0 Then
		Return 1
	ElseIf Value < 0 Then
		Return -1
	EndIf
End Function

Sub UpdateCamera(Camera As Integer,ViewSensivity As Single,MoveSensivity As Single)
	Dim As Single CamP=xEntityPitch(gCamera)+mYSp*ViewSensivity
	If Abs(CamP)>80 Then : CamP=80*SgnF(CamP) : EndIf
	xTurnEntity(Camera,0,-mXSp*ViewSensivity,0)
	xRotateEntity(Camera,CamP,xEntityYaw(gCamera),0)
	xMoveEntity(Camera,(IKdD-IKdA)*MoveSensivity,(IKdE-IKdQ)*MoveSensivity,(IKdW-IKdS)*MoveSensivity)
End Sub

Function mLoadSkyBox(d As String,t As String="jpg") As Integer
	Dim As Integer Mesh,Brush,Texture,Surf,v0,v1,v2,v3

	Mesh=xCreateMesh()

	' Left
	'	If FileSize(d+"\"+"left."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"left."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf,-1, 1,-1,0,0)
	v1=xAddVertex(Surf,-1, 1, 1,1,0)
	v2=xAddVertex(Surf,-1,-1,-1,0,1)
	v3=xAddVertex(Surf,-1,-1, 1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf
	' Front
	'	If FileSize(d+"\"+"front."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"front."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf,-1, 1,1,0,0)
	v1=xAddVertex(Surf, 1, 1,1,1,0)
	v2=xAddVertex(Surf,-1,-1,1,0,1)
	v3=xAddVertex(Surf, 1,-1,1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf
	' Right
	'	If FileSize(d+"\"+"right."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"right."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf,1, 1, 1,0,0)
	v1=xAddVertex(Surf,1, 1,-1,1,0)
	v2=xAddVertex(Surf,1,-1, 1,0,1)
	v3=xAddVertex(Surf,1,-1,-1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf
	' Back
	'	If FileSize(d+"\"+"back."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"back."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf, 1, 1,-1,0,0)
	v1=xAddVertex(Surf,-1, 1,-1,1,0)
	v2=xAddVertex(Surf, 1,-1,-1,0,1)
	v3=xAddVertex(Surf,-1,-1,-1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf
	' Bottom
	'	If FileSize(d+"\"+"bottom."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"bottom."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf,-1,-1, 1,0,0)
	v1=xAddVertex(Surf, 1,-1, 1,1,0)
	v2=xAddVertex(Surf,-1,-1,-1,0,1)
	v3=xAddVertex(Surf, 1,-1,-1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf
	' Top
	'	If FileSize(d+"\"+"top."+t)=>0 Then
	Texture=xLoadTexture(d+"\"+"top."+t,49)
	Brush=xCreateBrush()
	xBrushTexture(Brush,Texture)
	Surf=xCreateSurface(Mesh,Brush)
	v0=xAddVertex(Surf,-1, 1, 1,0,0)
	v1=xAddVertex(Surf,-1, 1,-1,1,0)
	v2=xAddVertex(Surf, 1, 1, 1,0,1)
	v3=xAddVertex(Surf, 1, 1,-1,1,1)
	xAddTriangle(Surf,v2,v1,v0)
	xAddTriangle(Surf,v1,v2,v3)
	'	EndIf

	xEntityFX(Mesh,1+8)
	xFlipMesh(Mesh)
	xUpdateNormals(Mesh)

	Return Mesh
End Function
'====================================

antarman · Post by **antarman** » Apr 11, 2022 7:01

For work need download full archive with all media from https://github.com/Guevara-chan/Xors3D-for-PB

"Another" 3d engine Xors3D (abandoned)

"Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)

Re: "Another" 3d engine Xors3D (abandoned)