Freebasic is not smooth in graphics

General discussion for topics related to the FreeBASIC project or its community.
nenver
Posts: 1
Joined: Mar 26, 2020 12:03

Freebasic is not smooth in graphics

Post by nenver »

Hello everybody.
I have seen dozens of games and demos written in this language and none of them ever had the fluid movement of sprites. Did I miss something or is it impossible to get fluid graphics?
in c ++ there is the vsync () command which is not there.
Thanks in advance from Italy.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Freebasic is not smooth in graphics

Post by badidea »

Which OS are you using?
On my linux laptop vsync (ScreenSync) does nothing, but also VLC plays movies with screen tearing. So possibly a driver issue here.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Freebasic is not smooth in graphics

Post by paul doe »

nenver wrote:...
I have seen dozens of games and demos written in this language and none of them ever had the fluid movement of sprites. Did I miss something or is it impossible to get fluid graphics?
Have you tested this one? No GPU, just the standard FreeBasic functionality. Runs pretty smoothly even on a 600Mhz (suffers from A LOT of screen tearing on those, though).
nenver wrote:...
in c ++ there is the vsync () command which is not there.
...
Which won't do you any good, unless its implemented in a certain way. See this article for an explanation on screen tearing (aka 'stuttering'), why does it happen, and how to solve it:

The elusive frame timing

FreeBasic's native graphics capabilities are pretty poor, indeed. But there are many alternatives. For example:

Raylib headers/binaries/examples
Landeel
Posts: 777
Joined: Jan 25, 2007 10:32
Location: Brazil
Contact:

Re: Freebasic is not smooth in graphics

Post by Landeel »

I agree. That's why I use OpenGL instead of fbgfx.
The learning curve is a little steeper, but it's pretty smooth.
Check out NeHe tutorials. (examples/graphics/OpenGL/NeHe)
You can activate vsync using extensions: viewtopic.php?f=7&t=13715&p=119261&hili ... gl#p119261
Some of my games are here, source included: https://sourceforge.net/u/clebercasali/profile/
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Freebasic is not smooth in graphics

Post by BasicCoder2 »

It would be nice to have extensive FreeBASIC tutorials for using OpenGL or SDL2.
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Freebasic is not smooth in graphics

Post by caseih »

Modern OpenGL requires the programmer to keep track of and manipulate the various transformation matrices, and heavily relies on these matrices and vectors for nearly everything. In C++ I used Qt's QMatrix4x4, and also QVector4D, QVector3D, and QVector2D class to do that, which has convenient methods like identity, perspective, project, etc, and can multiply matrices using an operator overload. Has anyone made an FB class that does something similar? Could be a fun exercise for someone who wants to learn this stuff to make such a class.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Freebasic is not smooth in graphics

Post by paul doe »

caseih wrote:...
Has anyone made an FB class that does something similar? Could be a fun exercise for someone who wants to learn this stuff to make such a class.
https://github.com/glasyalabolas/fb-fra ... /fbfw/math

That's mine (there are others too; Joshy for example also has one). It's part of a bigger framework, but I hadn't finished porting everything I have yet. Namely, quaternions, geometry, all the SVG stuff...
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Freebasic is not smooth in graphics

Post by paul doe »

BasicCoder2 wrote:It would be nice to have extensive FreeBASIC tutorials for using OpenGL or SDL2.
What for? There you have the Raylib headers ported by IchMagBier. I ported several examples and provided a link to the binaries. I've also built it statically and have it available if requested. Do you see much activity on that thread?
Having 'extensive' tutorials about OpenGL and/or SDL2 at this point would be a huge waste of time for the few people remaining in the community that can actually write them. Want to get the ball rolling? Try to at least write something and post it here to review/comment/document it for others.

Regarding OpenGL: as caseih pointed out, modern OpenGL requires extensive knowledge of vectors, matrices and a lot of other concepts. You can start with those (use my implementation or any other of your liking) and try to reimplement, say, the paperplane demo but without using globals. Only when you're comfortable with those concepts, then you can move to rendering with OpenGL (shaders, objects, buffers, etc)
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Freebasic is not smooth in graphics

Post by BasicCoder2 »

@paul doe
At the time I thought it was just a ray tracing program. Do you see it as a substitute for fbgfx rather than SDL2?
Also all those nice 3d models are not things I would be able to draw. I played around with Blender for a while but soon realised making all those 3d images and animations was beyond me. My artistic talent is limited to making some crude 2d animations.

The original post suggested fbgfx could not produce the fluid movement of sprites. My 2d sprites seemed fluid enough so I wasn't sure what the difference was when using OpenGL. My understanding of SDL2 was its wide use and its innate sound commands something FB lacks.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Freebasic is not smooth in graphics

Post by paul doe »

BasicCoder2 wrote:...
Do you see it as a substitute for fbgfx rather than SDL2?
...
Indeed. As Joshy pointed out before, it isn't particularly advanced but it does have some nice functionality that fits neatly into the 'BASIC' mindset (doEverythingForMe() kind of coding). SDL2 serves a similar purpose but has a different scope.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Freebasic is not smooth in graphics

