Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: ninogenio on July 07, 2007
-
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.
#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.
#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!
-
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
-
With Aulds 1kb startup utility ported, surely it would not be possible to write 1kb's in Freebasic?
Maybe 4kb but surely not 1kb?
-
oops i forgot about not using memset in the ptc example :P.
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.
-
cool aulds framework does port!
'
' 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?
-
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 (http://gem.intro.hu/dropper_v2_0.htm) with this fb .exe and pack it using apack (http://www.ibsensoftware.com/download.html)
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.
-
Karma all round I think.
-
cool so 4kb is possible!
anyone have any ideas about making an fb 1k? that would be cool
-
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
-
Might take a bit more effort than that though.
Yes, it does!
http://dbfinteractive.com/index.php?topic=2110.0 (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