Short info about Basic4GL

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Short info about Basic4GL

Post by D.J.Peters »

Basic4GL comes closer to FreeBASIC with SUB's Function's and Pointers.
After i ported my soundlib and the ODE package to Basic4GL
Tom the author of Basic4GL added subs and functions here my test for stencil shadows.

Joshy
http://shiny3d.de/public/stencilshadow.exe
The speed is not bad for a virtual machine.

Basic4GL used "#" to declare function that will return a SINGLE value
"%" is the mod oparator and pointers are declared as '&'
the rest locks same as FreeBASIC.

Code: Select all

' stencil buffer shadows
' example of using functions and sub's and pointers
' use menu Basic4GL->Options...Advanced->Enabled Stencil buffer[x]

const MaxObjectsPerWorld=20
const MaxPointsPerObject=30
const MaxFacesPerObject =40 

type Plane_t
  a as single
  b as single
  c as single
  d as single
end type

type Face_t
  PointIndex(2) as integer
  Normale(2)    as single
  Neighbors(2)  as integer
  Plane         as Plane_t
  Visible       as integer
end type

type Object_t
  strType as String
  Position(2) as single
  Rotation(2) as single
  Size(2) as single 
  ColorRGBA(3) as single 
  nPoints as integer
  nFaces as integer
  Points(MaxPointsPerObject-1,2) as single
  Faces (MaxFacesPerObject -1) as Face_t
end type

type World_t
  nObjects as integer
  Objects(MaxObjectsPerWorld-1) as Object_t
end type

' prototypes
declare function GetInvers#(o as OBJECT_T,v() as single)()
declare sub      CastShadow(o as OBJECT_T,v() as single,IsLastObject as integer)
declare sub      InitObject(&o as OBJECT_T)
declare sub      BuildNormals(&o as OBJECT_T)
declare sub      BuildPlane(&o as OBJECT_T,&f as FACE_T)
declare sub      DrawObject(o as OBJECT_T)
declare Sub      DrawRoom()
declare sub      DrawLights()

LabelWorld3D:
' number of objects
data 12
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"
data "BOX3D"

LabelUnitBox3D:
' number of points
data 8
' front side
data -0.5, 0.5,0.5
data -0.5,-0.5,0.5
data  0.5,-0.5,0.5
data  0.5, 0.5,0.5
' back side
data  0.5, 0.5,-0.5
data  0.5,-0.5,-0.5
data -0.5,-0.5,-0.5
data -0.5, 0.5,-0.5

LabelBox3D:
' number of faces
data 12
' faces 
data 0,1,2 ' front
data 0,2,3 
data 3,2,5 ' right
data 3,5,4
data 4,5,6 ' back
data 4,6,7
data 7,6,1 ' left
data 7,1,0
data 7,0,3 ' top
data 7,3,4
data 1,6,5 ' bottom
data 1,5,2

LabelObjects3D:
' 3x3 raster with 9 boxes
data -4,-5,-20 ' object position
data  2, 2,  2 ' object size

data  0,-5,-20 ' ...
data  2, 2,  2 ' ...

data  4,-5,-20
data  2, 2,  2

data -4,-6,-15
data  2, 2,  2

data  0,-6,-15
data  2, 2,  2

data  4,-6,-15
data  2, 2,  2

data -4,-7,-10
data  2, 2,  2

data  0,-7,-10
data  2, 2,  2

data  4,-7,-10
data  2, 2,  2

' 3 boxes
data -5,-1,-20 ' box1 position
data 1,2,3 ' size

data 0,-1,-17 ' box2 position
data 5, 2,0.5 ' size

data 5,-1,-14 ' box3 position
data 2,2,2 ' size

const camz#=20

dim World     as World_t
dim &pObject  as OBJECT_T
dim &pFace    as Face_t
dim Point(2)  as single
dim Vector(3) as single
' counters object, points, faces, lights
dim oc as integer
dim pc as integer
dim fc as integer
dim lc as integer
dim i  as integer

dim LastObject as integer

dim LightAmb(2,3) as single
dim LightDif(2,3) as single
dim LightSpc(2,3) as single
dim LightPos(2,3) as single
dim LightTexture as integer
dim wStep as single
dim MatAmb(3) as single
dim MatDif(3) as single
dim MatSpc(3) as single
dim MatShn as single 

' try to get the texture
LightTexture = LoadTexture("star.bmp")
if LightTexture=0 then
  LightTexture = LoadTexture("data/star.bmp")
  if LightTexture=0 then
    LightTexture = LoadTexture("Programs/data/star.bmp")
  end if
end if

' lights and material properties
LightAmb(0)=Vec4(0.3,0.3,0.3 ,1)
LightDif(0)=Vec4(0.5,0.5,0.5, 1)
LightSpc(0)=Vec4(1,0,0, 1)
LightPos(0)=Vec4(-7,6,-10,1)

LightAmb(1)=Vec4(0.3,0.3,0.3 ,1)
LightDif(1)=Vec4(0.5,0.5,0.5, 1)
LightSpc(1)=Vec4(0,1,0, 1)
LightPos(1)=Vec4(0,6,-10,1)

LightAmb(2)=Vec4(0.3,0.3,0.3 ,1)
LightDif(2)=Vec4(0.5,0.5,0.5, 1)
LightSpc(2)=Vec4(0,0,1, 1)
LightPos(2)=Vec4( 7,6,-10,0)

MatAmb =Vec4(0.01, 0.01, 0.01, 1.0)
MatDif =Vec4(0.5, 0.5, 0.5, 1.0)
MatSpc =Vec4(0.75, 0.75, 0.75, 1.0)
MatShn =15.0 

' a short world
' in this case simple from DATA statements 
reset LabelWorld3D
read World.nObjects
for oc=0 to World.nObjects-1
  read World.Objects(oc).strType
next
for oc=0 to World.nObjects-1
  reset LabelUnitBox3D
  &pObject=&World.Objects(oc)
  read pObject.nPoints
  for pc=0 to pObject.nPoints-1
    for i=0 to 2:read pObject.Points(pc,i):next
  next 
  if pObject.strType="BOX3D" then
    reset LabelBox3D
  end if
  read pObject.nFaces
  for fc=0 to pObject.nFaces-1
    for i=0 to 2:read pObject.Faces(fc).PointIndex(i):next
  next
next 

reset LabelObjects3D
for oc=0 to World.nObjects-1
  &pObject=&World.Objects(oc)
  for i=0 to 2:read pObject.Position(i):next
  for i=0 to 2:read pObject.Size(i):next
  for pc=0 to pObject.nPoints-1
    for i=0 to 2
      pObject.Points(pc,i)=pObject.Points(pc,i)*pObject.Size(i)
    next
  next
  InitObject(pObject)
  for fc=0 to pObject.nFaces-1
    &pFace=&pObject.Faces(fc)
    BuildPlane(pObject,pFace)
  next                           
  BuildNormals(pObject)
next


'
' main
'
glMatrixMode  (GL_PROJECTION)
glLoadIdentity()
gluPerspective(50.0, WindowWidth()/WindowHeight(), 0.1, 10000.0)
glMatrixMode  (GL_MODELVIEW) 

glShadeModel  (GL_SMOOTH)
glClearColor  (0,0,0,1)
glClearDepth  (1)
glClearStencil(0)
glEnable      (GL_DEPTH_TEST)
glDepthFunc   (GL_LEQUAL)
glHint        (GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)



for lc=0 to 2
  glLightfv(GL_LIGHT0+lc, GL_AMBIENT ,LightAmb(lc))
  glLightfv(GL_LIGHT0+lc, GL_DIFFUSE ,LightDif(lc))
  glLightfv(GL_LIGHT0+lc, GL_SPECULAR,LightSpc(lc))
  glEnable (GL_LIGHT0+lc) 
next
glEnable (GL_LIGHTING)

glMaterialfv(GL_FRONT, GL_AMBIENT  ,MatAmb)
glMaterialfv(GL_FRONT, GL_DIFFUSE  ,MatDif)
glMaterialfv(GL_FRONT, GL_SPECULAR ,MatSpc)
glMaterialf (GL_FRONT, GL_SHININESS,MatShn)

glCullFace(GL_BACK)
glEnable  (GL_CULL_FACE)

