demo of fbgfx in freebasic

[ron77]

hello here is a demo of a graphic screen in freebasic done by mysoft and one of his friends it's an arrow that you can move and rotate with the arrows key press escape to exit:
the program is called "projecao.bas" which is I guess in Portuguese...

#cmdline "-fpu sse"

#include "fbgfx.bi"
#include "windows.bi"

const PI = 3.141592/180

#define CoordType single

dim shared as long TelaH=640,TelaV=360,TelaHV,CentroX,CentroY
dim shared as CoordType RotPointX=0,RotPointY=0
dim shared as long Angulo
dim shared as double PosicaoX=0 , PosicaoY=0 , ScreenScale

sub DesenhaPoligono( PtX() as CoordType , PtY() as CoordType , NumeroDePontos as long )
  dim as long N,M
  for N = 0 to NumeroDePontos-1
    M = (N + 1) mod NumeroDePontos 
    'desenha uma linha do ponto [N] atי o ponto [M] 
    'sendo que o תltimp ponto conecta de volta ao primeiro ponto (fechando o poligono)
    line ( CentroX-PtX(N) , CentroY+PtY(N) ) - ( CentroX-PtX(M) , CentroY+PtY(M) ), 10+N '(N mod 6)
  next N
end sub
sub GirarPoligono( PtX() as CoordType , PtY() as CoordType , Angulo as double , NumeroDePontos as long )
  dim as long N
  for N = 0 to NumeroDePontos-1
    dim as CoordType X=PtX(N)-RotPointX,Y=PtY(N)-RotPointY
    dim as double Dist = sqr( X*X + Y*Y )
    dim as double Ang = atan2( Y , X )+Angulo
    PtX(N) = RotPointX+cos(Ang)*Dist
    PtY(N) = RotPointY+sin(Ang)*Dist
  next N
end sub
sub EscalonaPoligono( PtX() as CoordType , PtY() as CoordType , Escala as double , NumeroDePontos as long )
  dim as long N
  for N = 0 to NumeroDePontos-1
    dim as CoordType X=PtX(N)-RotPointX,Y=PtY(N)-RotPointY    
    PtX(N) = RotPointX+X*Escala 
    PtY(N) = RotPointY-Y*Escala
  next N
end sub
sub CopiaPoligono( InPtX() as CoordType , InPtY() as CoordType , OutPtX() as CoordType , OutPtY() as CoordType , NumeroDePontos as long )
  dim as long N
  for N = 0 to NumeroDePontos-1
    OutPtX(N) = InPtX(N)
    OutPtY(N) = InPtY(N)
  next N
end sub
sub DeslocaPoligono( PtX() as CoordType , PtY() as CoordType , DeslocaX as long , DeslocaY as long ,  NumeroDePontos as long )
  dim as long N
  for N = 0 to NumeroDePontos-1
    PtX(N) += DeslocaX
    PtY(N) += DeslocaY
  next N
end sub

' -------------------------------------------------------------------------

dim as CoordType QuadX(4-1) = { -25 ,  25 , 25 , -25 }
dim as CoordType QuadY(4-1) = { -25 , -25 , 25 ,  25 }
dim as CoordType  TriX(3-1) = {  0  , -25 , 25 }
dim as CoordType  TriY(3-1) = { -25 ,  25 , 25 }

dim as CoordType PolyX(4-1),PolyY(4-1)

dim as byte iTelaCheia = 0
if TelaH=0 and TelaV=0 then iTelaCheia=1 : screeninfo TelaH,TelaV

TelaHV = (TelaH+TelaV)\2
CentroX=TelaH\2 : CentroY=TelaV\2
ScreenScale = TelaHV/500


screenres TelaH,TelaV,8,,iif(iTelaCheia,fb.GFX_NO_FRAME,fb.GFX_NO_SWITCH)
if iTelaCheia then screencontrol(fb.Set_Window_Pos,0,0)

dim as double dStart,dFps=timer
dim as integer iFpsConta,iFpsMostra,iPrevRotate = -1