Post by BasicCoder2 »

paul doe wrote: ... the 'BASIC' mindset (doEverythingForMe() kind of coding).
Of course I have the 'BASIC' mindset that is why I am using FreeBASIC instead of C++ :)
I once used to use C++ with the Bloodshed Dev-C++ IDE which for a while had these "packages" that would install libraries for you.
The problem for a lot of casual hobby programmers is they don't have time to learn all the intricate long winded paper work involved to get something up and running. By the way the other hll languages like Python, Processing and Arduino C that I have been playing with also have the same doEverythingForMe coding.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Freebasic is not smooth in graphics

Post by Tourist Trap »

caseih wrote: Has anyone made an FB class that does something similar? Could be a fun exercise for someone who wants to learn this stuff to make such a class.
Hi,

D.J.Peters tends to post stuff like that:

Code: Select all

'https://www.freebasic.net/forum/viewtopic.php?f=7&t=22838&p=200294&hilit=matri%2A#p200294

'#define _DEBUG

#ifdef _DEBUG
  #define dprint(msg) : scope : dim as integer h=FreeFile() : open err for output as #h:print #h,msg:close #h : end scope
#else
  #define dprint(msg) :
#endif

'        32 bit 16,16 fixed point math

' 0111111111111111,000000000000000 = 32767
'                ...
'  100000000000000,000000000000000 = 8192
'   10000000000000,000000000000000 = 4096
'    1000000000000,000000000000000 = 2048
'     100000000000,000000000000000 = 1024
'      10000000000,000000000000000 = 512
'        100000000,000000000000000 = 256
'         10000000,000000000000000 = 128
'          1000000,000000000000000 = 64
'           100000,000000000000000 = 32
'            10000,000000000000000 = 16
'             1000,000000000000000 = 8
'              100,000000000000000 = 4
'               10,000000000000000 = 2
'                1,000000000000000 = 1
'                0,111111111111111 = 0.9999847
'                0,100000000000000 = 0.5
'                0,010000000000000 = 0.25
'                0,001000000000000 = 0.125
'                0,000100000000000 = 0.0625
'                0,000010000000000 = 0.03125
'                0,000001000000000 = 0.015625
'                0,000000100000000 = 0.0078125
'                0,000000010000000 = 0.00390625
'                0,000000001000000 = 0.001953125
'                0,000000000100000 = 0.0009765625
'                0,000000000010000 = 0.00048828125
'                0,000000000001000 = 0.000244140625
'                0,000000000000100 = 0.0001220703125
'                0,000000000000010 = 0.00006103515625
'                0,000000000000001 = 0.000030517578125


' 0111111111111111,000000000000000 = 32767.0
'                ...
' 0000000000000100,000000000000000 = 4.0
' 0000000000000010,000000000000000 = 2.0
' 0000000000000001,000000000000000 = 1.0
' 0000000000000000,000000000000000 = 0.0
' 1111111111111111,000000000000000 =-1.0
' 1111111111111110,000000000000000 =-2.0
' 1111111111111100,000000000000000 =-4.0
'                ...
' 1000000000000000,0               =-32768.0

type FP32 as long

#define TAB_MAX (1024) ' !!! must be power of two !!!
#define TAB_MASK (TAB_MAX-1)

dim shared as FP32 FP32SINTAB(TAB_MASK)
dim shared as FP32 FP32COSTAB(TAB_MASK)

#define FONE 65536   ' 1.0    in fixed point
#define FPI  205887  ' PI     in fixed point
#define FPI2 411775  ' PI*2.0 in fixed point


' r=S2F(x) single to fixed
#define S2F(x_) ((x_)*(1 shl 16))

' r=f/(1 shl 16) fixed to single
#define F2S(x_) ((x_)/65536.0f)

' r=integer to fixed
#define I2F(x_) ((x_) shl 16)

' r=fixed to integer
#define F2I(x_) ((x_) shr 16)

' r=rounded(fixed) to integer
#define RF2I(x_)(((x_)+&H8000) shr 16)

' r=x+y
#define FAdd(x_,y_) ((x_)+(y_))

' r=x-y
#define FSub(x_,y_) ((x_)-(y_))

' r=x*y
#define FMul(x_, y_) ( (clngint(x_)*(y_)) shr 16)

' r=x/y
#define FDiv(x_, y_) ( ((clngint(x_) shl 16)) / (y_))

' r=1.0/x
#define FInv(x_) (1 shl 16)/(x_)

' r=x^x
#define FSqrd(x_) FMul(x_,x_)

' create sin cos fixed point array
sub _module_init_ constructor
  dim as single w,s=atn(4)/TAB_MAX
  for i as integer =0 to TAB_MASK
    dim as single si=sin(w),co=cos(w)
    FP32SINTAB(i)=S2F(si)
    FP32COSTAB(i)=S2F(co)
    w+=s
  next
