MiniB3d for FreeBasic

External libraries (GTK, GSL, SDL, Allegro, OpenGL, etc) questions.
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: MiniB3d for FreeBasic

Postby ITomi » Jul 10, 2018 15:54

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: 37
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Postby Haubitze » Sep 29, 2018 12:20

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: 7835
Joined: May 28, 2005 3:28

Re: MiniB3d for FreeBasic

Postby D.J.Peters » Dec 22, 2018 10:41

@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: 37
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Postby Haubitze » May 10, 2019 16:34

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: 1535
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Postby angros47 » May 11, 2019 18:13

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: 37
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Postby Haubitze » May 12, 2019 15:14

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: 1535
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Postby angros47 » May 12, 2019 18:35

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: 37
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Postby Haubitze » May 25, 2019 9:25

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: 1535
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Postby angros47 » Jun 04, 2019 15:47

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: 37
Joined: May 20, 2016 8:42

Re: MiniB3d for FreeBasic

Postby Haubitze » Jun 04, 2019 21:27

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: 35
Joined: Mar 08, 2016 19:10

Re: MiniB3d for FreeBasic

Postby Gunslinger » Aug 15, 2019 10:26

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/ScreenshotOpenB3Dshadow02.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: 1535
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Postby angros47 » Aug 15, 2019 17:48

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: 35
Joined: Mar 08, 2016 19:10

Re: MiniB3d for FreeBasic

Postby Gunslinger » Aug 15, 2019 22:00

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.
https://www.freebasic.net/forum/viewtopic.php?f=14&t=27233&p=255789&hilit=openb3d#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: 1535
Joined: Jun 21, 2005 19:04

Re: MiniB3d for FreeBasic

Postby angros47 » Aug 15, 2019 22:27

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: 35
Joined: Mar 08, 2016 19:10

Re: MiniB3d for FreeBasic

Postby Gunslinger » Aug 17, 2019 23:04

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.

Return to “Libraries”

Who is online

Users browsing this forum: No registered users and 2 guests