MiniB3d for FreeBasic

Headers, Bindings, Libraries for use with FreeBASIC, Please include example of use to help ensure they are tested and usable.
Post Reply
ITomi
Posts: 154
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: MiniB3d for FreeBasic

Post by ITomi »

Hello!

I have a little problem. I would like build up a 3D world on the basis of a 2D map. Everything OK, all trees, enemies are visible - except the player's weapon.
Here is my code:

Code: Select all

dim as ubyte w,h,value,x,z
    select case which
    case 1
        restore level1
    end select
    read w
    read h
    x=1 : z=1
    for i as ubyte=1 to h
        for j as ubyte=1 to w
            read value
            select case value
            (...)
            case 3 'player
                positionentity camera,x*xspace,entityy#(camera),z*zspace '[b]!!![/b]
                weapon=createsprite(camera)
                scalesprite weapon,0.2,0.2
                entitytexture weapon,weapontex(0)
                positionentity weapon,entityx#(camera),entityy#(camera)-0.6,entityz#(camera)+1.1
If I remove the marked line with three exclamation marks, the weapon become visible at last, but in this case I can't place it, because its coordinates at 0,0,0, but I would like place it an other place. The camera already exists; I did it outside of that subprogram.
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Post by Haubitze »

hey there,

i have an problem with my CubeSphere. if i generate it from scratch it looks okay but if i cenerate it fom an own "cubemap" texture it is
craked. can anyone help me to fix that please?
i stole the code to generate the sphere from Krischan from the BB3D forum. but he only uses textures on it and dont modify the
vertex positions.

my texture looks this
Image
and the generator is this

Code: Select all