end sub
' fixed point squarroot
function FSqr(x as FP32) as FP32
  dim as FP32 t=any, q=0, b=&H40000000, r=x
  while( b > &H40 )
    t = q + b
    if ( r >= t ) then r-=t : q=t+b
    r shl= 1
    b shr= 1
  wend
  q shr= 8
  return q
end function

' fixed point sin
function FSin(ang as integer) as FP32
  ang and=TAB_MASK
  return FP32SINTAB(ang)
end function
' fixed point cos
function FCos(ang as integer) as FP32
  ang and=TAB_MASK
  return FP32SINTAB(ang)
end function
' fixed point tan
function FTan(ang as integer) as FP32
  ang and=TAB_MASK
  return (FDiv(FP32SINTAB(ang) shl 16, FP32COSTAB(ang)) shr 16)
end function
' fixed point cos and sin
sub FCosSin(ang as integer,pCos as FP32 ptr,pSin as FP32 ptr)
  ang and=TAB_MASK
  *pCos=FP32COSTAB(ang)
  *pSin=FP32SINTAB(ang)
end sub

' fixed point 3D vector
type VECTOR
  declare constructor
  ' pixel to VECTOR
  declare constructor(byval ui as ulong)
  declare constructor(byval sx as single,_
                      byval sy as single,_
                      byval sz as single)

  declare constructor(byref fx as FP32,_
                      byref fy as FP32,_
                      byref fz as FP32)

  declare constructor(byref v as VECTOR)

  declare operator cast as string
  ' VECTOR to pixel color pset(x,y),vector
  declare operator cast as ulong

  declare operator +=(byref v as VECTOR)

  declare operator -=(byref v as VECTOR)

  declare operator *=(byref s as FP32)

  declare operator /=(byref s as FP32)

  declare function LengthSqrd as FP32

  declare function Length as FP32

  declare function Distance(byref v as VECTOR) as FP32

  declare function Normalized as VECTOR

  declare sub      Normalize
  as FP32 x=any,y=any,z=any
end type
dim shared as VECTOR _v

constructor VECTOR (byval ui as ulong)
  dprint("VECTOR(pixel)")
  dim as long r = ui and 255 : ui shr= 8
  dim as long g = ui and 255 : ui shr= 8
  dim as long b = ui and 255
  x=I2F(r) : y=I2F(g) : z=I2F(b)
end constructor

constructor VECTOR
  dprint("VECTOR()")
  x=0:y=0:z=0
end constructor

constructor VECTOR(sx as single,_
                   sy as single,_
                   sz as single)
  dprint("VECTOR(s,s,s)")
  x=S2F(sx) : y=S2F(sy) : z=S2F(sz)
end constructor

constructor VECTOR(byref fx as FP32,_
                   byref fy as FP32,_
                   byref fz as FP32)
  dprint("VECTOR(fp,fp,fp)")
  x=fx : y=fy : z=fz
end constructor

constructor VECTOR(byref v as VECTOR)
  dprint("VECTOR(VECTOR)")
  x=v.x : y=v.y : z=v.z
end constructor

operator VECTOR.cast as ulong
  dprint("pixel=VECTOR")
  dim as ulong ur=any,ug=any,ub=any
  dim as single s = F2S(x)
  if s<0 then s = -s
  if s=0 then
    ur=0
  elseif s>1 then
    ur=255
  else
    ur=s*255
  end if
  s = F2S(y)
  if s<0 then s = -s
  if s=0 then
    ug=0
  elseif s>1 then
    ug=255
  else
    ug=s*255
  end if
  s = F2S(z)
  if s<0 then s = -s
  if s=0 then
    ub=0
  elseif s>1 then
    ub=255
  else
    ub=s*255
  end if
  operator = RGB(ur,ug,ub)
end operator

operator VECTOR.cast as string
  return "V(" & F2S(x) & "," & F2S(y) & "," & F2S(z) & ")"
end operator

operator VECTOR.+=(byref v as VECTOR)
  dprint("+=v")
  x+=v.x : y+=v.x : z+=v.x
end operator

operator VECTOR.-=(byref v as VECTOR)
  x-=v.x : y-=v.x : z-=v.x
end operator

operator VECTOR.*=(byref s as FP32)
  dprint("*=s")
  x=fmul(x,s)
  y=fmul(y,s)
  z=fmul(z,s)
end operator

operator VECTOR./=(byref s as FP32)
  dprint("/=s")
  if s=0 then
    x=0:y=0:z=0
  else
    dim as FP32 inv=FInv(s)
    x=fmul(x,inv)
    y=fmul(y,inv)
    z=fmul(z,inv)
  end if
end operator

operator +(byref l as VECTOR,byref r as VECTOR) as VECTOR
  dprint("v+v")
  return type<VECTOR>(l.x+r.x, l.y+r.y, l.z+r.z)
end operator

operator -(byref l as VECTOR,byref r as VECTOR) as VECTOR
  dprint("v-v")
  return type<VECTOR>(l.x-r.x, l.y-r.y, l.z-r.z)
