Freebasic is not smooth in graphics

For other topics related to the FreeBASIC project or its community.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Freebasic is not smooth in graphics

Postby dodicat » Mar 31, 2020 8:47

Hi basiccoder2.
Thanks for testing.
The indentations are an fbide option, tab size set at 4.
BasicCoder2
Posts: 3525
Joined: Jan 01, 2009 7:03

Re: Freebasic is not smooth in graphics

Postby BasicCoder2 » Mar 31, 2020 9:27

@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.

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
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Freebasic is not smooth in graphics

Postby dodicat » Mar 31, 2020 15:00

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.

Return to “Community Discussion”

Who is online

Users browsing this forum: No registered users and 3 guests