while True
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT)
  
  
  glLoadIdentity()
  glTranslatef(0.0, 0.0, -camz#)
  ' animate the lights
  for lc=0 to 2
    LightPos(lc,0)= cos(wStep+lc*1.57)*6
    LightPos(lc,1)= 4+sin(wStep*3)
    LightPos(lc,2)=-camz#*0.5+ sin(wStep+lc*1.57)*10
    glLightfv(GL_LIGHT0+lc, GL_POSITION, LightPos(lc))
    wStep=wStep+0.01 
  next
  
  ' draw the world
  glLoadIdentity()
  glTranslatef(0.0, 0.0, -camz#)
  DrawRoom() 
  for oc=0 to World.nObjects-1
    &pObject=&World.Objects(oc)
    glLoadIdentity()
    glTranslatef(0,0,-camz#)
    DrawObject(pObject)
    ' animate the objects
    for i=0 to 2
      pObject.Rotation(i)=pObject.Rotation(i)+(1+oc)*((i+1)*0.1)
    next
  next

  ' build and draw shadow volumes for every light
  for oc=0 to World.nObjects-1
    &pObject=&World.Objects(oc)
    glLoadIdentity()
    glTranslatef(0,0,-camz#)
    glTranslatef(pObject.Position(0),pObject.Position(1),pObject.Position(2))
    glRotatef   (pObject.Rotation(0), 1,0,0)
    glRotatef   (pObject.Rotation(1), 0,1,0)
    glRotatef   (pObject.Rotation(2), 0,0,1)
    for lc=0 to 2
      Vector=GetInvers#(pObject,LightPos(lc))
      LastObject=((World.nObjects-1)=oc) and (lc=2)
      CastShadow(pObject,Vector,LastObject)
    next
  next
  DrawLights()
  SwapBuffers()
wend
end

' calc face Neighbors from Object
' based on Gamasutra's article
sub InitObject(&o as OBJECT_T)
  dim p1i as integer
  dim p2i as integer
  dim p1j as integer
  dim p2j as integer
  dim b1i as integer
  dim b2i as integer
  dim b1j as integer
  dim b2j as integer
  dim p1i_p_p2i as integer
  dim p1i_m_p2i as integer
  dim p1j_p_p2j as integer
  dim p1j_m_p2j as integer
  dim Face1 as integer
  dim Face2 as integer
  dim Edge1 as integer
  dim Edge2 as integer

  for Face1=0 to o.nFaces-2
    for Face2=Face1+1 to o.nFaces-1
      for Edge1=0 to 2
        if o.Faces(Face1).Neighbors(Edge1) = 0 then
          for Edge2=0 to 2
            p1i=o.Faces(Face1).PointIndex(Edge1)
            p2i=o.Faces(Face1).PointIndex((Edge1+1) % 3)
            p1j=o.Faces(Face2).PointIndex(Edge2)
            p2j=o.Faces(Face2).PointIndex((Edge2+1) % 3)
            p1i_p_p2i=p1i+p2i
            p1i_m_p2i=abs(p1i-p2i)
            p1j_p_p2j=p1j+p2j
            p1j_m_p2j=abs(p1j-p2j)
            b1i=(p1i_p_p2i-p1i_m_p2i)
            b1j=(p1j_p_p2j-p1j_m_p2j)
            '' they are neighbours
            if (b1i=b1j) then
              b2i=(p1i_p_p2i+p1i_m_p2i)
              b2j=(p1j_p_p2j+p1j_m_p2j)
              if (b2i=b2j) then 
                o.Faces(Face1).Neighbors(Edge1)=Face2+1
                o.Faces(Face2).Neighbors(Edge2)=Face1+1
              end if
            end if
          next
        end if
      next
    next
  next
end sub

' calc plane equation from Object and Face
sub BuildPlane(&o as OBJECT_T,&f as FACE_T)
  dim v(2,2) as single
  dim pc     as integer 
  for pc=0 to 2
    v(pc)=o.Points(o.Faces(fc).PointIndex(pc))
  next
  f.Plane.a =v(0,1)*(v(1,2)-v(2,2))+v(1,1)*(v(2,2)-v(0,2))+v(2,1)*(v(0,2)-v(1,2))
  f.Plane.b =v(0,2)*(v(1,0)-v(2,0))+v(1,2)*(v(2,0)-v(0,0))+v(2,2)*(v(0,0)-v(1,0))
  f.Plane.c =v(0,0)*(v(1,1)-v(2,1))+v(1,0)*(v(2,1)-v(0,1))+v(2,0)*(v(0,1)-v(1,1))
  f.Plane.d =             v(0,0)*(v(1,1)*v(2,2)-v(2,1)*v(1,2))
  f.Plane.d = f.Plane.d + v(1,0)*(v(2,1)*v(0,2)-v(0,1)*v(2,2))
  f.Plane.d = f.Plane.d + v(2,0)*(v(0,1)*v(1,2)-v(1,1)*v(0,2))
  f.Plane.d =-f.Plane.d
end sub

' calc normals from Object.Faces
sub BuildNormals(&o as OBJECT_T)
  dim a(2) as single
  dim b(2) as single
  dim fc   as integer
  for fc=0 to o.nFaces-1
    a=o.Points(o.Faces(fc).PointIndex(1))-o.Points(o.Faces(fc).PointIndex(0))
    b=o.Points(o.Faces(fc).PointIndex(2))-o.Points(o.Faces(fc).PointIndex(0))
    o.Faces(fc).Normale=Normalize(CrossProduct(a,b))
  next
end sub

' Draw Object with curent position and rotation
sub DrawObject(o as OBJECT_T)
  dim fc as integer
  dim pc as integer
  glTranslatef(o.Position(0),o.Position(1),o.Position(2))
  glRotatef   (o.Rotation(0), 1,0,0)
  glRotatef   (o.Rotation(1), 0,1,0)
  glRotatef   (o.Rotation(2), 0,0,1)
  glBegin(GL_TRIANGLES)
    for fc=0 to o.nFaces-1
      glNormal3fv(o.Faces(fc).Normale)
      for pc=0 to 2
        glVertex3fv(o.Points(o.Faces(fc).PointIndex(pc)))
      next
    next
  glEnd()
end sub

' Multiply vector with invers matrix
function GetInvers#(o as OBJECT_T,v() as single)()
  dim m(3,3) as single 
  dim t( 3) as single 
  glPushMatrix()
    glLoadIdentity()
    ' now in reverse z,y,x order and negative position
    glRotatef(-o.Rotation(2), 0.0, 0.0, 1.0)
    glRotatef(-o.Rotation(1), 0.0, 1.0, 0.0)
    glRotatef(-o.Rotation(0), 1.0, 0.0, 0.0)
    glGetFloatv(GL_MODELVIEW_MATRIX,m)
    ' light position in worldspace
    t=m*v
    glTranslatef(-o.Position(0),-o.Position(1),-o.Position(2))
    glGetFloatv(GL_MODELVIEW_MATRIX,m)
    ' light position in objectspace
    t=m*Vec4(0,0,0,1)+t
  glPopMatrix()
  return t
end function

' Draw shadow volume from Object and Light position
sub CastShadow(o as OBJECT_T,v() as single,IsLastObject as integer)
  dim v1(2) as single
  dim v2(2) as single
  dim p    as PLANE_T
  dim fc   as integer
  dim pi   as integer
  dim side as single
  dim flag as integer
  dim r as integer
  dim i as integer
  dim j as integer
  dim k as integer
  ' faces visible from point of light?
  for fc=0 to o.nFaces-1
    p=o.Faces(fc).Plane
    side=p.a*v(0)+p.b*v(1)+p.c*v(2)+p.d*v(3)
    o.Faces(fc).Visible = (side>0.0)
  next

  glDisable    (GL_LIGHTING)
  glDepthMask  (GL_FALSE)
  glDepthFunc  (GL_LEQUAL)

  glEnable     (GL_STENCIL_TEST)
  glColorMask  (0,0,0,0)
  glStencilFunc(GL_ALWAYS, 1, -1)

  glFrontFace  (GL_CCW)
  glStencilOp  (GL_KEEP, GL_KEEP, GL_INCR)

  ' render two times the shadow volume
  ' 1 * backside + 1 * frontside
  for r=0 to 1
    ' draw the silouette from view of the light
    for fc=0 to o.nFaces-1
      if (o.Faces(fc).Visible<>0) then
        for i=0 to 2
          k = o.Faces(fc).Neighbors(i)
          flag=(k=0)
          if (flag=0) then
            flag=(o.Faces(k-1).Visible=0)
          end if
          if flag then
            ' draw the polygon
            glBegin(GL_TRIANGLE_STRIP)
              for j=0 to 1
                pi = o.Faces(fc).PointIndex((i+j) % 3)
                '' calculate the length of the vectors
                v1=o.Points(pi)
                v2(0)=(v1(0)-v(0))*1000
                v2(1)=(v1(1)-v(1))*1000
                v2(2)=(v1(2)-v(2))*1000
                glVertex3fv(v1)
                glVertex3fv(v2)
              next
            glEnd()
          end if
        next
      end if
    next
    glFrontFace(GL_CW)
    glStencilOp(GL_KEEP,GL_KEEP,GL_DECR)
  next

  glFrontFace(GL_CCW)
  glColorMask(1,1,1,1)
  ' only if it was the last object
  if (IsLastObject<>0) then
    glColor4fv(Vec4(0,0,0,0.1))
    glEnable     (GL_BLEND)
    glBlendFunc  (GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glStencilFunc(GL_NOTEQUAL,0,-1)
    glStencilOp  (GL_KEEP,GL_KEEP,GL_KEEP)
    glPushMatrix ()
      glLoadIdentity()
      glBegin(GL_TRIANGLE_STRIP)
        glVertex3fv(Vec3(-0.1, 0.1,-0.1))
        glVertex3fv(Vec3(-0.1,-0.1,-0.1))
        glVertex3fv(Vec3( 0.1, 0.1,-0.1))
        glVertex3fv(Vec3( 0.1,-0.1,-0.1))
      glEnd()
    glPopMatrix()
    glDisable(GL_BLEND)
  end if

  ' restore old render mode
  glDepthFunc (GL_LEQUAL)
  glDepthMask (GL_TRUE)
  glEnable    (GL_LIGHTING)
  glDisable   (GL_STENCIL_TEST)
  glShadeModel(GL_SMOOTH)
  glCullFace  (GL_BACK)
  glEnable    (GL_CULL_FACE)
end sub

Sub DrawRoom()
  glBegin(GL_QUADS)
    ' Floor
    glNormal3f(0.0, 1.0, 0.0)
    glVertex3f(-10,-10,-30)
    glVertex3f(-10,-10, 10)
    glVertex3f( 10,-10, 10)
    glVertex3f( 10,-10,-30)
    ' Ceiling
    glNormal3f(0.0,-1.0, 0.0)
    glVertex3f(-10, 10, 10)
    glVertex3f(-10, 10,-30)
    glVertex3f( 10, 10,-30)
    glVertex3f( 10, 10, 10)
    ' Front Wall
    glNormal3f(0.0, 0.0, 1.0)
    glVertex3f(-10, 10,-30)
    glVertex3f(-10,-10,-30)
    glVertex3f( 10,-10,-30)
    glVertex3f( 10, 10,-30)
    ' Back Wall
    glNormal3f(0.0, 0.0,-1.0)
    glVertex3f( 10, 10, 10)
    glVertex3f( 10,-10, 10)
    glVertex3f(-10,-10, 10)
    glVertex3f(-10, 10, 10)
    ' Left Wall
    glNormal3f(1.0, 0.0, 0.0)
    glVertex3f(-10, 10, 10)
    glVertex3f(-10,-10, 10)
    glVertex3f(-10,-10,-30)
    glVertex3f(-10, 10,-30)
    ' Right Wall
    glNormal3f(-1.0, 0.0, 0.0)
    glVertex3f( 10, 10,-30)
    glVertex3f( 10,-10,-30)
    glVertex3f( 10,-10, 10)
    glVertex3f( 10, 10, 10)
  glEnd()
end sub

sub DrawLights()
  dim lc as integer
  dim m(3,3) as single
  glDisable    (GL_LIGHTING)
  glDepthMask  (0)
  glBlendFunc  (GL_SRC_COLOR, GL_ONE)
  glEnable     (GL_BLEND)
  glEnable     (GL_TEXTURE_2D)
  glBindTexture(GL_TEXTURE_2D, LightTexture)
  glDisable    (GL_CULL_FACE)

  glPushMatrix()
  for lc=0 to 2
    glLoadIdentity()
    glTranslatef(0,0,-camz#)
    glTranslatef(LightPos(lc,0),LightPos(lc,1),LightPos(lc,2))
    glGetFloatv(GL_MODELVIEW_MATRIX,m)
    m(0)=Vec4(1,0,0,0)
    m(1)=Vec4(0,1,0,0)
    m(2)=Vec4(0,0,1,0)
    glLoadMatrixf(m)
    glScalef(3,3,3)
    glBegin(GL_QUADS)
      glColor4fv(LightSpc(lc)) 
      glTexCoord2f(0,0): glVertex3f(-.5,-.5,0)
      glTexCoord2f(1,0): glVertex3f( .5,-.5,0)
      glTexCoord2f(1,1): glVertex3f( .5, .5,0)
      glTexCoord2f(0,1): glVertex3f(-.5, .5,0)
      glTexCoord2f(0,0): glVertex3f(0,-.5,-.5)
      glTexCoord2f(1,0): glVertex3f(0, .5,-.5)
      glTexCoord2f(1,1): glVertex3f(0, .5, .5)
      glTexCoord2f(0,1): glVertex3f(0,-.5, .5)
    glEnd()
    glScalef(0.75,0.75,0.75)
    glBegin(GL_QUADS)
      glColor4fv(Vec4(1,1,1,1))
      glTexCoord2f(0,0): glVertex3f(-.5,0,-.5)
      glTexCoord2f(1,0): glVertex3f(-.5,0, .5)
      glTexCoord2f(1,1): glVertex3f( .5,0, .5)
      glTexCoord2f(0,1): glVertex3f( .5,0,-.5)
      glTexCoord2f(0,0): glVertex3f(0, .5,-.5)
      glTexCoord2f(1,0): glVertex3f(0,-.5,-.5)
      glTexCoord2f(1,1): glVertex3f(0,-.5, .5)
      glTexCoord2f(0,1): glVertex3f(0, .5, .5)
    glEnd()
  next
  glPopMatrix()

  glDepthMask(1)
  glDisable(GL_BLEND)
  glDisable(GL_TEXTURE_2D)
  glEnable (GL_LIGHTING)
  glEnable (GL_CULL_FACE)
end sub
Last edited by D.J.Peters on Oct 03, 2017 6:05, edited 3 times in total.
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

Nice, those look more like references than pointers, very sleek syntax. Nice tight integration with OGL, it looks really good.
tinram
Posts: 89
Joined: Nov 30, 2006 13:35
Location: UK

Post by tinram »

I like several things about Basic4GL: it's good for OGL tests, the IDE editor provides useful help and the speed, as mentioned, is not bad - but the size overheads can be considerable. For an OGL example present in both and FreeBASIC and Basic4GL (the spinning pyramid and cube) the standalone exe is c.100kB in FreeBASIC, but over 1MB in Basic4GL.
ciw1973
Posts: 157
Joined: Jun 12, 2007 15:03
Location: Isle of Man (United Kingdom)

Post by ciw1973 »

Looked at BASIC4GL a while back when I was looking to teach programming to my girlfriend, and there was quite a list of things which I didn't particularly like about it, although right now I can only think of the following:

The EXEs were quite a bit bigger and didn't seem to run as quickly as the same OpenGL based routines in FreeBASIC.

It's Windows only, and despite the fact that that's what I develop on, wherever possible I avoid using software which is tied to a single platform.

Whilst it does come with quite a nice IDE, it's certainly no better than FBEdit (which is unfortunately also Windows only), so I'm just wondering why I might want to use BASIC4GL over FreeBASIC?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

here are the FreeBASIC code and the Star.bmp file
http://shiny3d.de/public/images/Star.bmp

Joshy

Code: Select all

#include "fbgfx.bi"
#include "GL/glu.bi"
'#include "GL/gl.bi"

Const WindowWidth  = 640
Const WindowHeight = 480

Const MaxObjectsPerWorld=20
Const MaxPointsPerObject=30
Const MaxFacesPerObject =40

Type Plane_t
  a As Single
  b As Single
  c As Single
  d As Single
End Type

Type Face_t
  PointIndex(2) As Integer
  Normale(2)    As Single
  Neighbors(2)  As Integer
  Plane         As Plane_t
  Visible       As Integer
End Type

Type Object_t
  strType As String
  Position(2) As Single
  Rotation(2) As Single
  Size(2) As Single
  ColorRGBA(3) As Single
  nPoints As Integer
  nFaces As Integer
  Points(MaxPointsPerObject-1,2) As Single
  Faces (MaxFacesPerObject -1) As Face_t
End Type

Type World_t
  nObjects As Integer
  Objects(MaxObjectsPerWorld-1) As Object_t
End Type

#macro Vec4(r,a,b,c,d)
  r(0)=a:r(1)=b:r(2)=c:r(3)=d
#endmacro
#macro VecArray4(r,i,a,b,c,d)
  r(i,0)=a:r(i,1)=b:r(i,2)=c:r(i,3)=d
#endmacro
' prototypes
Declare Sub MatMul(r() As Single,m() As Single,v() As Single)
Declare Sub CrossProduct(r() As Single,a() As Single,b() As Single)
Declare Sub Normalize(r() As Single,v() As Single)
Declare Sub GetInvers(o() As Single, o As OBJECT_T Ptr,v() As Single)
Declare Sub CastShadow(o As OBJECT_T Ptr,v() As Single,IsLastObject As Integer)
Declare Sub InitObject(o As OBJECT_T Ptr)
Declare Sub BuildNormals(o As OBJECT_T Ptr)
Declare Sub BuildPlane(o As OBJECT_T Ptr,f As FACE_T Ptr)
Declare Sub DrawObject(o As OBJECT_T Ptr)
Declare Sub DrawRoom()
Declare Sub DrawLights()

Function LoadTexture(FileName As String, mask As Integer=0) As Uinteger
  Dim As Uinteger Ptr buffer,p
  Dim As Integer  w,h,col,hfile
  Dim As Uinteger texture
  Dim As String   id="  "
  Dim As GLenum   format, minfilter, magfilter
  Dim As FB.Image Ptr Image

  hFile=Freefile()
  If Open(filename For Binary Access Read As #hFile) Then
    Print "error: can't open [" & filename & "] !"
    Beep:Sleep:End
  End If
  Get #hfile,,id
  If id<>"BM" Then
    Print "error: [" & filename & "] isn't a bmp file!"
    Beep:Sleep:End
  End If
  Get #hfile,19,w
  Get #hfile,  ,h
  Close #hFile
  If ((w And (w-1)) Or (h And (h-1))) Then
    Print "error: [" & filename & "] isn't power of 2 !"
    Beep:Sleep:End
  End If

  image=ImageCreate(w,h,0)
  Bload filename,image

  buffer=callocate(w*h*4)
  p=buffer

  glGenTextures 1, @texture
  glBindTexture GL_TEXTURE_2D, texture

  For y As Integer = h-1 To 0 Step -1
    For x As Integer = 0 To w-1
      col = Point(x,y,image)
      col = rgb(col And &hFF,(col Shr 8) And &hFF,(col Shr 16) And &hFF)
      If ((mask<>0) And (col = &hFF00FF)) Then
        *p = 0
      Else
        *p = col Or &hFF000000
      End If
      p += 1
    Next
  Next

  format    = GL_RGBA
  magfilter = GL_LINEAR
  minfilter = GL_LINEAR_MIPMAP_LINEAR
  gluBuild2DMipmaps GL_TEXTURE_2D,format,w,h,GL_RGBA,GL_UNSIGNED_BYTE, buffer
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, minfilter
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, magfilter
  deallocate buffer
  Return texture
End Function


LabelWorld3D:
' number of objects
Data 12
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"
Data "BOX3D"

LabelUnitBox3D:
' number of points
Data 8
' front side
Data -0.5, 0.5,0.5
Data -0.5,-0.5,0.5
Data  0.5,-0.5,0.5
Data  0.5, 0.5,0.5
' back side
Data  0.5, 0.5,-0.5
Data  0.5,-0.5,-0.5
Data -0.5,-0.5,-0.5
Data -0.5, 0.5,-0.5

LabelBox3D:
' number of faces
Data 12
' faces
Data 0,1,2 ' front
Data 0,2,3
Data 3,2,5 ' right
Data 3,5,4
Data 4,5,6 ' back
Data 4,6,7
Data 7,6,1 ' left
Data 7,1,0
Data 7,0,3 ' top
Data 7,3,4
Data 1,6,5 ' bottom
Data 1,5,2

LabelObjects3D:
' 3x3 raster with 9 boxes
Data -4,-5,-20 ' object position
Data  2, 2,  2 ' object size

Data  0,-5,-20 ' ...
Data  2, 2,  2 ' ...

Data  4,-5,-20
Data  2, 2,  2

Data -4,-6,-15
Data  2, 2,  2

Data  0,-6,-15
Data  2, 2,  2

Data  4,-6,-15
Data  2, 2,  2

Data -4,-7,-10
Data  2, 2,  2

Data  0,-7,-10
Data  2, 2,  2

Data  4,-7,-10
Data  2, 2,  2

' 3 boxes
Data -5,-1,-20 ' box1 position
Data 1,2,3 ' size

Data 0,-1,-17 ' box2 position
Data 5, 2,0.5 ' size

Data 5,-1,-14 ' box3 position
Data 2,2,2 ' size

Const camz As Single = 20

Dim World      As World_t
Dim pObject    As OBJECT_T Ptr
Dim pFace      As Face_t Ptr
Dim Points(2)  As Single
Dim Vector(3)  As Single
Dim LastObject As Integer

Dim LightAmb(2,3) As Single
Dim LightDif(2,3) As Single
Dim Shared LightSpc(2,3) As Single
Dim Shared LightPos(2,3) As Single
Dim Shared LightTexture As Integer
Dim wStep        As Single
Dim MatAmb(3)    As Single
Dim MatDif(3)    As Single
Dim MatSpc(3)    As Single
Dim MatShn       As Single

ScreenRes WindowWidth,WindowHeight,32, ,FB.GFX_OPENGL Or FB.GFX_STENCIL_BUFFER
glViewport 0, 0,WindowWidth,WindowHeight
glMatrixMode   GL_PROJECTION
glLoadIdentity
gluPerspective 50.0, WindowWidth/WindowHeight, 0.1, 1000.0
glMatrixMode   GL_MODELVIEW
glLoadIdentity

glShadeModel   (GL_SMOOTH)
glClearColor   (0,0,0,1)
glClearDepth   (1)
glClearStencil (0)
glEnable       (GL_DEPTH_TEST)
'glDepthFunc    (GL_LEQUAL)
glHint         (GL_PERSPECTIVE_CORRECTION_HINT , GL_NICEST)
glEnable       (GL_TEXTURE_2D)


' get the texture
LightTexture = LoadTexture("Star.bmp")

' lights and material properties
VecArray4(LightAmb,0,0.3,0.3,0.3 ,1)
VecArray4(LightDif,0,0.5,0.5,0.5, 1)
VecArray4(LightSpc,0,1,0,0, 1)
VecArray4(LightPos,0,-7,6,-10,1)

VecArray4(LightAmb,1,0.3,0.3,0.3 ,1)
VecArray4(LightDif,1,0.5,0.5,0.5, 1)
VecArray4(LightSpc,1,0,1,0, 1)
VecArray4(LightPos,1,0,6,-10,1)

VecArray4(LightAmb,2,0.3,0.3,0.3 ,1)
VecArray4(LightDif,2,0.5,0.5,0.5, 1)
VecArray4(LightSpc,2,0,0,1, 1)
VecArray4(LightPos,2,7,6,-10,0)

Vec4(MatAmb,0.01, 0.01, 0.01, 1.0)
Vec4(MatDif,0.5, 0.5, 0.5, 1.0)
Vec4(MatSpc,0.75, 0.75, 0.75, 1.0)
MatShn =15.0

' a short world
' in this case simple from DATA statements
Restore LabelWorld3D
Read World.nObjects
For oc as integer=0 To World.nObjects-1
  Read World.Objects(oc).strType
Next
For oc as integer=0 To World.nObjects-1
  Restore LabelUnitBox3D
  pObject=@World.Objects(oc)
  Read pObject->nPoints
  For pc as integer=0 To pObject->nPoints-1
    For i as integer=0 To 2:Read pObject->Points(pc,i):Next
  Next
  If pObject->strType="BOX3D" Then
    Restore LabelBox3D
  End If
  Read pObject->nFaces
  For fc as integer=0 To pObject->nFaces-1
    For i as integer=0 To 2:Read pObject->Faces(fc).PointIndex(i):Next
  Next
next

Restore LabelObjects3D
For oc as integer=0 To World.nObjects-1
  pObject=@World.Objects(oc)
  For i as integer=0 To 2:Read pObject->Position(i):Next
  For i as integer=0 To 2:Read pObject->Size(i):Next
  For pc as integer=0 To pObject->nPoints-1
    For i as integer=0 To 2
      pObject->Points(pc,i)=pObject->Points(pc,i)*pObject->Size(i)
    Next
  Next
  InitObject(pObject)
  For fc as integer=0 To pObject->nFaces-1
    pFace=@pObject->Faces(fc)
    BuildPlane(pObject,pFace)
  Next
  BuildNormals(pObject)
Next


'
' main
'

For lc as integer=0 To 2
  glLightfv(GL_LIGHT0+lc, GL_AMBIENT ,@LightAmb(lc,0))
  glLightfv(GL_LIGHT0+lc, GL_DIFFUSE ,@LightDif(lc,0))
  glLightfv(GL_LIGHT0+lc, GL_SPECULAR,@LightSpc(lc,0))
  glEnable (GL_LIGHT0+lc)
Next
glEnable (GL_LIGHTING)

glMaterialfv(GL_FRONT, GL_AMBIENT  ,@MatAmb(0))
glMaterialfv(GL_FRONT, GL_DIFFUSE  ,@MatDif(0))
glMaterialfv(GL_FRONT, GL_SPECULAR ,@MatSpc(0))
glMaterialf (GL_FRONT, GL_SHININESS,MatShn)

glCullFace(GL_BACK)
glEnable  (GL_CULL_FACE)

While Inkey=""
  glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT Or GL_STENCIL_BUFFER_BIT)

  glLoadIdentity()
  glTranslatef(0.0, 0.0, -camz)
  ' animate the lights
  For lc as integer=0 To 2
    LightPos(lc,0)= Cos(wStep+lc*1.57)*6
    LightPos(lc,1)= 4+Sin(wStep*3)
    LightPos(lc,2)=-camz*0.5+ Sin(wStep+lc*1.57)*10
    glLightfv(GL_LIGHT0+lc, GL_POSITION, @LightPos(lc,0))
    wStep=wStep+0.01
  Next

  ' draw the world
  glLoadIdentity()
  glTranslatef(0.0, 0.0, -camz)
  DrawRoom()
  For oc as integer=0 To World.nObjects-1
    pObject=@World.Objects(oc)
    glLoadIdentity()
    glTranslatef(0,0,-camz)
    DrawObject(pObject)
    ' animate the objects
    For i as integer =0 To 2
      pObject->Rotation(i)=pObject->Rotation(i)+(1+oc)*((i+1)*0.1)
    Next
  Next

  ' build and draw shadow volumes for every light
  For oc as integer=0 To World.nObjects-1
    pObject=@World.Objects(oc)
    glLoadIdentity()
    glTranslatef(0,0,-camz)
    glTranslatef(pObject->Position(0),pObject->Position(1),pObject->Position(2))
    glRotatef   (pObject->Rotation(0), 1,0,0)
    glRotatef   (pObject->Rotation(1), 0,1,0)
    glRotatef   (pObject->Rotation(2), 0,0,1)
    For lc as integer=0 To 2
      dim as single lp(3)
      for i as integer=0 to 3
        lp(i)=LightPos(lc,i)
      next
      GetInvers(vector(0),pObject,lp(0))
      LastObject=((World.nObjects-1)=oc) And (lc=2)
      CastShadow(pObject,Vector(0),LastObject)
    Next
  Next
  DrawLights()
  Flip()
  Sleep(1000\50)
Wend
End

Sub MatMul(r() As Single,m() As Single,v() As Single)
  r(0)=M(0)*v(0)+M(4)*v(1)+M( 8)*v(2)+M(12)*v(3)
  r(1)=M(1)*v(0)+M(5)*v(1)+M( 9)*v(2)+M(13)*v(3)
  r(2)=M(2)*v(0)+M(6)*v(1)+M(10)*v(2)+M(14)*v(3)
  r(3)=M(3)*v(0)+M(7)*v(1)+M(11)*v(2)+M(15)*v(3)
End Sub

Sub CrossProduct(r() As Single,a() As Single,b() As Single)
  r(0) = a(1)*b(2) - a(2)*b(1)
  r(1) = a(2)*b(0) - a(0)*b(2)
  r(2) = a(0)*b(1) - a(1)*b(0)
End Sub

Sub Normalize(r() As Single,v() As Single)
  Dim As Single l=v(0)*v(0)+v(1)*v(1)+v(2)*v(2)
  If l Then
    l=1/Sqr(l)
    r(0)=v(0)*l
    r(1)=v(1)*l
    r(2)=v(2)*l
  End If
End Sub


' calc face Neighbors from Object
' based on Gamasutra's article
Sub InitObject(o As OBJECT_T Ptr)
  Dim p1i As Integer
  Dim p2i As Integer
  Dim p1j As Integer
  Dim p2j As Integer
  Dim b1i As Integer
  Dim b2i As Integer
  Dim b1j As Integer
  Dim b2j As Integer
  Dim p1i_p_p2i As Integer
  Dim p1i_m_p2i As Integer
  Dim p1j_p_p2j As Integer
  Dim p1j_m_p2j As Integer
  Dim Face1 As Integer
  Dim Face2 As Integer
  Dim Edge1 As Integer
  Dim Edge2 As Integer

  For Face1=0 To o->nFaces-2
    For Face2=Face1+1 To o->nFaces-1
      For Edge1=0 To 2
        If o->Faces(Face1).Neighbors(Edge1) = 0 Then
          For Edge2=0 To 2
            p1i=o->Faces(Face1).PointIndex(Edge1)
            p2i=o->Faces(Face1).PointIndex((Edge1+1) Mod 3)
            p1j=o->Faces(Face2).PointIndex(Edge2)
            p2j=o->Faces(Face2).PointIndex((Edge2+1) Mod 3)
            p1i_p_p2i=p1i+p2i
            p1i_m_p2i=Abs(p1i-p2i)
            p1j_p_p2j=p1j+p2j
            p1j_m_p2j=Abs(p1j-p2j)
            b1i=(p1i_p_p2i-p1i_m_p2i)
            b1j=(p1j_p_p2j-p1j_m_p2j)
            '' they are neighbours
            If (b1i=b1j) Then
              b2i=(p1i_p_p2i+p1i_m_p2i)
              b2j=(p1j_p_p2j+p1j_m_p2j)
              If (b2i=b2j) Then
                o->Faces(Face1).Neighbors(Edge1)=Face2+1
                o->Faces(Face2).Neighbors(Edge2)=Face1+1
              End If
            End If
          Next
        End If
      Next
    Next
  Next
End Sub

' calc plane equation from Object and Face
Sub BuildPlane(o As OBJECT_T Ptr,f As FACE_T Ptr)
  Dim v(2,2) As Single
  Dim pc     As Integer
  For pc=0 To 2
    v(pc,0)=o->Points(f->PointIndex(pc),0)
    v(pc,1)=o->Points(f->PointIndex(pc),1)
    v(pc,2)=o->Points(f->PointIndex(pc),2)
  Next
  f->Plane.a =v(0,1)*(v(1,2)-v(2,2))+v(1,1)*(v(2,2)-v(0,2))+v(2,1)*(v(0,2)-v(1,2))
  f->Plane.b =v(0,2)*(v(1,0)-v(2,0))+v(1,2)*(v(2,0)-v(0,0))+v(2,2)*(v(0,0)-v(1,0))
  f->Plane.c =v(0,0)*(v(1,1)-v(2,1))+v(1,0)*(v(2,1)-v(0,1))+v(2,0)*(v(0,1)-v(1,1))
  f->Plane.d =              v(0,0)*(v(1,1)*v(2,2)-v(2,1)*v(1,2))
  f->Plane.d = f->Plane.d + v(1,0)*(v(2,1)*v(0,2)-v(0,1)*v(2,2))
  f->Plane.d = f->Plane.d + v(2,0)*(v(0,1)*v(1,2)-v(1,1)*v(0,2))
  f->Plane.d =-f->Plane.d
End Sub

' calc normals from Object.Faces
Sub BuildNormals(o As OBJECT_T Ptr)
  Dim a(2) As Single
  Dim b(2) As Single
  Dim t(2) As Single
  Dim fc   As Integer
  For fc=0 To o->nFaces-1
    a(0)=o->Points(o->Faces(fc).PointIndex(1),0)-o->Points(o->Faces(fc).PointIndex(0),0)
    a(1)=o->Points(o->Faces(fc).PointIndex(1),1)-o->Points(o->Faces(fc).PointIndex(0),1)
    a(2)=o->Points(o->Faces(fc).PointIndex(1),2)-o->Points(o->Faces(fc).PointIndex(0),2)

    b(0)=o->Points(o->Faces(fc).PointIndex(2),0)-o->Points(o->Faces(fc).PointIndex(0),0)
    b(1)=o->Points(o->Faces(fc).PointIndex(2),1)-o->Points(o->Faces(fc).PointIndex(0),1)
    b(2)=o->Points(o->Faces(fc).PointIndex(2),2)-o->Points(o->Faces(fc).PointIndex(0),2)

    CrossProduct(t(0),a(0),b(0))
    Normalize(o->Faces(fc).Normale(0),t())
  Next
End Sub

' Draw Object with curent position and rotation
Sub DrawObject(o As OBJECT_T Ptr)
  glTranslatef(o->Position(0),o->Position(1),o->Position(2))
  glRotatef   (o->Rotation(0), 1,0,0)
  glRotatef   (o->Rotation(1), 0,1,0)
  glRotatef   (o->Rotation(2), 0,0,1)
  glBegin(GL_TRIANGLES)
    For fc as integer=0 To o->nFaces-1
      glNormal3fv(@o->Faces(fc).Normale(0))
      For pc as integer=0 To 2
        glVertex3fv(@o->Points(o->Faces(fc).PointIndex(pc),0))
      Next
    Next
  glEnd()
End Sub

' Multiply vector with invers matrix
Sub GetInvers(r() As Single, o As OBJECT_T Ptr,v() As Single)
  Dim m(15) As Single
  Dim t( 3) As Single
  Dim t2(3) As Single
  Dim v2(3) As Single

  Vec4(v2,0,0,0,1)
  glPushMatrix()
    glLoadIdentity()
    ' now in reverse z,y,x order and negative position
    glRotatef(-o->Rotation(2), 0.0, 0.0, 1.0)
    glRotatef(-o->Rotation(1), 0.0, 1.0, 0.0)
    glRotatef(-o->Rotation(0), 1.0, 0.0, 0.0)
    glGetFloatv(GL_MODELVIEW_MATRIX,@m(0))
    ' light position in worldspace
    MatMul(t(0),m(0),v(0))
    glTranslatef(-o->Position(0),-o->Position(1),-o->Position(2))
    glGetFloatv(GL_MODELVIEW_MATRIX,@m(0))
    ' light position in objectspace
    MatMul(t2(0),m(0),v2(0))
    r(0)=t2(0)+t(0)
    r(1)=t2(1)+t(1)
    r(2)=t2(2)+t(2)
    r(3)=t2(3)+t(3)
  glPopMatrix()
End Sub

' Draw shadow volume from Object and Light position
Sub CastShadow(o As OBJECT_T Ptr,v() As Single,IsLastObject As Integer)
  Dim v1(2) As Single
  Dim v2(2) As Single
  Dim p    As PLANE_T
  Dim side As Single
  Dim flag As Integer

  ' faces visible from point of light?
  For fc as integer=0 To o->nFaces-1
    p=o->Faces(fc).Plane
    side=p.a*v(0)+p.b*v(1)+p.c*v(2)+p.d*v(3)
    o->Faces(fc).Visible = (side>0.0)
  Next

  glDisable    (GL_LIGHTING)
  glDepthMask  (GL_FALSE)
  glDepthFunc  (GL_LEQUAL)

  glEnable     (GL_STENCIL_TEST)
  glColorMask  (0,0,0,0)
  glStencilFunc(GL_ALWAYS, 1, -1)

  glFrontFace  (GL_CCW)
  glStencilOp  (GL_KEEP, GL_KEEP, GL_INCR)

  ' render two times the shadow volume
  ' backside + frontside
  For r as integer=0 To 1
    ' draw the silouette from view of the light
    For fc as integer=0 To o->nFaces-1
      If (o->Faces(fc).Visible<>0) Then
        For i as integer=0 To 2
          dim as integer k = o->Faces(fc).Neighbors(i)
          flag=(k=0)
          If (flag=0) Then
            flag=(o->Faces(k-1).Visible=0)
          End If
          If flag Then
            ' draw the polygon
            glBegin(GL_TRIANGLE_STRIP)
              For j as integer=0 To 1
                dim as integer index = o->Faces(fc).PointIndex((i+j) Mod 3)
                '' calculate the length of the vectors
                v1(0)=o->Points(index,0)
                v1(1)=o->Points(index,1)
                v1(2)=o->Points(index,2)

                v2(0)=(v1(0)-v(0))*100
                v2(1)=(v1(1)-v(1))*100
                v2(2)=(v1(2)-v(2))*100

                glVertex3fv(@v1(0))
                glVertex3fv(@v2(0))
              Next
            glEnd()
          End If
        Next
      End If
    Next
    glFrontFace(GL_CW)
    glStencilOp(GL_KEEP,GL_KEEP,GL_DECR)
  Next

  glFrontFace(GL_CCW)
  glColorMask(1,1,1,1)
  ' only if it was the last object
  If (IsLastObject<>0) Then
    glColor4f(0,0,0,0.1)
    glEnable     (GL_BLEND)
    glBlendFunc  (GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glStencilFunc(GL_NOTEQUAL,0,-1)
    glStencilOp  (GL_KEEP,GL_KEEP,GL_KEEP)
    glPushMatrix ()
      glLoadIdentity()
      glBegin(GL_TRIANGLE_STRIP)
        glVertex3f(-0.1, 0.1,-0.1)
        glVertex3f(-0.1,-0.1,-0.1)
        glVertex3f( 0.1, 0.1,-0.1)
        glVertex3f( 0.1,-0.1,-0.1)
      glEnd()
    glPopMatrix()
    glDisable(GL_BLEND)
  End If

  ' restore old render mode
  glDepthFunc (GL_LEQUAL)
  glDepthMask (GL_TRUE)
  glEnable    (GL_LIGHTING)
  glDisable   (GL_STENCIL_TEST)
  glShadeModel(GL_SMOOTH)
  glCullFace  (GL_BACK)
  glEnable    (GL_CULL_FACE)
End Sub

Sub DrawRoom()
  glBegin(GL_QUADS)
    ' Floor
    glNormal3f(0.0, 1.0, 0.0)
    glVertex3f(-10,-10,-30)
    glVertex3f(-10,-10, 10)
    glVertex3f( 10,-10, 10)
    glVertex3f( 10,-10,-30)
    ' Ceiling
    glNormal3f(0.0,-1.0, 0.0)
    glVertex3f(-10, 10, 10)
    glVertex3f(-10, 10,-30)
    glVertex3f( 10, 10,-30)
    glVertex3f( 10, 10, 10)
    ' Front Wall
    glNormal3f(0.0, 0.0, 1.0)
    glVertex3f(-10, 10,-30)
    glVertex3f(-10,-10,-30)
    glVertex3f( 10,-10,-30)
    glVertex3f( 10, 10,-30)
    ' Back Wall
    glNormal3f(0.0, 0.0,-1.0)
    glVertex3f( 10, 10, 10)
    glVertex3f( 10,-10, 10)
    glVertex3f(-10,-10, 10)
    glVertex3f(-10, 10, 10)
    ' Left Wall
    glNormal3f(1.0, 0.0, 0.0)
    glVertex3f(-10, 10, 10)
    glVertex3f(-10,-10, 10)
    glVertex3f(-10,-10,-30)
    glVertex3f(-10, 10,-30)
    ' Right Wall
    glNormal3f(-1.0, 0.0, 0.0)
    glVertex3f( 10, 10,-30)
    glVertex3f( 10,-10,-30)
    glVertex3f( 10,-10, 10)
    glVertex3f( 10, 10, 10)
  glEnd()
End Sub

Sub DrawLights()
  Dim m(3,3) As Single
  glDisable    (GL_LIGHTING)
  glDepthMask  (0)
  glBlendFunc  (GL_SRC_COLOR, GL_ONE)
  glEnable     (GL_BLEND)
  glEnable     (GL_TEXTURE_2D)
  glBindTexture(GL_TEXTURE_2D, LightTexture)
  glDisable    (GL_CULL_FACE)

  glPushMatrix()
  For lc as integer=0 To 2
    glLoadIdentity()
    glTranslatef(0,0,-camz)
    glTranslatef(LightPos(lc,0),LightPos(lc,1),LightPos(lc,2))
    glGetFloatv(GL_MODELVIEW_MATRIX,@m(0,0))
    VecArray4(m,0,1,0,0,0)
    VecArray4(m,1,0,1,0,0)
    VecArray4(m,2,0,0,1,0)
    glLoadMatrixf(@m(0,0))
    glScalef(3,3,3)
    glBegin(GL_QUADS)
      glColor4fv(@LightSpc(lc,0))
      glTexCoord2f(0,0): glVertex3f(-.5,-.5,0)
      glTexCoord2f(1,0): glVertex3f( .5,-.5,0)
      glTexCoord2f(1,1): glVertex3f( .5, .5,0)
      glTexCoord2f(0,1): glVertex3f(-.5, .5,0)
      glTexCoord2f(0,0): glVertex3f(0,-.5,-.5)
      glTexCoord2f(1,0): glVertex3f(0, .5,-.5)
      glTexCoord2f(1,1): glVertex3f(0, .5, .5)
      glTexCoord2f(0,1): glVertex3f(0,-.5, .5)
    glEnd()
    glScalef(0.75,0.75,0.75)
    glBegin(GL_QUADS)
      glColor4f(1,1,1,1)
      glTexCoord2f(0,0): glVertex3f(-.5,0,-.5)
      glTexCoord2f(1,0): glVertex3f(-.5,0, .5)
      glTexCoord2f(1,1): glVertex3f( .5,0, .5)
      glTexCoord2f(0,1): glVertex3f( .5,0,-.5)
      glTexCoord2f(0,0): glVertex3f(0, .5,-.5)
      glTexCoord2f(1,0): glVertex3f(0,-.5,-.5)
      glTexCoord2f(1,1): glVertex3f(0,-.5, .5)
      glTexCoord2f(0,1): glVertex3f(0, .5, .5)
    glEnd()
  Next
  glPopMatrix()

  glDepthMask(1)
  glDisable(GL_BLEND)
  glDisable(GL_TEXTURE_2D)
  glEnable (GL_LIGHTING)
  glEnable (GL_CULL_FACE)
End Sub
Last edited by D.J.Peters on Oct 03, 2017 6:04, edited 3 times in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

One question why i must make a copy of one row from 2D array in FreeBASIC ?

Joshy

I can't do this in line 377
GetInvers(vector(0),pObject,LightPos(lc,0))

Code: Select all

For lc as integer=0 To 2
  dim as single l(3)
  for i as integer=0 to 3
    l(i)=LightPos(lc,i) ' <-- here are the copy
  next
  GetInvers(vector(0),pObject,l(0))
  LastObject=((World.nObjects-1)=oc) And (lc=2)
  CastShadow(pObject,Vector(0),LastObject)
Next
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

As far as I know, it's a bug that the call even compiles, it should be

Code: Select all

GetInvers(vector(),pObject,lp())
roook_ph
Posts: 402
Joined: Apr 01, 2006 20:50
Location: philippines
Contact:

Post by roook_ph »

I tested Basic 4gl unfortunately Im bad at opengl I tried to convert the walkdemo.gb to freebasic but all I got was error reports on winxp can someone helP?
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Post by KristopherWindsor »

roook_ph wrote:I tested Basic 4gl unfortunately Im bad at opengl I tried to convert the walkdemo.gb to freebasic but all I got was error reports on winxp can someone helP?
Possibly, if you post the code. ;-)
roook_ph
Posts: 402
Joined: Apr 01, 2006 20:50
Location: philippines
Contact:

Post by roook_ph »

I cant post the original I maybe liable for that but you can download it at their site basic4gl.net

heres my futile attempt

Code: Select all

' WalkDemo
'
' Written by Tom Mulgrew and Scott Brosious
'
' A simple wolfenstein like engine
option explicit

#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "crt.bi"          '' scanf is used to parse data file
#include once "fbgfx.bi"        '' for Scan code constants
#include once "createtex.bi"
const squareSize = 10      ' Size of each individual square (cube)
const false = 0
const true  = not false

data 1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,1,0,1,0,3
data 1,0,1,0,0,1,0,1,0,3
data 1,0,0,0,0,0,0,0,0,3
data 1,0,0,0,0,0,0,0,0,3
data 1,0,1,0,1,0,0,0,0,3
data 1,0,0,0,0,0,0,1,0,3
data 1,0,1,0,1,0,0,1,0,3
data 1,0,0,0,0,0,0,1,0,3
data 1,1,1,1,1,1,1,1,1,1

' Working variables
dim x, y, i, drawWall, hype as integer

' Read map size

dim as integer ardu

' Allocate map
const BASS = 0, NORTH = 1, SOUTH = 2, EAST = 3, WEST = 4
dim map(10000)

' Read it in
for y = 1 to 10
    for x = 1 to 10
    
        ' Read in the hype, then copy it to ALL the walls.
        read hype
        for i = 0 to 4
        ardu=(y*100)+(x*10)
            map(ardu+1) = hype
        next
    next
next

' Add in specific texture overrides here

map(330+NORTH) = 1
map(330+SOUTH) = 4
map(330+WEST) = 1
map(330+EAST) = 1       
' Load texture first
dim shared texture(0 to 2) as uinteger 

redim buffer(256*256*4+4) as ubyte '' Size = Width x Height x 4 bytes per pixel 
	bload exepath + "/data/Mud.bmp", @buffer(0)                      '' 
	texture(0) = CreateTexture(@buffer(0))   '' Nearest Texture
	texture(1) = CreateTexture(@buffer(0))                '' Linear Textur
	texture(2) = CreateTexture(@buffer(0))     '' MipMapped Texture
	'' Exit if error loading texture
	if texture(0) = 0 or texture(1) = 0 or texture(2) = 0 then end 1


' Enable texturing.
' (Note: We use GL_TEXTURE_2D, because the texture are 2D images.)
glEnable (GL_TEXTURE_2D)

dim as single camX
dim as single camY
dim as single camZ
dim as single camAng   ' Camera position and direction
camX = 10 * squareSize * .5 + 5
camY = 5
camZ = 10 * squareSize * .5

while true
    
    ' Draw scene
    glClear (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT) 
    glLoadIdentity ()
    glRotatef (camAng, 0, 1, 0)
    glTranslatef (camX, camY, camZ)
    glScalef (squareSize, squareSize, squareSize)
                                    
    ' Ceiling texture
                glBindTexture (GL_TEXTURE_2D, texture(2))
               
                glBegin (GL_QUADS)
                    glTexCoord2f ( 0,         0): glVertex3f (0,      1, 0)
                    glTexCoord2f ( 10,     0): glVertex3f (10,  1, 0)
                    glTexCoord2f ( 10, 10): glVertex3f (10,  1, 10)
                    glTexCoord2f ( 0,     10): glVertex3f (0,      1, 10)
                glEnd ()      
     
     ' Floor texture
                glBindTexture (GL_TEXTURE_2D, texture(3))
               
                glBegin (GL_QUADS)
                    glTexCoord2f ( 0,         0): glVertex3f (0,      0, 0)
                    glTexCoord2f ( 10,     0): glVertex3f (10,  0, 0)
                    glTexCoord2f ( 10, 10): glVertex3f (10,  0, 10)
                    glTexCoord2f ( 0,     10): glVertex3f (0,      0, 10)
                glEnd ()                                          
          
    for y = 2 to 10
        for x = 2 to 10                  
                         
            ' Look at the cell, and it's left hand neighbour
            ' If one is 0 and the other isn't, we need to draw a wall
            ardu=(y*100)+(x*10)
            if map(ardu+BASS) = 0 and map(ardu-10+BASS) <> 0 then
                drawWall = true
                hype = map(ardu+EAST)
            else
                if map(ardu+BASS) <> 0 and map(ardu-10+BASS) = 0 then
                    drawWall = true
                    hype = map(ardu+WEST)
                else
                    drawWall = false
                endif
            endif              
            if drawWall then
               
                glBindTexture (GL_TEXTURE_2D, texture(hype))
               
                glBegin (GL_QUADS)
                    glTexCoord2f ( 0, 0): glVertex3f ( x,  0, y)
                    glTexCoord2f ( 1, 0): glVertex3f ( x,  0, y+1)
                    glTexCoord2f ( 1, 1): glVertex3f ( x,  1, y+1)
                    glTexCoord2f ( 0, 1): glVertex3f ( x,  1, y)
                glEnd ()

             endif
            
            ' Compare the cell and it's above neighbour
            ' Same again
             ardu=(y*100)+(x*10)
             if map(ardu+BASS) = 0 and map(ardu-100+BASS) <> 0 then
                drawWall = true
                hype = map(ardu-100+SOUTH)
            else
                if map(ardu+BASS) <> 0 and map(ardu-100+BASS) = 0 then
                    drawWall = true
                    hype = map(ardu+NORTH)
                else
                    drawWall = false
                endif
            endif              
            if drawWall then
                
                glBindTexture (GL_TEXTURE_2D, texture(hype))
                            
                glBegin (GL_QUADS)
                    glTexCoord2f ( 0, 0): glVertex3f ( x,   0, y)
                    glTexCoord2f ( 1, 0): glVertex3f ( x+1, 0, y)
                    glTexCoord2f ( 1, 1): glVertex3f ( x+1, 1, y)
                    glTexCoord2f ( 0, 1): glVertex3f ( x,   1, y)
                glEnd ()
           
           endif
        next
    next  
    Screenset 1,0

    ' Move camera
    while MULTIKEY(SC_ESCAPE) = 0
        if multikey(SC_LEFT)  then camAng = camAng + 1: endif
        if multikey(SC_RIGHT) then camAng = camAng - 1: endif
        if multikey(SC_UP)    then
            camX = camX - sin (camAng) * .2
            camZ = camZ - cos (camAng) * .2
        endif
        if multikey(SC_DOWN)  then
            camX = camX + sin (camAng) * .2
            camZ = camZ + cos (camAng) * .2
        endif
    wend
wend

noticed I do something about themultidimensional array? Ive converted it to (y*100)+(x*10) there is no multidimensional array example I can find anywhere on freebasic thanx
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

Download: WalkDemo.zip

This version is for both Basic4GL and FreeBASIC

Joshy

WalkDemo.bas or WalkDemo.gb

Code: Select all

#include "Basic4GL.bi" ' <-- only in FreeBASIC

' WalkDemo
'
' Written by Tom Mulgrew and Scott Brosious
'
' A simple wolfenstein like engine

const squareSize = 10      ' Size of each individual square (cube)

data 10, 10                 ' Width and height
data 1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,1,0,1,0,3
data 1,0,1,0,0,1,0,1,0,3
data 1,0,0,0,0,0,0,0,0,3
data 1,0,0,0,0,0,0,0,0,3
data 1,0,1,0,1,0,0,0,0,3
data 1,0,0,0,0,0,0,1,0,3
data 1,0,1,0,1,0,0,1,0,3
data 1,0,0,0,0,0,0,1,0,3
data 1,1,1,1,1,1,1,1,1,1

' Working variables
dim x as integer, y as integer, i as integer, drawWall as integer, wallType as integer

' Read map size
dim xSize as integer, ySize as integer
read xSize, ySize

' Allocate map
const _BASE = 0, NORTH = 1, SOUTH = 2, EAST = 3, WEST = 4
dim map(xSize,ySize,4) as integer

' Read it in
for y = 1 to ySize
  for x = 1 to xSize
    ' Read in the type, then copy it to ALL the walls.
    read wallType
    for i = 0 to 4
      map(x,y,i) = wallType
    next
  next
next

' Add in specific texture overrides here
map(3,3,NORTH) = 1
map(3,3,SOUTH) = 4
map(3,3,WEST ) = 1
map(3,3,EAST ) = 1
       
' Load textures first
dim textures(4) as integer

textures(1) = LoadTexture ("Wall01.bmp")   
textures(2) = LoadTexture ("Ceil01.bmp")
textures(3) = LoadTexture ("Floor01.bmp")
textures(4) = LoadTexture ("Star.bmp") 


glMatrixMode  (GL_PROJECTION)
glLoadIdentity()
gluPerspective(50.0, WindowWidth()/WindowHeight(),0.1,1000)
glMatrixMode  (GL_MODELVIEW)
glEnable      (GL_DEPTH_TEST)

' Enable texturing.
' (Note: We use GL_TEXTURE_2D, because the textures are 2D images.)
glEnable (GL_TEXTURE_2D)
' Camera position and direction
dim camX as single, camY as single, camZ as single, camAng as single
camX = xSize * squareSize * .5 + 5
camY = 5
camZ = ySize * squareSize * .5

while not ScanKeyDown(VK_ESCAPE)
  ' Draw scene
  glClear        (GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT) 
  glLoadIdentity ()
  glRotatef      (-camAng, 0, 1, 0)
  glTranslatef   (-camX, -camY, -camZ)
  glScalef       (squareSize, squareSize, squareSize)
                                    
  ' Ceiling texture
  glBindTexture (GL_TEXTURE_2D, textures(2))
  glBegin (GL_QUADS)
    glTexCoord2f ( 0,         0): glVertex3f (0,      1, 0)
    glTexCoord2f ( xSize,     0): glVertex3f (xSize,  1, 0)
    glTexCoord2f ( XSize, ySize): glVertex3f (xSize,  1, ySize)
    glTexCoord2f ( 0,     ySize): glVertex3f (0,      1, ySize)
  glEnd ()      
     
  ' Floor texture
  glBindTexture (GL_TEXTURE_2D, textures(3))
  glBegin (GL_QUADS)
    glTexCoord2f ( 0,         0): glVertex3f (0,      0, 0)
    glTexCoord2f ( xSize,     0): glVertex3f (xSize,  0, 0)
    glTexCoord2f ( XSize, ySize): glVertex3f (xSize,  0, ySize)
    glTexCoord2f ( 0,     ySize): glVertex3f (0,      0, ySize)
  glEnd ()                                          
          
  for y = 2 to ySize
    for x = 2 to xSize                  
      ' Look at the cell, and it's left hand neighbour
      ' If one is 0 and the other isn't, we need to draw a wall
     if map(x,y,_BASE) = 0 and map(x-1,y,_BASE) <> 0 then
       drawWall = true
       wallType = map(x-1,y,EAST)
     else
       if map(x,y,_BASE) <> 0 and map(x-1,y,_BASE) = 0 then
         drawWall = true
         wallType = map(x,y,WEST)
       else
         drawWall = false
       end if
     end if              
     if drawWall then
       glBindTexture (GL_TEXTURE_2D, textures(wallType))
       glBegin (GL_QUADS)
         glTexCoord2f ( 0, 0): glVertex3f ( x,  0, y)
         glTexCoord2f ( 1, 0): glVertex3f ( x,  0, y+1)
         glTexCoord2f ( 1, 1): glVertex3f ( x,  1, y+1)
         glTexCoord2f ( 0, 1): glVertex3f ( x,  1, y)
       glEnd ()
     end if
            
     ' Compare the cell and it's above neighbour
     ' Same again
     if map(x,y,_BASE) = 0 and map(x,y-1,_BASE) <> 0 then
        drawWall = true
        wallType = map(x,y-1,SOUTH)
      else
        if map(x,y,_BASE) <> 0 and map(x,y-1,_BASE) = 0 then
          drawWall = true
          wallType = map(x,y,NORTH)
        else
          drawWall = false
        end if
      end if
              
      if drawWall then
        glBindTexture (GL_TEXTURE_2D, textures(wallType))
        glBegin (GL_QUADS)
          glTexCoord2f ( 0, 0): glVertex3f ( x,   0, y)
          glTexCoord2f ( 1, 0): glVertex3f ( x+1, 0, y)
          glTexCoord2f ( 1, 1): glVertex3f ( x+1, 1, y)
          glTexCoord2f ( 0, 1): glVertex3f ( x,   1, y)
        glEnd ()
      end if
    next
  next  
  SwapBuffers()
  Sleep(1000/100)
  ' Move camera
  if ScanKeyDown (VK_LEFT)  then camAng = camAng + 1: end if
  if ScanKeyDown (VK_RIGHT) then camAng = camAng - 1: end if
  if ScanKeyDown (VK_UP)    then
    camX = camX - sind (camAng) * .2
    camZ = camZ - cosd (camAng) * .2
  end if
  if ScanKeyDown (VK_DOWN)  then
    camX = camX + sind (camAng) * .2
    camZ = camZ + cosd (camAng) * .2
  end if
wend
end
"Basic4GL.bi"

Code: Select all

#include "fbgfx.bi"
using FB
#include "GL/glu.bi"

const True         =-1
const False        = 0
const PI           = 4*ATN(1)
const DEG2RAD      =  PI/180.0
#define SIND(v) SIN(v*DEG2RAD)
#define COSD(v) COS(v*DEG2RAD)
#define VK_ESCAPE SC_ESCAPE
#define VK_LEFT SC_LEFT
#define VK_RIGHT SC_RIGHT
#define VK_UP SC_UP
#define VK_DOWN SC_DOWN
#define ScanKeyDown(k) MultiKey(k)
#define SwapBuffers() Flip()


function WindowWidth as integer
  dim as integer w
  if screenptr=0 then 
    w=640
  else
    ScreenInfo w
  end if
  return w
end function
function WindowHeight as integer
  dim as integer h
  if screenptr=0 then 
    h=480
  else
    ScreenInfo ,h
  end if
  return h
end function
Function LoadTexture(FileName As String, mask As Integer=0) As Uinteger
  Dim As Uinteger Ptr buffer,p
  Dim As Integer  w,h,col,hfile
  Dim As Uinteger texture
  Dim As String   id="  "
  Dim As GLenum   format, minfilter, magfilter
  Dim As FB.Image Ptr Image

  hFile=Freefile()
  If Open(filename For Binary Access Read As hFile) Then
    Print "error: can't open [" & filename & "] !"
    Beep:Sleep:End
  End If
  Get #hfile,,id
  If id<>"BM" Then
    Print "error: [" & filename & "] isn't a bmp file!"
    Beep:Sleep:End
  End If
  Get #hfile,19,w
  Get #hfile,  ,h
  Close hFile
  If ((w And (w-1)) Or (h And (h-1))) Then
    Print "error: [" & filename & "] isn't power of 2 !"
    Beep:Sleep:End
  End If

  Image=ImageCreate(w,h,0)
  Bload Filename,image

  Buffer=callocate(w*h*4)
  p=Buffer

  glGenTextures 1, @texture
  glBindTexture GL_TEXTURE_2D, texture

  For y As Integer = h-1 To 0 Step -1
    For x As Integer = 0 To w-1
      col = Point(x,y,image)
      col = rgb(col And &hFF,(col Shr 8) And &hFF,(col Shr 16) And &hFF)
      If ((mask<>0) And (col = &hFF00FF)) Then
        *p = 0
      Else
        *p = col Or &hFF000000
      End If
      p += 1
    Next
  Next

  format    = GL_RGBA
  magfilter = GL_LINEAR
  minfilter = GL_LINEAR_MIPMAP_LINEAR
  gluBuild2DMipmaps GL_TEXTURE_2D,format,w,h,GL_RGBA,GL_UNSIGNED_BYTE, buffer
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, minfilter
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, magfilter
  Deallocate buffer
  Return texture
End Function
ScreenRes WindowWidth,WindowHeight,16,,GFX_OPENGL
Last edited by D.J.Peters on Oct 03, 2017 6:03, edited 1 time in total.
Sisophon2001
Posts: 1706
Joined: May 27, 2005 6:34
Location: Cambodia, Thailand, Lao, Ireland etc.
Contact:

Post by Sisophon2001 »

So the languages are so similar that (almost) the same code compiles in both? Interesting.

Garvan
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

two primary things are not the same BYREF and define of return type

FreeBASIC: (ByRef name1 as DataType,name2 as DataType)
Basic4GL: (&name1 as DataType,name2 as DataType)
FreeBASIC: function name1() as integer
Basic4GL: function name1()
FreeBASIC:function name2() as single
Basic4GL:function name2#()

return ' exit from sub
return Value ' exit from function
are same in both

Joshy
roook_ph
Posts: 402
Joined: Apr 01, 2006 20:50
Location: philippines
Contact:

Post by roook_ph »

youve ported a program to freebasic?? *respect *
There are full games on that site cant wait to test all that
I know there are a lot of shortcuts in that language maybe I can addsome thanks for the help
roook_ph
Posts: 402
Joined: Apr 01, 2006 20:50
Location: philippines
Contact:

Post by roook_ph »

ooops rejoiced too quickly basic4gl.bi wont compile cleanly the corridor demo, the pool demo and my favorite quakes 3d format demo. All except for 1 walkdemo but at least its faster

thanks joshy
Post Reply