end operator

operator *(byref l as VECTOR,byref r as FP32) as VECTOR
  dprint("v*s")
  return type<VECTOR>(fmul(l.x,r),fmul(l.y,r),fmul(l.z,r))
end operator

operator *(byref l as FP32, byref r as VECTOR) as VECTOR
  dprint("s*v")
  return type<VECTOR>(fmul(l,r.x),fmul(l,r.y),fmul(l,r.z))
end operator

' dot product
operator *(byref l as VECTOR,byref r as VECTOR) as FP32
  dprint("v*v")
  return fmul(l.x,r.x)+fmul(l.y,r.y)+fmul(l.z,r.z)
end operator

' cross product
operator \(byref l as VECTOR,byref r as VECTOR) as VECTOR
  dprint("v\v")
  return type<VECTOR>(fmul(l.y,r.z)-fmul(l.z,r.y), _
                      fmul(l.z,r.x)-fmul(l.x,r.z), _
                      fmul(l.x,r.y)-fmul(l.y,r.x))
end operator

function VECTOR.LengthSqrd as FP32
  dprint("VECTOR.LengthSqrd()")
  return fsqrd(x)+fsqrd(y)+fsqrd(z)
end function

function VECTOR.Length as FP32
  dprint("VECTOR.Length()")
  return fsqr(fsqrd(x)+fsqrd(y)+fsqrd(z))
end function

function VECTOR.Distance(byref other as VECTOR) as FP32
  dprint("VECTOR.Distance(VECTOR)")
  _v = this-other
  var _l = fsqrd(_v.x) + fsqrd(_v.y) + fsqrd(_v.z)
  if _l<>0 then  _l = fsqr(_l)
  return _l
end function

function VECTOR.Normalized as VECTOR
  dprint("VECTOR.Normalized()")
  var _l = fsqrd(x)+fsqrd(y)+fsqrd(z)
  if _l=0 then
    _v.x=0:_v.y=0:_v.z=0
  else
    _l=finv(fsqr(_l))
    _v.x=fmul(x,_l)
    _v.y=fmul(y,_l)
    _v.z=fmul(z,_l)
  end if
  return _v
end function

sub VECTOR.Normalize
  dprint("VECTOR.Normalize")
  var _l = fsqrd(x)+fsqrd(y)+fsqrd(z)
  if _l=0 then
    x=0 : y=0 : z=0
  else
    _l=FInv(fsqr(_l))
    x=fmul(x,_l)
    y=fmul(y,_l)
    z=fmul(z,_l)
  end if
end sub

' a 4x3 fixed point matrix
' last row asumed 0,0,0,1
type MATRIX
  declare constructor

  declare constructor(byref m as MATRIX)

  declare constructor(byref r00 as FP32,byref r01 as FP32,byref r02 as FP32, _
                      byref r10 as FP32,byref r11 as FP32,byref r12 as FP32, _
                      byref r20 as FP32,byref r21 as FP32,byref r22 as FP32)

  declare constructor(byref r00 as FP32,byref r01 as FP32,byref r02 as FP32,byref r03 as FP32, _
                      byref r10 as FP32,byref r11 as FP32,byref r12 as FP32,byref r13 as FP32, _
                      byref r20 as FP32,byref r21 as FP32,byref r22 as FP32,byref r23 as FP32)

  declare constructor(byref a as VECTOR, _
                      byref b as VECTOR, _
                      byref c as VECTOR)

  declare constructor(byref a as VECTOR, _
                      byref b as VECTOR, _
                      byref c as VECTOR, _
                      byref t as VECTOR)

  declare sub Identity

  declare sub Scale    (byref s as FP32)

  declare sub Scale    (byref v as VECTOR)

  declare sub Translate(byref v as VECTOR)

  declare sub Pitch    (byval ang as integer)

  declare sub Yaw      (byval ang as integer)

  declare sub Roll     (byval ang as integer)

  declare sub PYR      (byval p as integer, _
                        byval y as integer, _
                        byval r as integer)

  declare function Rotate   (byref v as VECTOR) as VECTOR

  declare function Transform(byref v as VECTOR) as VECTOR
 
  as FP32 m00=any,m01=any,m02=any,m03=any
  as FP32 m10=any,m11=any,m12=any,m13=any
  as FP32 m20=any,m21=any,m22=any,m23=any
end type
dim shared as MATRIX _p,_y,_r
constructor MATRIX
end constructor

constructor MATRIX(byref m as MATRIX)
  dprint("MATRIX(MATRIX)")
  m00=m.m00:m01=m.m01:m02=m.m02:m03=m.m03
  m10=m.m10:m11=m.m11:m12=m.m12:m13=m.m13
  m20=m.m20:m21=m.m21:m22=m.m22:m23=m.m23
end constructor

