First freebasic gdi code.

[ninogenio]

hey folks i was boerd tonight so i ported jims gdi framework code from c++ to freebasic i got stuck in several places but just about got there in the end.

here is the code for any one who is intrested.

Code: [Select]

#Include "windows.bi"
#Include "crt.bi"

#define SCREEN_X   800
#define SCREEN_Y   600
#define SCREEN_BPP 32

Declare Sub ClearWorld()
Declare Sub RenderWorld()


Dim Shared As UInteger ucKeys(255)

Dim Shared As BITMAPINFO bmi
Dim Shared As HWND Game_Window

Dim Shared As String Game_Class
Game_Class = "GameWindow"

Dim Shared As Integer quit = 0

Dim Shared As Integer BackBuffer( ( SCREEN_X * SCREEN_Y * SCREEN_BPP ) Shr 3 )
Dim Shared As Integer Ptr Screen_Ptr
Screen_Ptr = @BackBuffer(0)

Declare Function WinMain( ByVal hInstance As HINSTANCE , ByVal hPrevInstance As HINSTANCE , ByVal lpCmdLine As LPSTR ,  ByVal nCmdShow As Integer ) As Integer

End WinMain( GetModuleHandle( NULL ), NULL, command$, SW_NORMAL )

Function WndProc (ByVal hwnd as HWND , byval uMsg As UINT , ByVal wParam As WPARAM , ByVal lParam As LPARAM ) As LRESULT
        Select Case(uMsg)

        case WM_DESTROY
             PostQuitMessage(0)
             quit = 1
             Return 0
        case WM_KEYDOWN
             ucKeys( wParam And 255 ) = 1
             Select Case (wParam)

             case VK_ESCAPE:
                  PostQuitMessage(0)
                  quit = 1
                  Return 0
             End Select

             case WM_KEYUP
                  ucKeys( wParam And 255 ) = 0
                  Return 0

         End Select

         return DefWindowProc( hwnd, uMsg, wParam, lParam )

End Function

Function WinMain( ByVal hInstance As HINSTANCE , ByVal hPrevInstance As HINSTANCE , ByVal lpCmdLine As LPSTR ,  ByVal nCmdShow As Integer ) As Integer
        Dim As WNDCLASSEX Clas
        Dim As MSG Msg
        Dim As Integer style
        Dim Rect As RECT
        clas.cbSize = sizeof(WNDCLASSEX)
        clas.style = CS_HREDRAW Or CS_VREDRAW Or CS_OWNDC
        clas.lpfnWndProc = @WndProc
        clas.cbClsExtra = 0
        clas.cbWndExtra = 0
        clas.hInstance = hInstance
        clas.hIcon = NULL
        clas.hCursor = NULL
        clas.hbrBackground = Cast( HBRUSH , COLOR_WINDOW+1 )
        clas.lpszMenuName = NULL
        clas.lpszClassName = StrPtr( Game_Class )
        clas.hIconSm = 0
        RegisterClassEx(@clas)
        style = WS_CAPTION Or WS_SYSMENU Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
        game_window = CreateWindowEx( 0 , game_class , "GDI TEST" , style , CW_USEDEFAULT , CW_USEDEFAULT , CW_USEDEFAULT , CW_USEDEFAULT , NULL , NULL , hInstance , 0 )

        Dim As Integer Src_W , Src_H
        Dim As Integer bpp

        src_w = SCREEN_X
        src_h = SCREEN_Y
        bpp = SCREEN_BPP
        rect.left = rect.top = 0
        rect.right = src_w
        rect.bottom = src_h
        AdjustWindowRectEx(@rect, style , TRUE, 0)
        SetWindowPos(game_window, NULL, 0,0, rect.right , rect.bottom , 0)

        bmi.bmiHeader.biSize = sizeof( BITMAPINFOHEADER )
        bmi.bmiHeader.biWidth = src_w
        bmi.bmiHeader.biHeight = -src_h
        bmi.bmiHeader.biPlanes = 1
        bmi.bmiHeader.biBitCount = bpp
        bmi.bmiHeader.biCompression = BI_RGB
        bmi.bmiHeader.biSizeImage = 0
        bmi.bmiHeader.biXPelsPerMeter = 75
        bmi.bmiHeader.biYPelsPerMeter = 75
        bmi.bmiHeader.biClrUsed = 0
        bmi.bmiHeader.biClrImportant = 0

        ShowWindow( Game_Window, nCmdShow)

        quit = 0

        do
                while ( PeekMessage( @msg , Game_Window , 0 , 0 , PM_NOREMOVE) )
                        If (GetMessage( @msg , Game_Window , 0 , 0 ) < 0 ) Then
                                Exit While
                        End If
                        TranslateMessage(@msg)
                        DispatchMessage(@msg)
                Wend

                For X = 0 To SCREEN_X * SCREEN_Y
                         Screen_Ptr[x] = RGB(rnd(1)*255,rnd(1)*255,rnd(1)*255)
                Next

                renderworld()
                clearworld()
                Sleep(0)
        Loop While ( quit = 0 )

        return 0
End Function

