Hi basiccoder2.
Thanks for testing.
The indentations are an fbide option, tab size set at 4.
Freebasic is not smooth in graphics
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: Freebasic is not smooth in graphics
@dodicat
I also use FBIDE but if you look at your posted code all the end if statements are bang up against the left border.
Below I have gone through your code and restored the indentations as it makes it easier for me to read.
I also use FBIDE but if you look at your posted code all the end if statements are bang up against the left border.
Below I have gone through your code and restored the indentations as it makes it easier for me to read.
Code: Select all
'dodicat https://www.freebasic.net/forum/viewtopic.php?f=17&t=28415
#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(0,200,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(0,0,200),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
print "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()
screenres 840,600,32
'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
Re: Freebasic is not smooth in graphics
Hi Basiccoder2.
I've got rid of the end if's
I must have forgot to indent before I posted.
See the projects section for cubes instead of pendulums.
I've got rid of the end if's
I must have forgot to indent before I posted.
See the projects section for cubes instead of pendulums.