constructor MATRIX(byref r00 as FP32,byref r01 as FP32,byref r02 as FP32, _
                   byref r10 as FP32,byref r11 as FP32,byref r12 as FP32, _
                   byref r20 as FP32,byref r21 as FP32,byref r22 as FP32)
  dprint("MATRIX(FP,...)")
  m00=r00:m01=r01:m02=r02:m03=0
  m10=r10:m11=r11:m12=r12:m13=0
  m20=r20:m21=r21:m22=r22:m23=0
end constructor


constructor MATRIX(byref r00 as FP32,byref r01 as FP32,byref r02 as FP32,byref r03 as FP32, _
                   byref r10 as FP32,byref r11 as FP32,byref r12 as FP32,byref r13 as FP32, _
                   byref r20 as FP32,byref r21 as FP32,byref r22 as FP32,byref r23 as FP32)
  dprint("MATRIX(FP,...)")
  m00=r00:m01=r01:m02=r02:m03=r03
  m10=r10:m11=r11:m12=r12:m13=r13
  m20=r20:m21=r21:m22=r22:m23=r23
end constructor

constructor MATRIX(byref a as VECTOR, _
                   byref b as VECTOR, _
                   byref c as VECTOR)
  dprint("MATRIX(VECTOR,...)")
  m00=a.x : m01=a.y : m02=a.z : m03=0
  m10=b.x : m11=b.y : m12=b.z : m13=0
  m20=c.x : m21=c.y : m22=c.z : m23=0
end constructor

constructor MATRIX(byref a as VECTOR, _
                   byref b as VECTOR, _
                   byref c as VECTOR, _
                   byref t as VECTOR)
  dprint("MATRIX(VECTOR,...)")
  m00=a.x : m01=a.y : m02=a.z : m03=t.x
  m10=b.x : m11=b.y : m12=b.z : m13=t.y
  m20=c.x : m21=c.y : m22=c.z : m23=t.z
end constructor

sub MATRIX.Identity
  dprint("MATRIX.Identity")
  m00=FONE: m01=0   : m02=0   : m03=0
  m10=0   : m11=FONE: m12=0   : m13=0
  m20=0   : m21=0   : m22=FONE: m23=0
end sub

sub MATRIX.Scale(byref s as FP32)
  dprint("MATRIX.Scale(s)")
  m00=s: m01=0: m02=0: m03=0
  m10=0: m11=s: m12=0: m13=0
  m20=0: m21=0: m22=s: m23=0
end sub

sub MATRIX.Scale(byref v as VECTOR)
  dprint("MATRIX.Scale(VECTOR)")
  m00=v.x: m01=0  : m02=0  : m03=0
  m10=0  : m11=v.y: m12=0  : m13=0
  m20=0  : m21=0  : m22=v.z: m23=0
end sub

sub MATRIX.Translate(byref v as VECTOR)
  dprint("MATRIX.Translate(VECTOR)")
  m00=FONE: m01=0   : m02=0   : m03=v.x
  m10=0   : m11=FONE: m12=0   : m13=v.y
  m20=0   : m21=0   : m22=FONE: m23=v.z
end sub

sub MATRIX.Pitch(byval ang as integer)
  dprint("MATRIX.Pitch(ang)")
  ang and=TAB_MASK
  var s=FP32SINTAB(ang)
  var c=FP32COSTAB(ang)
  m00=FONE: m01= 0 : m02= 0: m03=0
  m10=0   : m11= c : m12= s: m13=0
  m20=0   : m21=-s : m22=-c: m23=0
end sub

sub MATRIX.Yaw(byval ang as integer)
  dprint("MATRIX.Yaw(ang)")
  ang and=TAB_MASK
  var s=FP32SINTAB(ang)
  var c=FP32COSTAB(ang)
  m00= c: m01= 0   : m02=-s: m03=0
  m10= 0: m11= FONE: m12= 0: m13=0
  m20=-s: m21= 0   : m22= c: m23=0
end sub

sub MATRIX.Roll(byval ang as integer)
  dprint("MATRIX.Roll(ang)")
  ang and=TAB_MASK
  var s=FP32SINTAB(ang)
  var c=FP32COSTAB(ang)
  m00= c: m01= s: m02= 0  : m03=0
  m10=-s: m11= c: m12= 0  : m13=0
  m20= 0: m21= 0: m22=FONE: m23=0
end sub