Sub renderworld()
        Dim As HDC hdc
        hdc = GetDC(Game_Window)
        SetDIBitsToDevice(hdc, 0,0, SCREEN_X,SCREEN_Y, 0,0, 0,SCREEN_Y, Cast( Any Ptr , screen_ptr ) , @bmi,  DIB_RGB_COLORS)
        ReleaseDC(game_window, hdc)
End Sub


Sub ClearWorld()
     memset( screen_ptr , 0 , SCREEN_X * SCREEN_Y * sizeof( UInteger ) )
End Sub

one interesting thing i noticed was that compared to ptc using this code.

Code: [Select]

#Include "TinyPtc_ext.Bi"

ptc_open( "PtcTest", 800, 600 )

Dim Shared As Integer Buffer(800*600)

Do
     for x = 0 to 800*600
         buffer( x ) =  RGB(rnd(1)*255,rnd(1)*255,rnd(1)*255)
     next
     ptc_update @buffer(0)
     for x = 0 to 800*600
         buffer( x ) = 0
     next
Loop Until( Inkey$ = Chr$( 27 ) )
ptc_close

gdi was smaller and faster gdi 14kb ptc 18kb and i know my gdi code doesnt wait for vblanks but neither of the two examples comes close on my comp to my refresh rate but the gdi example looks like its running at about twice the speed.

right thats enough gibberish from me hope this is of use to some of you guys!

[Jim]

The difference in speed is because in GDI you're using memset to clear the screen, and in PTC you're using a for loop.
Try using crt.bi to bring in memset() to PTC.
The GDI's also smaller because there's no baggage of the PTC static library, and it could easily be made smaller, eg. to port Auld's 1k C framework as startup instead of writing it all out neatly.

Jim

[Shockwave]

With Aulds 1kb startup utility ported, surely it would not be possible to write 1kb's in Freebasic?

Maybe 4kb but surely not 1kb?

[ninogenio]

oops i forgot about not using memset in the ptc example  .

im interested is it possible to use aulds framework in freebasic i thought not but if it is i might try porting it over just to see how small i can get this.

[ninogenio]

cool aulds framework does port!

Code: [Select]

'
' Re-use granted as long as long as you give credit in
' either your demo or accompanying files please...(auld)
'
' Thanks go to Icehawk for WS_MAXIMIZE optimisation and the idea
' how to get rid of Peekmessage
' The following code sets up an Opengl window under win32
' It is double buffered, hides the mouse, has 32 bits of depth/Z.
' The main loop includes a clear for depth and color bits and
' a swapbuffers call for drawing.
' It exits when escape is pressed...
' Tested under XP.
'
#include "windows.bi"
#include "GL/gl.bi"

Declare Function WinMainCRTStartup() As Integer

End WinMainCRTStartup()

Function WinMainCRTStartup() As Integer

   Dim As PIXELFORMATDESCRIPTOR pfd
   pfd.cColorBits = pfd.cDepthBits = 32
   pfd.dwFlags    = PFD_SUPPORT_OPENGL Or PFD_DOUBLEBUFFER

   Dim As HDC hDC = GetDC ( CreateWindow("edit", 0,WS_POPUP Or WS_VISIBLE Or WS_MAXIMIZE ,0, 0, 0 , 0, 0, 0, 0, 0) )

   SetPixelFormat ( hDC , ChoosePixelFormat ( hDC, @pfd) , @pfd )
   wglMakeCurrent ( hDC , wglCreateContext(hDC) )

   ShowCursor(FALSE)

   glClearColor( 1.0f, 0.0f, 0.5f, 1.0f )
   do
       glClear ( GL_DEPTH_BUFFER_BIT Or GL_COLOR_BUFFER_BIT )
       ' insert Breakpoint winning 4kdemo here
       SwapBuffers ( hDC )
   Loop while ( GetAsyncKeyState(VK_ESCAPE) = 0 )
End Function

it builds to 6kb but now if we can figuar out how to use a dropper with fb we can get this down im shure.

does anyone know if yousing a droper works in fb?

[Rbz]

it builds to 6kb but now if we can figuar out how to use a dropper with fb we can get this down im shure.

does anyone know if yousing a droper works in fb?

Nice work nino!

Yeah you can use dropper with this fb .exe and pack it using apack

Code: [Select]

dropper /c3 /o2 /n /p2 fb1k.exe
apack -t fb1k.com
Tried it here and the final .com file has been packed down to 2015 bytes, to make it smaller we need to find a way to compile an .exe file with size of ~2048 bytes.

[Shockwave]

Karma all round I think.

[ninogenio]

cool so 4kb is possible!

anyone have any ideas about making an fb 1k? that would be cool

[Jim]

I suspect it's bigger because WinMainCRTStartup is VisualStudio's entry point which is called before the runtime startup code.  Someone needs to work out how not to link the FB runtime startup, because that will be different.

The compiler options you want are
-nodeflibs
and then perhaps
-m WinMainCRTStartup

Might take a bit more effort than that though.

btw, dropper stuff usually doesn't work on Vista.

Jim

[Jim]

Might take a bit more effort than that though.

Yes, it does!

http://dbfinteractive.com/index.php?topic=2110.0

It will be interesting to see how much FB relies on it's built-in libraries and how much is done direct in the compiler.  If it relies a lot on the libs it'll be very difficult to do anything.

Jim