Function LoadCubeSphere(filename As String, scale As Single=0.25,mode As Integer = 0) As Any Ptr'only supports bmp
	

    Dim As Integer filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

    '' open BMP file
    filenum = FreeFile()
    If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL

        '' retrieve BMP dimensions
        Get #filenum, 19, bmpwidth
        Get #filenum, 23, bmpheight

    Close #filenum

    '' create image with BMP dimensions
    img = ImageCreate( Abs(bmpwidth), Abs(bmpheight) )

    If img = NULL Then Return NULL

    '' load BMP file into image buffer
    If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL

	Dim segments As Integer=(Abs(bmpwidth)-1)
	'If segments>16 Then segments=16
	Dim As Integer s
	Dim As Integer x,y
	Dim As single vx, vy, vz
	Dim As single magnitude 
	Dim As single  vertx, verty, vertz
	Dim As integer vertex
	
	Dim As Any Ptr mesh = CreateMesh()
	Dim As Any Ptr surf
	Dim As Single u,v
	
	For s = 1 To 6
		
		surf = CreateSurface(mesh)
		
		For y = 0 To segments
		
			For x = 0 To segments
				
				Select Case s
				
					Case 1:
							vx = x - segments / 2
							vy = segments / 2
							vz = segments / 2 - y

					Case 2:
							vx = x - segments / 2
							vy = segments / 2 - y
							vz = -segments / 2
							
					Case 3:
							vx = x - segments / 2
							vy = -segments / 2
							vz = y - segments / 2
							
					Case 4:
							vx = -segments / 2
							vy = segments / 2 - y
							vz = segments / 2 - x
							
					Case 5:
							vx = segments / 2
							vy = segments / 2 - y
							vz = x - segments / 2
							
					Case 6:
							vx = segments / 2 - x
							vy = segments / 2 - y
							vz = segments / 2
							
				End Select
				
				If mode = 0 Then
				
					magnitude = Sqr(vx * vx + vy * vy + vz * vz)
					vertx = vx / magnitude
					verty = vy / magnitude
					vertz = vz / magnitude
					
				Else
				
					vx = vx / segments * 2
					vy = vy / segments * 2
					vz = vz / segments * 2
					
					vertx = vx * Sqr(1.0 - (vy * vy) / 2.0 - (vz * vz) / 2.0 + ((vy * vy) * (vz * vz) / 3.0))
					verty = vy * Sqr(1.0 - (vz * vz) / 2.0 - (vx * vx) / 2.0 + ((vz * vz) * (vx * vx) / 3.0))
					vertz = vz * Sqr(1.0 - (vx * vx) / 2.0 - (vy * vy) / 2.0 + ((vx * vx) * (vy * vy) / 3.0))
					
				EndIf
				
				u=(x * 1.0 / segments)/2.0
				v=(y * 1.0 / segments)/3.0
				Dim h As Single
				If s=1 Then 
					vertz+=vertz*((Point((0.5+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.5+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					vertx+=vertx*((Point((0.5+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf
				If s=3 Then 
					vertz+=vertz*((Point((0.0+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.0+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					vertx+=vertx*((Point((0.0+u)*bmpwidth,	((2.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf

				If s=2 Then 
					vertz+=vertz*((Point((0.5+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.5+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale '-z
					vertx+=vertx*((Point((0.5+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf

				If s=6 Then 
					vertz+=vertz*((Point((0.0+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.0+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					vertx+=vertx*((Point((0.0+u)*bmpwidth,	((1.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf

				If s=4 Then 
					vertz+=vertz*((Point((0.0+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.0+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					vertx+=vertx*((Point((0.0+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf

				If s=5 Then 
					vertz+=vertz*((Point((0.5+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					verty+=verty*((Point((0.5+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
					vertx+=vertx*((Point((0.5+u)*bmpwidth,	((0.0/3.0)+v)*bmpheight,img) And &hff)/256)*scale	'-z
				EndIf
				If s=4 Then vertextexcoords(surf,vertex,	0.0+u,	(0.0/3.0)+v)'-x
				If s=5 Then vertextexcoords(surf,vertex,	0.5+u,	(0.0/3.0)+v)'+x
				
				vertex = AddVertex(surf, vertx, verty, vertz, x * 1.0 / segments, y * 1.0 / segments)
				VertexNormal(surf,vertex,vertX,vertY,vertZ)
'todo fix the texture mapping 
				u=(x * 1.0 / segments)/2.0
				v=(y * 1.0 / segments)/3.0
				If s=1 Then vertextexcoords(surf,vertex,	0.5+u,	(2.0/3.0)+v)'-z
				If s=3 Then vertextexcoords(surf,vertex,	0.0+u,	(2.0/3.0)+v)'+z
				'
				If s=2 Then vertextexcoords(surf,vertex,	0.5+u,	(1.0/3.0)+v)'-y
				If s=6 Then vertextexcoords(surf,vertex,	0.0+u,	(1.0/3.0)+v)'+y
				'
				If s=4 Then vertextexcoords(surf,vertex,	0.0+u,	(0.0/3.0)+v)'-x
				If s=5 Then vertextexcoords(surf,vertex,	0.5+u,	(0.0/3.0)+v)'+x
				
			Next
			
		Next
		
		For y = 0 To segments - 1
		
			For x = 0 To segments - 1
			
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + 1, y * (segments + 1) + x + segments + 2)
				
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + segments + 2, y * (segments + 1) + x + segments + 1)
				
			Next
			
		Next
		
	Next
	ImageDestroy img
	Return mesh
	
End Function
use it like so

Code: Select all

#Include once "fbgfx.bi"
#Include Once "crt.bi"
#Include Once "crt/math.bi"
#Include Once "crt/limits.bi"
#Include Once "gl\gl.bi"
#Include Once "gl\glu.bi"
#Include Once "gl\glext.bi"
#Include "inc/Openb3d.bi"
#Define Render_OpenGL




Using FB

ScreenRes( scrW, scrH, 32,2 , GFX_ALPHA_PRIMITIVES Or GFX_OPENGL Or GFX_MULTISAMPLE)
Graphics3D scrW, scrH, 32

Var cam=createcamera(0)
CameraViewport(cam,0,0,scrW, scrH)
CameraRange(cam,0.01,10000)
CameraClsColor(cam,16,16,32)

Var cubes = LoadCubeSphere(exepath + "/data/cubemap.bmp",0.1,1)



Var lights = CreateLight(1,cam)
LightColor(lights,128,128,255)
ambientLight(32,32,32)
positionentity lights,10,-10,-1

Var tex=LoadTexture( exepath + "/data/cubemap.bmp" ) 
entitytexture cubes,tex
entityfx cubes,2

	PositionEntity(cubes,0,0,3)

LightRange(lights,10000)


dim angle as single
Do
	GetMouse mx,my,,mb
	rotateentity cubes,0,angle,0
	angle+=0.5
	UpdateWorld
	RenderWorld
	ScreenSync
	Flip
loop until ( MultiKey( fb.sc_escape ))
salute
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: MiniB3d for FreeBasic

Post by D.J.Peters »

@angros47

in ShadowObject::Update(Camera* Cam) you overwrite the current cls mode of the camera but never restore the old mode.

That means the user of the lib must update the cls mode for all active cameras every frame !

As a small fix you can declare (for internal use only) in "camera.h"

Code: Select all

void CameraGetClsMode(int &color,int &zbuffer);
and add in "camera.cpp"

Code: Select all

void Camera::CameraGetClsMode(int &color,int &zbuffer){
  color=cls_color;
  zbuffer=cls_zbuffer;
}
and use it in shaddow.cpp

Code: Select all

void ShadowObject::Update(Camera* Cam){
  vector<Light*>::iterator it;
  // !!! save current cls mode
  int old_cls_color;
  int old_cls_zbuffer;
  Cam->CameraGetClsMode(old_cls_color, old_cls_zbuffer);

  for(it=Light::light_list.begin();it!=Light::light_list.end();++it){
    Light* Light=*it;
    if (Light->hide==true || Light->cast_shadow==false)
      continue;

    light_x = Light->EntityX(true) * (1 + parallel * 1);
    light_y = Light->EntityY(true) * (1 + parallel * 1);
    light_z = Light->EntityZ(true) * (1 + parallel * 1);
    // overwrite cls mode
    Cam->CameraClsMode(false,false);
    Cam->Update();

    list<ShadowObject*>::iterator it2;
    for(it2=shadow_list.begin();it2!=shadow_list.end();it2++){
      ShadowObject* S=*it2;
      if (S->Parent->hide==false && Light->EntityDistance(S->Parent) < 1/Light->range) {
        VolumeLength = (Cam->range_far - S->Parent->EntityDistance(Cam)) / (S->Parent->EntityDistance(Light) + abs(S->Parent->cull_radius));
       S->ShadowMesh->reset_bounds = true;
       S->ShadowMesh->GetBounds();
       S->UpdateCaster();
       S->Render = true;
      } else {
       S->Render = false;
       }
    }
    // overwrite cls mode again why ?
    Cam->CameraClsMode(false,false);
    ShadowRenderWorldZFail();
  }
  // !!! how ever on end restore the cls mode
  Cam->CameraClsMode(old_cls_color, old_cls_zbuffer);
}
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Post by Haubitze »

i made a function to create a spherized Cube. i hope anyone find it usefull.
only problem i cant solve is the texturemapping so you have to solve it by your own :/

Code: Select all

' ----------------------------------------------------------------------------
' Creates a spherized Cube
' ----------------------------------------------------------------------------
Function CreateCubeSphere(segments As Integer = 16, mode As Integer = 0) As Any ptr
	If segments>255 Then segments=255
	If segments<1 Then segments=1
	Dim As Integer s
	Dim As Integer x,y
	Dim As single vx, vy, vz
	Dim As single magnitude
	Dim As single  vertx, verty, vertz
	Dim As integer vertex

	Dim As Any Ptr mesh = CreateMesh()
	Dim As Any Ptr surf
	Dim As Single u,v

	For s = 1 To 6
		surf = CreateSurface(mesh)
		For y = 0 To segments
			For x = 0 To segments
				Select Case s
					Case 1:
						vx = x - segments / 2
						vy = segments / 2
						vz = segments / 2 - y
					Case 2:
						vx = x - segments / 2
						vy = segments / 2 - y
						vz = -segments / 2
					Case 3:
						vx = x - segments / 2
						vy = -segments / 2
						vz = y - segments / 2
					Case 4:
						vx = -segments / 2
						vy = segments / 2 - y
						vz = segments / 2 - x
					Case 5:
						vx = segments / 2
						vy = segments / 2 - y
						vz = x - segments / 2
					Case 6:
						vx = segments / 2 - x
						vy = segments / 2 - y
						vz = segments / 2
				End Select

				If mode = 0 Then
					magnitude = Sqr(vx * vx + vy * vy + vz * vz)
					If magnitude<0.000001 Then magnitude=1'0.000001

					vertx = vx / magnitude
					verty = vy / magnitude
					vertz = vz / magnitude
				Else
					vx = vx / segments * 2
					vy = vy / segments * 2
					vz = vz / segments * 2

					vertx = vx * Sqr(1.0 - (vy * vy) / 2.0 - (vz * vz) / 2.0 + ((vy * vy) * (vz * vz) / 3.0))
					verty = vy * Sqr(1.0 - (vz * vz) / 2.0 - (vx * vx) / 2.0 + ((vz * vz) * (vx * vx) / 3.0))
					vertz = vz * Sqr(1.0 - (vx * vx) / 2.0 - (vy * vy) / 2.0 + ((vx * vx) * (vy * vy) / 3.0))
				EndIf
				vertex = AddVertex(surf, vertx, verty, vertz, x * 1.0 / segments, y * 1.0 / segments)
				VertexNormal(surf,vertex,vertX,vertY,vertZ)
				'todo fix the texture mapping
				u=(x * 1.0 / segments)'/2.0
				v=(y * 1.0 / segments)'/3.0
				
				If u>1 Then u-=1.0
				If v>1 Then v-=1.0
				If u<0 Then u+=1.0
				If v<0 Then v+=1.0
				
				vertextexcoords(surf,vertex,	u,	v)
				'If s=1 Then vertextexcoords(surf,vertex,	0.5+u,	(2.0/3.0)+v)'-y
				'If s=3 Then vertextexcoords(surf,vertex,	0.0+u,	(2.0/3.0)+v)'+y
				''
				'If s=6 Then vertextexcoords(surf,vertex,	0.5+u,	(1.0/3.0)+v)'-z
				'If s=2 Then vertextexcoords(surf,vertex,	0.0+u,	(1.0/3.0)+v)'+z
				''
				'If s=4 Then vertextexcoords(surf,vertex,	0.0+u,	(0.0/3.0)+v)'-x
				'If s=5 Then vertextexcoords(surf,vertex,	0.5+u,	(0.0/3.0)+v)'+x
			Next
		Next

		For y = 0 To segments - 1
			For x = 0 To segments - 1
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + 1, y * (segments + 1) + x + segments + 2)
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + segments + 2, y * (segments + 1) + x + segments + 1)
			Next
		Next
	Next
	Return mesh
End Function
salute
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Post by angros47 »

Nicely done!

Actually, to texture a cube sphere, you would need 6 different textures, one for each face, or you can "pack" them into a single texture, in a cube map (either a cross-shaped picture, or a "strip" made of 6 square textures). If you use separate textures, you can then apply each one to each face using PaintSurface. Otherwise, you have to decide how faces will be packed in the strip, and you will have to map the UV coordinates according to that.
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Post by Haubitze »

hi angros47,

i have a question about your 2d fbgfx patch for opengl.
if you know i use OpenB3D, i also use sGUI from Muttonhead and i have patched the sGUI to work with the old 2d.bi.
the last version of sGUI uses now 32 bit images mostly all cleared to rgba(0,0,0,0) and then painted with sGUI stuff.
if i try your patch in manual sync mode i only get the 3D scene, if i use automatic sync mode i only get the sGUI on the screen.

i use FB 1.06.0 32bit and 64bit, can you tell me eventualy what i make wrong or if the patch does not working with OpenB3D?

thanks and salute


Edit: here the new code for the spheroized cube, now with texturecoordinates.

Code: Select all

' ----------------------------------------------------------------------------
' Creates a spherized Cube
' ----------------------------------------------------------------------------
Function CreateCubeSphere(segments As Integer = 16, mode As Integer = 0,texture_mode as Integer = 1) As Any ptr
	If segments>255 Then segments=255
	If segments<1 Then segments=1
	If mode<0 Then mode=0
	If mode>1 Then mode=1
	If texture_mode<0 Then texture_mode=0
	If texture_mode>1 Then texture_mode=1
   
	Dim As Integer s
	Dim As Integer x,y
	Dim As single vx, vy, vz
	Dim As single magnitude
	Dim As single  vertx, verty, vertz
	Dim As integer vertex

	Dim As Any Ptr mesh = CreateMesh()
	Dim As Any Ptr surf
	Dim As Single u,v

	For s = 1 To 6
		surf = CreateSurface(mesh)
		For y = 0 To segments
			For x = 0 To segments
				Select Case s
					Case 1:
						vx = x - segments / 2
						vy = segments / 2
						vz = segments / 2 - y
					Case 2:
						vx = x - segments / 2
						vy = segments / 2 - y
						vz = -segments / 2
					Case 3:
						vx = x - segments / 2
						vy = -segments / 2
						vz = y - segments / 2
					Case 4:
						vx = -segments / 2
						vy = segments / 2 - y
						vz = segments / 2 - x
					Case 5:
						vx = segments / 2
						vy = segments / 2 - y
						vz = x - segments / 2
					Case 6:
						vx = segments / 2 - x
						vy = segments / 2 - y
						vz = segments / 2
				End Select

				If mode = 0 Then
					magnitude = Sqr(vx * vx + vy * vy + vz * vz)
					If magnitude<0.000001 Then magnitude=0.000001

					vertx = vx / magnitude
					verty = vy / magnitude
					vertz = vz / magnitude
				Else
					vx = vx / segments * 2
					vy = vy / segments * 2
					vz = vz / segments * 2

					vertx = vx * Sqr(1.0 - (vy * vy) / 2.0 - (vz * vz) / 2.0 + ((vy * vy) * (vz * vz) / 3.0))
					verty = vy * Sqr(1.0 - (vz * vz) / 2.0 - (vx * vx) / 2.0 + ((vz * vz) * (vx * vx) / 3.0))
					vertz = vz * Sqr(1.0 - (vx * vx) / 2.0 - (vy * vy) / 2.0 + ((vx * vx) * (vy * vy) / 3.0))
				EndIf
				vertex = AddVertex(surf, vertx, verty, vertz, x * 1.0 / segments, y * 1.0 / segments)
				VertexNormal(surf,vertex,vertX,vertY,vertZ)
            
            if texture_mode=0 then
				'todo fix the texture mapping
				u=(x * 1.0 / segments)/2.0
				v=(y * 1.0 / segments)/3.0
				
				If u>1 Then u-=1.0
				If v>1 Then v-=1.0
				If u<0 Then u+=1.0
				If v<0 Then v+=1.0
				
				If s=5 Then vertextexcoords(surf,vertex,	0.5+u,	(2.0/3.0)+v)'right
				If s=4 Then vertextexcoords(surf,vertex,	0.0+u,	(2.0/3.0)+v)'left
				''
				If s=6 Then vertextexcoords(surf,vertex,	0.5+u,	(0.0/3.0)+v)'back
				If s=2 Then vertextexcoords(surf,vertex,	0.0+u,	(0.0/3.0)+v)'front
            
				If s=3 Then vertextexcoords(surf,vertex,	0.5+u,	(1.0/3.0)+v)'down
				If s=1 Then vertextexcoords(surf,vertex,	0.0+u,	(1.0/3.0)+v)'up
            
            elseif texture_mode=1 then
				u=(x * 1.0 / segments)/6.0
				v=(y * 1.0 / segments)
 				If s=5 Then vertextexcoords(surf,vertex,	(5.0/6.0)+u,	v)'right
				If s=4 Then vertextexcoords(surf,vertex,	(4.0/6.0)+u,	v)'left
				''
				If s=6 Then vertextexcoords(surf,vertex,	(1.0/6.0)+u,	v)'back
				If s=2 Then vertextexcoords(surf,vertex,	(0.0/6.0)+u,	v)'front
            
				If s=3 Then vertextexcoords(surf,vertex,	(3.0/6.0)+u,	v)'down
				If s=1 Then vertextexcoords(surf,vertex,	(2.0/6.0)+u,	v)'up
              
            endif
				''
			Next
		Next

		For y = 0 To segments - 1
			For x = 0 To segments - 1
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + 1, y * (segments + 1) + x + segments + 2)
				AddTriangle(surf, y * (segments + 1) + x, y * (segments + 1) + x + segments + 2, y * (segments + 1) + x + segments + 1)
			Next
		Next
	Next
	Return mesh
End Function
it supports 2 cubemap variants like the following ones.
Image
Image
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Post by angros47 »

Hard to tell where is the issue without a code example. By the way, with OpenB3D you must use manual sync mode. Also, try removing the RenderWorld command and using only the Flip command to see if the 2d screen appears, in that case
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Post by Haubitze »

hello angros47,

now a demo for my problem with the internal 2d renderer for opengl,

Code: Select all

#Include once "fbgfx.bi"
#Include Once "crt.bi"
#Include Once "crt/math.bi"
#Include Once "math.bi"
#Include Once "crt/limits.bi"
#Include Once "gl\gl.bi"
#Include Once "gl\glu.bi"
#Include Once "gl\glext.bi"
#Include "inc/Openb3d.bi"
#Include "inc/ob3dplus.bi"

'#Define Render_OpenGL
'#Include Once "inc/2d.bi"

'this is the new sGUI with the window drawing stuff ( i patched for 2d.bi, so a bit puts are now use ALPHA instead of TRANS )
#Include Once "Inc/sGUI/sGUI/sGUI.bas"
#include once "Inc/sGUI/sGUI/Window.bas"
#include once "Inc/sGUI/sGUI/Window_CloseButton.bas"
#include once "Inc/sGUI/sGUI/SimpleToggle.bas"

Using FB
Using sGUI

Const as integer scrW = 1366, scrH = 768

ScreenControl SET_GL_2D_MODE ,OGL_2D_MANUAL_SYNC
'screencontrol SET_GL_2D_MODE ,OGL_2D_AUTO_SYNC
'screencontrol SET_GL_SCALE,1
ScreenRes scrW, scrH, 32,2,GFX_OPENGL or GFX_MULTISAMPLE or GFX_ALPHA_PRIMITIVES
Randomize timer

InitGUI()
MinimumClearance        =4'fat frame
SelectBrightnessValue   =30'slightly brighter when selected, try a minus sign.
Colors.AlphaValue       =224'global alpha value used in sGUI
Colors.Cleaning         =&H00000000 'the window clear color here set to complete 0 for transparense
'    Colors.BackGround       =&HF0F0F0
'
'    Colors.WinFrame         =&HAFAFAF
'    Colors.WinTitle         =&H0
'    Colors.WinFrameSelected =&HF7630C
'    Colors.WinTitleSelected =&HFFFFFF
'    Colors.WinBackGround    =Colors.BackGround
'
'    Colors.GadText          =&H0
'    Colors.GadTextSelected  =&HFFFF88
'    Colors.GadBody          =&HEAEAEA
'    Colors.GadFrame         =&HACACAC
'    Colors.GadBodyGlow      =&HE4F0FC
'    Colors.GadFrameGlow     =&H3399FF
'    Colors.GadSleepGrid     =&H444444

Graphics3D scrW, scrH, 32
WindowTitle("OpenB3D and sGUI demo")


'LoadProportionalFont("Ubuntu\Ubuntu-R\Ubuntu-R.bmp")
'LoadFixedFont("Ubuntu\UbuntuMono-R\UbuntuMono-R.bmp")




Dim as sGUIWindow ptr winA,winB,winC
Dim As Gadget Ptr cb
winA=AddWindow(0,10,10,400,400,"winA",WFLAG_WINDOWTYPE2 or WFLAG_DRAGABLE Or WFLAG_CLOSEABLE )
winB=AddWindow(winA,10,80,100,50,"winB",WFLAG_WINDOWTYPE2 or WFLAG_DRAGABLE)
winC=AddWindow(WinA,120,80,100,50,"winC",WFLAG_WINDOWTYPE2 or WFLAG_DRAGABLE)
ShowWindow(winA)
ShowWindow(winB)
ShowWindow(winC)

Dim as IMAGE ptr img_s,img_a,img_b,img_c
img_s=EnableUserGFX(0)'Rootwindow / Screen selbst
img_a=EnableUserGFX(winA)
img_b=EnableUserGFX(winB)
img_c=EnableUserGFX(winC)
winA->Caption="hello"

dim as Gadget ptr simpleA,toggleA,simpleB,toggleB',dragA',CloseA
simpleA=AddSimpleGadget(0,10,10,70,30,"simpleA")
simpleB=AddSimpleGadget(winA,10,10,70,30,"simpleB")
toggleA=AddToggleGadget(0,100,10,70,30,1,"toggleA")
toggleB=AddToggleGadget(winA,100,10,70,30,1,"toggleB")
GadgetOn(simpleA)
GadgetOn(simpleB)
GadgetOn(toggleA)
GadgetSleep(toggleB)'example SleepMode

'Draw stuff to the Windows
'it goes all to the RootWindow, it is first cleared by &H00000000 (full transparent black)
draw string img_s,(10,10),"RootWindow or Screen",&HFFFFFFff
circle img_a,(200,200),100,&HFFff0000,,,,f
Draw String img_b,(10,10),";)",&HFF00FF00
paint img_c,(1,1),&Hff000000
draw string img_c,(10,10),"Blaa",&Hff12FF00



Var cam=createcamera(0)
CameraViewport(cam,0,0,scrW, scrH)
CameraRange(cam,0.01,10000)
CameraClsColor(cam,16,16,32)

Var lights = CreateLight(1,cam)
LightColor(lights,128,128,255)
ambientLight(16,16,16)
positionentity lights,10,-10,-10

LightRange(lights,10000)


Var cubes0 = CreateCube(0)


positionentity(cubes0,0,0,5.5)

EntityShininess(cubes0,0.05)

Do

	positionentity lights,-100,-100,-100
	pointentity lights,cubes0

	If multikey(SC_W) then
		turnentity cubes0,-1,0,0
	EndIf
	If multikey(SC_S) then
		turnentity cubes0,1,0,0
	EndIf
	If multikey(SC_A) then
		turnentity cubes0,0,-1,0
	EndIf
	If multikey(SC_D) then
		turnentity cubes0,0,1,0
	EndIf

	UpdateWorld
	RenderWorld
	MasterControlProgram 'render the new sGUI Windows

	Draw String(8,24),"Hello ",&Hffffffff ' draw another stuf to the screen
	
   Flip
	'screensync
	Sleep 1


loop until SCREENCLOSEBUTTON Or ( MultiKey( fb.sc_escape )) ' Or (event->EXITEVENT )'' loop until esc is pressed or x pressed

ClearWorld
End
in this case i only see the cube but nothing of the sGUI or FBGFX stuff.
if i comment RenderWorld out i get a black screen.
so i hope you can tell me what a make wrong.

if i use 2d.bi and syncscreen all is okay.
salute
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Post by angros47 »

I can't test your demo, since I have no sGUI installed.
By the way, here is a demo:

Code: Select all

#include "openb3d.bi"
#include once "GL/gl.bi"

Common Shared glBindBuffer As Sub(ByVal target As GLenum, ByVal buffer As GLuint)



screencontrol 150,1

screen 18,  32, , &h10002 
glBindBuffer = ScreenGLProc("glBindBuffer")
'ambientlight 255,255,255

	
Graphics3d 640,480,32,1,1
color ,rgba(0,0,0,0)
cls
?"hello"
circle (100,100),80,rgb(255,255,0),,,,f


var camera=createcamera(0)
'cameraclscolor camera,0,255,0

var cube=createcube
ambientlight 255,255,255

scaleentity cube,.5,.5,.5
rotateentity cube,0,90,0

positionentity cube,0,0,2


setanimtime cube,1

do
	turnentity cube,.1,.2,.1
	updateworld 
	renderworld
	sleep 1

	glColor4f(1.0, 1.0, 1.0, 1.0)
	glDisable(GL_CULL_FACE)
	glDisable(GL_NORMALIZE)
	glActiveTexture(GL_TEXTURE0)
	glClientActiveTexture(GL_TEXTURE0)
	glDisable(GL_DEPTH_TEST)
	glBindBuffer(GL_ARRAY_BUFFER,0)
	glEnable(GL_BLEND)
	glEnable(GL_ALPHA_TEST)
	glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)


flip
	glEnableClientState(GL_NORMAL_ARRAY)



loop until multikey(1)
To be able to use the 2d mode, basically, one has to disable the buffers using glBindBuffer: when it uses buffers, OpenB3D doesn't unbind them at the end of the rendering, since it would only slow down the rendering itself, and there is no need for it, unless one wants a buffer with no binding: and FreeBasic doesn't use binding, to ensure compatibility with older versions of OpenGL. So, you need to unbind them manually
Haubitze
Posts: 44
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Post by Haubitze »

thanks angros47, your sample code works with little changes. now i can see sGUI with the intern OpenGL renderer :)
nice side effect now i have ~75 fps, before with 2d.bi only ~30-40 fps :)

By the way nice work to convert OpenB3D to FreeBASIC.
so thx and salute.
Gunslinger
Posts: 103
Joined: Mar 08, 2016 19:10
Location: The Netherlands

Re: MiniB3d for FreeBasic

Post by Gunslinger »

I can use some help with this.
After some days testing demos en reading on openB3D i got to like it.
Now i'm making some basic things with shadows and got some problems.
Very sure it normal whats happening.
Can someone tell me why and how to prevent it?

Some kind of overlapping shadows that invert the shading effect.
http://ac1.servegame.com:88/image/Scree ... adow02.PNG image

Code: Select all

#include "openb3d.bi"

Screenres(800,600,32,,&h10002)
Graphics3d(800,600,32,1)

var Camera = CreateCamera(0)
	CameraClsColor camera,0,0,0
	CameraFogRange camera,100,400
	CameraProjMode camera,1
	MoveEntity Camera, 40,40,0

var Light2=CreateLight(2)
	positionEntity Light2,-10,10,30
	LightRange light2, 500
	LightColor light2, 255,255,255
'	AmbientLight 100,100,100

var plane = CreatePlane()
	TranslateEntity plane,0,-10,0
	EntityFX plane, 0
	EntityColor(plane,127,127,127)
	PointEntity camera,plane

var Sphere = CreateSphere(32) 
	ScaleEntity Sphere,1,1,1
	EntityColor(Sphere,255,255,255)
	EntityFX Sphere, 0
	EntityShininess(Sphere,0.5)
	
For i as ubyte = 1 To 25
	var cube = CreateCube()
	PositionEntity cube,(-.5+Rnd)*100,rnd*2,(-.5+Rnd)*100
	EntityColor cube, 0,255*rnd,255
	EntityFX cube, 0
	ScaleEntity cube,rnd*5,rnd*5,rnd*5
	var shadow = CreateShadow(cube)

	var cylinder = CreateCylinder()
	PositionEntity cylinder,(-.5+Rnd)*100,0,(-.5+Rnd)*100
	EntityFX cylinder, 0
	var shadow1 = CreateShadow(cylinder)
Next


dim key as string
dim as single i,xx,yy

do
   key=inkey()
   if key=chr(255)+"H" then TurnEntity(Camera,1,0,0,0)
   if key=chr(255)+"P" then TurnEntity(Camera,-1,0,0,0)
   if key=chr(255)+"M" then TurnEntity(Camera,0,-1,0,0)
   if key=chr(255)+"K" then TurnEntity(Camera,0,1,0,0)
   if key="a" then MoveEntity(Camera,0,0,1)
   if key="z" then MoveEntity(Camera,0,0,-1)
   i=i+.01: xx=(sin(i))*30: yy=(cos(i))*10
   PositionEntity light2,xx,20,yy

  UpdateWorld()
  Renderworld

   PositionEntity Sphere,xx,23,yy
   PointEntity camera,Sphere
   flip:  sleep 1

loop until key=chr(27)
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Post by angros47 »

That bug is caused by an issue in capping of the volumetric shadow (it is one of the known downsides of the Z-fail algorithm used: shadows must be capped, or that effect will happen). Normally, OpenB3D should take care of building and capping the volumetric shadows automatically, but sometimes it miscalculates the length of the shadow, so the capping ends outside of the camera range. (I know this explanation is not clear, but to understand what is happening you should read a tutorial about the Z-Fail stencil shadow, it can't be explained shortly).

By the way, it's possible to tweak OpenB3D and force it to use a shorter volumetric shadow, by increasing the mesh cull radius.

In the example, adding:

Code: Select all

meshcullradius cube,10
meshcullradius cylinder,10
in the FOR...NEXT loop that creates all the meshes should fix the issue
Gunslinger
Posts: 103
Joined: Mar 08, 2016 19:10
Location: The Netherlands

Re: MiniB3d for FreeBasic

Post by Gunslinger »

Thanks angros47 for your quick replay. your trick worked for now.

I'm new to openGL and openB3D.
Hoop you still working on it? Because a lot of things can be added.(Like terrain functions)
Also it make 3d rendering in freebasic easy to do, just whats needed.

I just ran into a problem with the different openB3D.bi files.
D.J.Peters made a OOP still of version 1.25.
viewtopic.php?f=14&t=27233&p=255789&hil ... 3d#p255789

With his libOpenB3D i got a error on

Code: Select all

plane=CopyEntity(plane)
error 180: Invalid assignment/conversion in 'plane=CopyEntity(plane)'

And your version 1.25 of works fine.
I do like the OOP Still from Peters.
Can you fix it ? :)
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Post by angros47 »

Terrain functions (CreateTerrain, and LoadTerrain) are already available.

Your error seems to depend on wrong type assignment, you must check the declare of CopyEntity, and the line when you wrote DIM plane
Gunslinger
Posts: 103
Joined: Mar 08, 2016 19:10
Location: The Netherlands

Re: MiniB3d for FreeBasic

Post by Gunslinger »

Oke forget the last error.

I have loaded some terrain yes.
Next step for me is to cast some sunlight on it for the right look.
That is where i get stuck.
Not lucky with shaders and to complicated me for now.

I placed a directional light on top of the camera position.
Seems the best sunlight effect only problem is the light range still has less effect in distance.
So have to set very high and i'm not sure that a good performance idea.

I do miss good examples en help files for openB3D.
Post Reply