operator *(byref l as MATRIX,byref r as MATRIX) as MATRIX
  dprint("MATRIX*MATRIX")
  _p.m00 = fmul(l.m00,r.m00) + fmul(l.m01,r.m10) + fmul(l.m02,r.m20)
  _p.m01 = fmul(l.m00,r.m01) + fmul(l.m01,r.m11) + fmul(l.m02,r.m21)
  _p.m02 = fmul(l.m00,r.m02) + fmul(l.m01,r.m12) + fmul(l.m02,r.m22)
  _p.m03 = fmul(l.m00,r.m03) + fmul(l.m01,r.m13) + fmul(l.m02,r.m23) + l.m03

  _p.m10 = fmul(l.m10,r.m00) + fmul(l.m11,r.m10) + fmul(l.m12,r.m20)
  _p.m11 = fmul(l.m10,r.m01) + fmul(l.m11,r.m11) + fmul(l.m12,r.m21)
  _p.m12 = fmul(l.m10,r.m02) + fmul(l.m11,r.m12) + fmul(l.m12,r.m22)
  _p.m13 = fmul(l.m10,r.m03) + fmul(l.m11,r.m13) + fmul(l.m12,r.m23) + l.m13

  _p.m20 = fmul(l.m20,r.m00) + fmul(l.m21,r.m10) + fmul(l.m22,r.m20)
  _p.m21 = fmul(l.m20,r.m01) + fmul(l.m21,r.m11) + fmul(l.m22,r.m21)
  _p.m22 = fmul(l.m20,r.m02) + fmul(l.m21,r.m12) + fmul(l.m22,r.m22)
  _p.m23 = fmul(l.m20,r.m03) + fmul(l.m21,r.m13) + fmul(l.m22,r.m23) + l.m23
  operator = _p
end operator

sub MATRIX.PYR(byval p as integer, _
               byval y as integer, _
               byval r as integer)
  dprint("MATRIX.PYR(p,y,r)")
  _p.Pitch(p)
  _y.Yaw  (y)
  _r.Roll (r)
  this=_p*_y*_r
end sub

function MATRIX.Rotate(byref v as VECTOR) as VECTOR
  dprint("MATRIX.Rotate")
  return type<VECTOR>(fmul(m00,v.x) + fmul(m01,v.y) + fmul(m02,v.z), _
                      fmul(m10,v.x) + fmul(m11,v.y) + fmul(m12,v.z), _
                      fmul(m20,v.x) + fmul(m21,v.y) + fmul(m22,v.z))
end function

function MATRIX.Transform(byref v as VECTOR) as VECTOR
  dprint("MATRIX.Transform")
  return type<VECTOR>(fmul(m00,v.x) + fmul(m01,v.y) + fmul(m02,v.z) + m03, _
                      fmul(m10,v.x) + fmul(m11,v.y) + fmul(m12,v.z) + m13, _
                      fmul(m20,v.x) + fmul(m21,v.y) + fmul(m22,v.z) + m23)
end function


type RAY
  declare constructor
  declare constructor(byref o as VECTOR,byref d as VECTOR)
  as VECTOR Origin
  as VECTOR Direction
  as FP32   ODot
  as FP32   DDot
  as FP32   t
end type

constructor RAY
  dprint("RAY()")
  Direction.z=FONE
  DDot=fsqrd(Direction.z)
end constructor

constructor RAY(byref o as VECTOR, _
                byref d as VECTOR)
  dprint("RAY(VECTOR,VECTOR)")
  Origin   =o
  Direction=d
  ODot=fsqrd(Origin.x)+fsqrd(Origin.y)+fsqrd(Origin.z)
  DDot=fsqrd(Direction.x)+fsqrd(Direction.y)+fsqrd(Direction.z)
end constructor

type SPHERE
  declare constructor
  declare constructor(byref c as VECTOR, _
                      byval r as FP32)
  declare constructor(byval cx as single, _
                      byval cy as single, _
                      byval cz as single, _
                      byval r  as single)
  declare function Intersection(byref r as RAY) as boolean
  as VECTOR Center
  as FP32   Radius,R2,CDot
end type

constructor SPHERE
  dprint("SPHERE()")
  Radius=S2F(0.5)
  R2=fsqrd(Radius)
end constructor

constructor SPHERE(byref c as VECTOR, _
                   byval r as FP32)
  dprint("SPHERE(VECTOR,FP32)")
  Center=c
  Radius=r
  R2=fsqrd(Radius)
  CDot=fsqrd(Center.x)+fsqrd(Center.y)+fsqrd(Center.z)
end constructor

constructor SPHERE(byval cx as single, _
                   byval cy as single, _
                   byval cz as single, _
                   byval r  as single)
  dprint("SPHERE(sX,sY,sZ,sRadius)")
  Center.x=S2F(cx)
  Center.y=S2F(cy)
  Center.z=S2F(cz)
  Radius=S2F(r)
  R2=fsqrd(Radius)
  CDot=fsqrd(Center.x)+fsqrd(Center.y)+fsqrd(Center.z)
end constructor

function SPHERE.Intersection(byref r as RAY) as boolean
  dim as FP32 L=r.DDot
  If L=0 Then beep:return false
  dim as FP32 M=fmul(fmul(&H20000,r.Direction.x),r.Origin.X-Center.X) _
               +fmul(fmul(&H20000,r.Direction.y),r.Origin.Y-Center.Y) _
               +fmul(fmul(&H20000,r.Direction.z),r.Origin.Z-Center.Z)
  dim as FP32 N = CDot+r.ODot - fmul(&H20000,Center*r.Origin) - R2
  dim as FP32 T = fsqrd(M) - fmul(&H40000 ,fmul(L,N))
  if (T<0) then return false
  L=fmul(&H20000,L)
  if (T=0) then
    T = fdiv(-M,L)
    if (T<=0) then return false
    r.t=T
    return true
  else ' two hit points
    T=fsqr(T)
    dim as FP32 T1 = fdiv(-M - T,L)
    dim as FP32 T2 = fdiv(-M + T,L)
    If (T1 < &B100000) Then T1 = 0
    If (T2 < &B100000) Then T2 = 0
    ' no hits
    If (t1=0 andalso t2=0) Then return false
    ' both are ok
    If T1 > 0 andalso T2 > 0 Then
      If T1 < T2 Then
        r.t=T1
      else
        r.t=T2
      end if
    Else ' one are ok
      If T1 > 0 Then
        r.t=T1
      Else
        r.t=T2
      end if
    End If
    return true
  End If
