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)
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
hello johnno56 :)
Aliens? Maybe in future demos ;)
I'm happy freebasic ran smoothly on wine, and you were able to check the demo :)