do    
  dim as byte iRotateWorld = (GetKeyState(VK_SCROLL) and 1) xor 1
  if iPrevRotate <> iRotateWorld then    
    if Angulo > 0 then
      iRotateWorld = iPrevRotate
      if (360-Angulo) < Angulo then
        Angulo = Angulo+2 : Angulo = ((360+Angulo*7)\8) mod 360
      else
        Angulo = Angulo-2 : Angulo = (Angulo*7)\8
      end if
    else
      iPrevRotate = iRotateWorld
    end if
  end if
  
  screenlock
  cls
  
  randomize 55
  for N as long = -1 to 99
    dim as long iPoints = 4    
    if N > 0 and rnd > .5 then
      iPoints = 3 : CopiaPoligono( TriX(),TriY() , PolyX(),PolyY() , iPoints )      
    else        
      iPoints = 4 : CopiaPoligono( QuadX(),QuadY() , PolyX(),PolyY() , iPoints )
    end if
    EscalonaPoligono( PolyX() , PolyY() , ScreenScale , iPoints )    
    if N=0 then 
      GirarPoligono( PolyX(),PolyY() , PI*((timer-dStart)*72) , iPoints )
    elseif N>0 then
      GirarPoligono( PolyX(),PolyY() , PI*(rnd*360) , iPoints )
    elseif N=-1 then
      EscalonaPoligono( PolyX() , PolyY() , 22 , iPoints )
    end if
    DeslocaPoligono( PolyX() , PolyY() , PosicaoX,PosicaoY , iPoints )        
    
    if N>0 then 
      dim as long iPX,iPY
      do
        iPX = -TelaHV+rnd*(TelaHV*2) : iPY = -TelaHV+rnd*(TelaHV*2)
        if abs(iPX) > (TelaHV\10) andalso abs(iPY) > (TelaHV\10) then exit do
      loop
      DeslocaPoligono( PolyX() , PolyY() , iPX , iPY , iPoints )
    end if

    if iRotateWorld then GirarPoligono( PolyX(),PolyY() , PI*Angulo , iPoints )
    DesenhaPoligono( PolyX() , PolyY() , iPoints )
    
  next N
  
  
  if iRotateWorld then
    dim as CoordType iCX = CentroX , iCY = CentroY-TelaHV\48
    line(iCX,iCY)-step(0,TelaHV\24),15
    line(iCX,iCY)-step(-TelaHV\64,+TelaHV\64),15
    line(iCX,iCY)-step(+TelaHV\64,+TelaHV\64),15
  else
    dim as CoordType iDX = -cos(PI*(Angulo-90))*(TelaHV\48) , iDY = -sin(PI*(Angulo-90))*(TelaHV\48)
    dim as CoordType iCX = CentroX-iDX , iCY = CentroY-iDY
    line(iCX,iCY)-step(iDX*2,iDY*2),14
    iDX = -cos(PI*(Angulo-45))*(TelaHV\48) : iDY = -sin(PI*(Angulo-45))*(TelaHV\48)
    line(iCX,iCY)-step(iDX,iDY),14
    line(iCX,iCY)-step(iDY,-iDX),14
    
  end if
  
  locate 1,1: print iFpsMostra;"fps (" & Angulo & ")"
  screenunlock  
  
  dim as single Velocidade = TelaHV/333
  if Multikey(fb.SC_LSHIFT) then Velocidade += Velocidade
  if Multikey(fb.SC_RSHIFT) then Velocidade *= 1.333
  if Multikey(fb.SC_LEFT)  then Angulo = (Angulo+358) mod 360
  if Multikey(fb.SC_RIGHT) then Angulo = (Angulo+2) mod 360
  if Multikey(fb.SC_A) then 
    PosicaoX += sin(PI*(Angulo-90))*Velocidade : PosicaoY += cos(PI*(Angulo-90))*Velocidade
  end if
  if Multikey(fb.SC_D) then 
    PosicaoX += sin(PI*(Angulo+90))*Velocidade : PosicaoY += cos(PI*(Angulo+90))*Velocidade
  end if

  if Multikey(fb.SC_UP) or Multikey(fb.SC_W) then 
    PosicaoX += sin(PI*Angulo)*Velocidade : PosicaoY += cos(PI*Angulo)*Velocidade
  end if
  if Multikey(fb.SC_DOWN) or Multikey(fb.SC_H) then 
    PosicaoX -= sin(PI*Angulo)*Velocidade : PosicaoY -= cos(PI*Angulo)*Velocidade
  end if
    
  sleep 15,1  
  
  iFpsConta += 1
  if (timer-dFps) >= 1 then
    dFps = timer : iFpsMostra = iFpsConta : iFpsConta = 0
  end if
  
loop until multikey(fb.SC_ESCAPE)

[johnno56]

Installed Windows version of FB 1.09 and FBIDE... I was surprised that Wine ran everything "out of the box" (had to point to the compiler...) Example ran very well... Ran quite smoothly as 65fps.

A little disappointed by the lack of aliens... Moo Ha Ha Ha....

Nicely done!

J

[ron77]

hello johnno56

Aliens? Maybe in future demos

I'm happy freebasic ran smoothly on wine, and you were able to check the demo