end function

dim as SPHERE Sph = SPHERE(VECTOR(S2F(0),S2F(0),S2F(2)),S2F(.5))
dim as VECTOR Origin
dim as VECTOR Direction


dim as integer scr_w,scr_h,scr_p
screeninfo scr_w,scr_h
scr_w*=0.5
scr_h*=0.5
screenres scr_w,scr_h,32


screeninfo scr_w,scr_h,,,scr_p

dim as single xr,yr

scr_p shr=2

if scr_w>scr_h then
  xr=scr_w/scr_h
  yr=1.0
else
  yr=scr_w/scr_h
  xr=1.0
end if
dim as single xs=xr/scr_w
dim as single ys=yr/scr_h
xr*=0.5
yr*=0.5

Origin.x = S2F(0.0)
Origin.y = S2F(0.0)
Origin.z = S2F(-.5)

Direction.z=S2F(2.4)

screenlock
dim as ulong ptr row=screenptr()
for y as single=0 to scr_h-1
  Direction.y=S2F(-yr+y*ys)
  dim as ulong ptr pixel = row
  for x as single=0 to scr_w-1
    Direction.x=S2F(-xr+x*xs)
    dim as RAY r=Ray(Origin,Direction)
    if Sph.Intersection(r) then
      dim as VECTOR h=Origin+Direction*r.t
      dim as VECTOR N=h-sph.center
      pixel[x]=N ' cast vector to RGB (ulong)
    end if
  next
  row+=scr_p ' row += pitch in pixels
next
screenunlock
sleep

viewtopic.php?f=7&t=22838&p=200294&hili ... 2A#p200294
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Freebasic is not smooth in graphics

Post by dodicat »

Here is an openGL pendulum and a gfx pendulum together.

Code: Select all


#include "windows.bi"
#include "GL\glu.bi"
Dim Shared As Integer refresh_rate

Dim Shared As Integer w,h

Sub glcircle(x As Single,y As Single,rx As Single,ry As Single,clr As Ulong) Export
    Const pi2 = 8*Atn(1),st=pi2/(60)
    glend
    glBegin GL_TRIANGLE_FAN
   glcolor3ub(Cast(Ubyte Ptr,@clr)[2],Cast(Ubyte Ptr,@clr)[1],Cast(Ubyte Ptr,@clr)[0]) 
    For a As Single=0 To pi2  Step st
        glVertex2f (x)+Cos(a)*(rx),(y)+Sin(a)*(ry)
    Next
    glEnd
End Sub

Sub glline(x1 As Long,y1 As Long,x2 As Long,y2 As Long,clr As Ulong)
    glend
    glbegin gl_lines
     glcolor3ub(Cast(Ubyte Ptr,@clr)[2],Cast(Ubyte Ptr,@clr)[1],Cast(Ubyte Ptr,@clr)[0]) 
     glvertex2f x1,y1
     glvertex2f x2,y2
    glend
    End Sub

Sub LineByAngle(x As Long,y As Long,angle As Single,length As Single,col As Ulong,Byref x2 As Long=0,Byref y2 As Long=0)
    x2=x+length*Cos(angle)
    y2=y-length*Sin(angle)
   Line(x,y)-(x2,y2),col 
   Circle(x2,y2),50,Rgb(200,0,0),,,,f
End Sub

Sub glLineByAngle(x As Long,y As Long,angle As Single,length As Single,col As Ulong,Byref x2 As Long=0,Byref y2 As Long=0)
    x2=x+length*Cos(angle)
    y2=y-length*Sin(angle)
   glline(x,y,x2,y2,col )
   glcircle(x2,y2,50,50,Rgb(200,0,0))
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Sub gfxpendulum(a As Single)
    Const pi=4*Atn(1)
    Dim As Long x,y
     LineByAngle(w/4,120,.3*Sin(a)-pi/2,.75*h,Rgb(200,0,0),x,y)
    End Sub
    
    Sub glpendulum(a As Single)
    Const pi=4*Atn(1)
    Dim As Long x,y
     glLineByAngle(3*w/4,h-120,.3*Sin(a)-3*pi/2,.75*h,Rgb(200,0,0),x,y)    
    End Sub
    
    Sub GLinit
    glOrtho (0,w,h,0, -1, 1)
    glDisable (GL_DEPTH_TEST)
    glEnable (GL_LINE_SMOOTH)
    glLineWidth(1)
    End Sub

'from glwin2
Sub SetUpglTOfbscreen(Byref pPixels As Ubyte Ptr,x As Long,y As Long )
Dim As Any Ptr       MemoryDC,ScreenDC 'HDC
Dim As Any Ptr     RenderContext 'HGLRC
Dim As Any Ptr    Bitmap,OldBitmap ' HBITMAP
Dim As BITMAPINFO BI
Dim As PIXELFORMATDESCRIPTOR PfD
Dim As Integer    PixelFormat

ScreenDC=GetDC(0) 'CreateDC("DISPLAY",NULL,NULL,NULL)

If ScreenDC Then
  MemoryDC=CreateCompatibleDC(ScreenDC)
  If MemoryDC Then
    With BI.bmiHeader
      .biSize          = Sizeof(BITMAPINFOHEADER)
      .biWidth         = x'800'512
      .biHeight        =-y'-600'-512
      '.biSizeImage     = 512*512*2
      .biPlanes        =   1
      .biBitCount      =  24
      .biCompression   = BI_RGB
      .biXPelsPerMeter = 0
      .biYPelsPerMeter = 0
      .biClrUsed       = 0
      .biClrImportant  = 0

    End With
    Bitmap=CreateDIBSection(MemoryDC,@BI,DIB_RGB_COLORS,@pPixels,NULL,0)
    If Bitmap Then
      OldBitmap=SelectObject(MemoryDC,Bitmap)
      If OldBitmap Then
        With PfD
          .nSize = Sizeof(PIXELFORMATDESCRIPTOR)
          .nVersion     = 1
          .dwFlags      = PFD_DRAW_TO_BITMAP Or PFD_SUPPORT_OPENGL Or PFD_SUPPORT_GDI
          .iPixelType   = PFD_TYPE_RGBA
          .iLayerType   = PFD_MAIN_PLANE 
          .cColorBits   = 24
          .cDepthBits   = 24
          '.cAlphaBits   = 8
          '.cAccumBits   = 0
          '.cStencilBits = 0
        End With
        PixelFormat = ChoosePixelFormat(MemoryDC,@PfD)
        If PixelFormat Then
          If SetPixelFormat(MemoryDC,PixelFormat,@PfD) Then
            RenderContext=wglCreateContext(MemoryDC)
            If RenderContext=0 Then
              Dim As zstring Ptr pszMessage
              FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or _
                            FORMAT_MESSAGE_FROM_SYSTEM Or _
                            FORMAT_MESSAGE_IGNORE_INSERTS, _
                            NULL, GetLastError(), _
                            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _
                            Cptr(Any Ptr,@pszMessage),0, NULL )
  
              SelectObject(MemoryDC,OldBitmap)
              DeleteObject(Bitmap)
              DeleteDC(MemoryDC)
              DeleteDC(ScreenDC)
              Print "error create opengl render context: " & *pszMessage
              Beep:Sleep:End
            End If ' create render context
            If wglMakeCurrent(MemoryDC,RenderContext)=0 Then
  ? "error: make current!"
  Beep:Sleep
End If
End If
End If
End If
End If
End If
End If

End Sub

'superimpose via screenptr
Sub Drawgl(p As Ubyte Ptr,pPixels As Ubyte Ptr,xx As Long,yy As Long)
   Dim As Long i
For y As Long=0 To xx-1
  For x As Long=0 To yy-1
    p[i*4+0]= pPixels[i*3+0]
    p[i*4+1]= pPixels[i*3+1]
    p[i*4+2]= pPixels[i*3+2]
    i+=1
  Next
Next 
End Sub

Sub Start()
Screen 20,32
Screeninfo w,h
Screencontrol 8,refresh_rate
Dim As Ubyte Ptr pPixels

'==== opengl ===========
SetUpglTOfbscreen(pPixels,w,h)       'for gl
glinit()        'initialize the open gl ortho
'======================== 
  
    Dim As Long fps
       
        Dim As Single a
       While 1
           a+=.02
      Screenlock
        Cls
        glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT 
        
       DrawGl(Screenptr,pPixels,w,h) 'transfer openGL to fb screen

       glpendulum(a)
       gfxpendulum(a)
     
      Draw String(50, 10), " Press escape key to end", Rgb(255, 200, 0)
      Draw String(50, 55), "framerate " &fps , Rgb(0, 200, 0)
      Draw String(w\4-50,110),"fbgfx pendulum"
      Draw String(3*w\4-50,110),"openGL pendulum"
      Screenunlock
      glflush
      Sleep regulate(refresh_rate, fps)
      If Inkey=Chr(27) Then Exit While
   Wend
End Sub

start

I find the 64 bit compiler jumpy sometimes.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Freebasic is not smooth in graphics

Post by BasicCoder2 »

That is a neat little demo almost enough to make me want to learn more about openGL so I can untangle the code :)
What I have noticed with a lot of your example code is erratic indentations?
Post Reply