Ive been doing a little bit of investigating to do with trying to see how to do proper Screen Syncing / VSync with tinyptc.
Below is the new Tinyptc include that works with the latest version of Freebasic.
I've seen from google searching on tinyptc, that a library called Pixel Toaster is the succsesor to TinyPC - and that it uses DirectDraw / Windows in some fasihion to enable smooth syncing. However I don't know how I'd set this up or go about it, as I've not dealt with windows in FB to any degree.
I gather that it is possible with TinyPTC and Freebasic going by the stuff at the bottom of the include lib where it has:
#ifdef __FB_WIN32__
# inclib "ddraw"
# inclib "user32"
# inclib "gdi32"
Include lib as follows:
''
'' TinyPTC by Gaffer
'' www.gaffer.org/tinyptc
''
''
'' add the -d PTC_WIN option to fbc's command-line to use the windowed version
''
#if defined(PTC_WIN) and not defined(__FB_DOS__)
# inclib "tinyptc-win"
#else
# inclib "tinyptc"
#endif
'' tinyptc api
declare function ptc_open cdecl alias "ptc_open" (byval title as zstring ptr, _
byval width as integer, _
byval height as integer ) as integer
declare function ptc_update cdecl alias "ptc_update" (byval buffer as integer ptr) as integer
declare function ptc_close cdecl alias "ptc_close" () as integer
#ifdef __FB_WIN32__
# inclib "ddraw"
# inclib "user32"
# inclib "gdi32"
#elseif defined(__FB_LINUX__)
# inclib "X11"
# libpath: "/usr/X11R6/lib"
#elseif defined(__FB_DOS__)
'''
#else
# error Platform not supported!
#endif
If you could help with this, I'd really very much appreciate it. And Im sure lots of us here will benefit from this big time too.
Cheers and many humble thanks,
Clyde.
Hi Clyde....
I played about with tinpyptc for a fair bit trying to get it to sync properly and after a while i sacked it coz when i did get it synced it was a bit twitchy to say the least. one workround i found though was to use the screensync function. Now I know thats a gfxlib call and it doesnt work until you init the screen with the screenres() command. So on the line before you init your tinyptc with ptc_open() init a gfxlib screen with something like screenres 640, 480, 32. you can then use the screensync call before your ptc_update(). It worked for me but sometimes had strange tearing effects towards the top of the screen. Give it a go if it works then all the better. I've actually sacked the tinyptc lib now because you can do exectly the same using gfxlib by getting a pointer to the current work page. And if you enable the double buffering you dont even have to lock the screen before you read/write to it.... Anyways I dont want to go off topic to much but if you fancy a look at some code using gfxlib in the same way as youd use tinyptc give us a shout......
Thank you for that info mate, I have also used GFXlib and the ScreenSync with TinyPTC.
What Im really after is somehow implementing a windows / ddraw method as I have heard it is possible.
Cheers,
Clyde.
I can assure you that FB tinyptc uses directdraw method and that is why you see this line --> inclib "ddraw" in tinyptc.bi
So that means that there must be a way of doing Screen Syncing in TinyPTC?
Wonder how that would be possible to code to get it to work.
You need to look into Delta Timing Clyde.
That's the method that I am using now and I am getting a rock steady refresh with tinyptc, which further more should be compatible with most computers.
Take the amount of frames drawn over the last second and divide a number into it and use that to compute a universal number to divide or multiply your movements by and it's as simple as that.
The main reason for asking about proper Screen Syncing, is because I get an incredible amout of tearing of the display.
I've used Delta Timing before, cheers for the info on that, I'll try using that until somebody cleverer then me can work out proper screen syncing.
Cheers,
Clyde.
I just checked the source for PixelToaster. It's using Direct3D, not DirectDraw. It doesn't set the swap interval when creating the Direct3DDevice, so there isn't any framesyncing in there.
I got the TinyPTC lib source from here http://sourceforge.net/project/showfiles.php?group_id=5722. If it's built for DirectDraw fullscreen mode it will (or looks like it should from the code) sync to refresh. Does anyone know how to rebuild libs for freebasic?
Alternatively we could roll our own. Direct3D and OpenGL versions can vsync in a window, or at least make a good approximation. With the existing opengl.bi library it's pretty trivial to implement a version of ptc_update() and have frame syncing.
Jim
I guess that someone have disabled vertical sync for FB version, because I did some tests in C (VC++ 6.0)Ã, and for
fullscreen mode it works nice without tearing. So we will need to fix it.
This pice of code below is from tinyptc v0.8 'ddraw.c', DDFLIP_WAIT = wait for video vertical retrace
Ã, Ã, Ã, Ã, // unlock back surface
Ã, Ã, Ã, Ã, IDirectDrawSurface_Unlock(lpDDS_back,descriptor.lpSurface);
Ã, Ã, Ã, Ã, #ifndef __PTC_WINDOWED__
Ã, Ã,
Ã, Ã, Ã, Ã, Ã, Ã, // flip primary surface
Ã, Ã, Ã, Ã, Ã, Ã, IDirectDrawSurface_Flip(lpDDS,0,DDFLIP_WAIT);
Ã, Ã, Ã, Ã, #else
Ã, Ã, Ã, Ã, Ã, Ã, // paint primary
Ã, Ã, Ã, Ã, Ã, Ã, ptc_paint_primary();
Ã, Ã, Ã, Ã, #endifQuoteDoes anyone know how to rebuild libs for freebasic?
I guess that Relsoft can do it for us.
This is starting to sound very promising!
There is something else that is missing from this lib as far as I'm concerned, and that is the ability to switch from full screen to windowed mode.
Sounds fantastic and brilliant investigating guys!
Cheers,
Clyde.
QuoteDoes anyone know how to rebuild libs for freebasic?
i remember reading up on this the other day and i far as i could see you could simply bulid the lib.a file in dev c/visuall c and point the freebasic compilier to the lib but in our case we could just drop the new tiny lib on top of the existing one in the lib folder then its simply a case of porting the header file to a .bi file that freebasic can understand but in our case we already have a .bi tiny file so like i said it probably would be a case of compiling a new .a file and dropping it in place of the existing one.
not sure if that quite right but its the best i could think of.
For include libs that have .bi or .bas it's a mere case of just re-saving with the new code. And then exitting FBIDE / Freebasic cmd prompt, and then re-running.
What do you think of this? It uses fbgfx to create a windowed OpenGL app, but then emulates tinyptc at the function level so it can do everything ptc does, BUT it also supports Alt-Enter to switch fullscreen AND it lets you set the swap interval to any number of vblanks, including 0 using the new ptc_setflip() function. Another advantage is that those running 16bit displays get free colour conversion. A disadvantage is that it doesn't set the window title. Finally, it's a bit bigger for exe size than tinyptc. If someone were to make this into a real .bi file it might be smaller.
I didn't do any benchmarks to see if it's faster or slower than ptc. It should be in the same ballpark.
Jim
#include once "windows.bi"
#include once "gl/gl.bi"
#include once "gl/glext.bi"
#include once "fbgfx.bi"
option explicit
option static
declare function ptc_open(byval title as zstring ptr, byval width as integer, byval height as integer ) as integer
declare function ptc_update(byval buff as integer ptr) as integer
declare function ptc_close() as integer
declare sub ptc_setflip(byval interval as integer)
dim shared buffer(640*480) as uinteger
dim x as integer
ptc_open("hello",640,480)
do
for x=0 to 639
buffer(x)=&hffff0000
next
for x=640 to 640*480-1
buffer(x)=&hffffffff
next
ptc_update(@buffer(0))
for x=0 to 639
buffer(x)=&hffff0000
next
for x=640 to 640*480-1
buffer(x)=&hff000000
next
ptc_update(@buffer(0))
loop until inkey$<>""
ptc_close()
end
dim shared g_w as integer
dim shared g_h as integer
type PFNWGLSWAPINTERVALFARPROC as sub(byval interval as integer)
dim shared wglSwapIntervalEXT as PFNWGLSWAPINTERVALFARPROC
function ptc_open(byval title as zstring ptr, byval w as integer, byval h as integer) as integer
screenres w,h,32,0,2
wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALFARPROC,wglGetProcAddress("wglSwapIntervalEXT"))
ptc_setflip(1)
glViewport(0, 0, w,h)
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
glOrtho(0,w,h,0,0,1)
glPixelZoom(1,-1)
glRasterPos2i(0,0)
g_w=w
g_h=h
return 0
end function
function ptc_update(byval buff as integer ptr) as integer
glDrawPixels(g_w,g_h,GL_BGRA_EXT,GL_UNSIGNED_BYTE,buff)
flip
return 0
end function
function ptc_close() as integer
return 0
end function
sub ptc_setflip(byval interval as integer)
if wglSwapIntervalExt <> 0 then
wglSwapIntervalEXT(interval)
endif
end sub
That is so neat because I would haev thought that you can use all the fbgfx commands with it too?
Exe size isn't a complete disaster either, the example krunches down to about 30kb with kkrunchy by ryg^fb so maybe with music it won't be doing any 40k intros, however it is perfectly acceptable I think to have an intro of around 100-200 k without getting flamed and for the benefit of a rock steady refresh, I'd have to say it rocks!
Nice one Jim. What I will do later is to give it the complete acid test is to code a ptc sine scroller, add some music and upload the exe here so we can see how steady the refresh rate is.
I'm guessing it will be rock solid.
Btw, anybody who suffers from epilepsy should not watch Jims example as it has intense strobing.
QuoteThat is so neat because I would have thought that you can use all the fbgfx commands with it too?
Yep, I think so, and also any OpenGL commands too. It would be possible to remove fbgfx and replace it with another 100 lines or so of code which will definitely shrink the size as all the code would be in Windows' dlls then.
strobing? oh yes :D Try setting sync interval to 0. On my card/driver you can see exactly how OpenGL is emulating a rectangular blit with a couple of triangles.
Jim
brilliant work there jim i just ported my fireworks in about two mins with this and of course we can use the multikey fun now.
cant belive it was so simple.
:cheers:
#include once "windows.bi"
#include once "gl/gl.bi"
#include once "gl/glext.bi"
#include once "fbgfx.bi"
'fire works demo by nino coded on 15 july '06
'have fun'
defint a-z
const SCR_WIDTH = 640
const SCR_HEIGHT = 480
const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT
RANDOMIZE TIMER
Type partical
partical_x as double
partical_y as double
partical_x_direction as double
partical_y_direction as double
partical_color as double
End Type
Type firework
x as double
y as integer
r as double
dist as double
bloom_switch as double
init_speed as double
frames as double
firework_color as double
firework_bloom(250) as partical
End Type
'raise or lower the fireworks number to how ever many fireworks you wish
dim shared fireworks(10) as firework
dim shared buffer( 0 to SCR_SIZE-1 ) as integer
declare function smooth( screen_ptr() )
declare function put_ptc_pixel( screen_ptr() , byval x as integer ,byval y as integer ,byval col as integer)
declare function explode(fireworks as firework)
declare function draw_and_animate_firework(fireworks as firework)
declare function flush_partical_buffer(fireworks as firework)
declare function ptc_open(byval title as zstring ptr, byval width as integer, byval height as integer ) as integer
declare function ptc_update(byval buff as integer ptr) as integer
declare function ptc_close() as integer
declare sub ptc_setflip(byval interval as integer)
ptc_open( "freeBASIC v0.01 - tinyPTC test", SCR_WIDTH, SCR_HEIGHT )
for x=0 to ubound(fireworks)
fireworks(x).x = 50 + int(rnd(1)*540)
fireworks(x).y = 480
fireworks(x).r = 40+int(rnd(1) * 40)
fireworks(x).dist = 100+int(rnd(1)*300)
fireworks(x).bloom_switch = 0
fireworks(x).init_speed = 1+int(rnd(1)*4)
fireworks(x).frames = 40+int(rnd(1)*100)
'firework color 1 = red 2 = green 3 = blue 4 = white 5 = randome
fireworks(x).firework_color = 1+int(rnd(1)*5)
next
do
for x=0 to ubound(fireworks)
if ( SCR_HEIGHT - fireworks(x).y ) >= fireworks(x).dist then
if fireworks(x).bloom_switch = 0 then
explode fireworks(x)
fireworks(x).bloom_switch = 1
else
fireworks(x).frames = fireworks(x).frames - 1
draw_and_animate_firework fireworks(x)
if fireworks(x).frames <= 1 then
flush_partical_buffer fireworks(x)
fireworks(x).r = 40+int(rnd(1) * 40)
fireworks(x).bloom_switch = 0
fireworks(x).dist = 100+int(rnd(1)*300)
fireworks(x).x = 50 + int(rnd(1)*540)
fireworks(x).init_speed = 1+int(rnd(1)*4)
fireworks(x).y = 480
fireworks(x).frames = 40+int(rnd(1)*100)
fireworks(x).firework_color = 1+int(rnd(1)*5)
end if
endif
else
fireworks(x).y = fireworks(x).y - fireworks(x).init_speed
if fireworks(x).firework_color = 1 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,0,0)
elseif fireworks(x).firework_color = 2 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(0,255,0)
elseif fireworks(x).firework_color = 3 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(0,0,255)
elseif fireworks(x).firework_color = 4 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,255,255)
elseif fireworks(x).firework_color = 5 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,0,255)
endif
endif
next
smooth buffer()
ptc_update @buffer(0)
loop until( inkey$ = chr$( 27 ) )
ptc_close
function explode(fireworks as firework)
dim r2 as double
dim z as double
dim w as double
dim fireworksize as integer
dim partical_speed as double
r2 = ( fireworks.r * fireworks.r )
for z = -fireworks.r to fireworks.r
w=sqr( r2 - z * z )
fireworks.firework_bloom(fireworksize).partical_x = ( fireworks.x-w ) + ( RND( 1 ) * ( w * 2 ) )
fireworks.firework_bloom(fireworksize).partical_y = z+fireworks.y
if fireworks.firework_bloom(fireworksize).partical_x < fireworks.x then
partical_speed = ( fireworks.x - fireworks.firework_bloom(fireworksize).partical_x )/50
fireworks.firework_bloom(fireworksize).partical_x_direction = -partical_speed
elseif fireworks.firework_bloom(fireworksize).partical_x > fireworks.x then
partical_speed = ( fireworks.firework_bloom(fireworksize).partical_x - fireworks.x )
fireworks.firework_bloom(fireworksize).partical_x_direction = partical_speed/50
endif
fireworks.firework_bloom(fireworksize).partical_y_direction = z/50
if fireworks.firework_color = 1 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(255,0,0)
elseif fireworks.firework_color = 2 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(0,255,0)
elseif fireworks.firework_color = 3 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(0,0,255)
elseif fireworks.firework_color = 4 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(255,255,255)
elseif fireworks.firework_color = 5 then
fireworks.firework_bloom(fireworksize).partical_color = rgb( int( rnd(1) * 255 ) , int( rnd(1) * 255 ) , int( rnd(1) * 255 ) )
endif
fireworksize = fireworksize + 1
next
return 0
end function
function draw_and_animate_firework(fireworks as firework)
dim x as integer
for x=0 to ubound(fireworks.firework_bloom)
fireworks.firework_bloom(x).partical_x = fireworks.firework_bloom(x).partical_x + fireworks.firework_bloom(x).partical_x_direction
fireworks.firework_bloom(x).partical_y = fireworks.firework_bloom(x).partical_y + fireworks.firework_bloom(x).partical_y_direction
put_ptc_pixel buffer() , fireworks.firework_bloom(x).partical_x , fireworks.firework_bloom(x).partical_y , fireworks.firework_bloom(x).partical_color
next
return 0
end function
function flush_partical_buffer(fireworks as firework)
for x=0 to ubound(fireworks.firework_bloom)
fireworks.firework_bloom(x).partical_x = 0
fireworks.firework_bloom(x).partical_x_direction = 0
fireworks.firework_bloom(x).partical_y = 0
fireworks.firework_bloom(x).partical_y_direction = 0
fireworks.firework_bloom(x).partical_color =0
next
return 0
end function
function put_ptc_pixel(screen_ptr(),byval x as integer ,byval y as integer ,byval col as integer)
if x<4 or x>SCR_WIDTH-4 then exit function
if y<4 or y>SCR_HEIGHT-4 then exit function
screen_ptr(y*SCR_WIDTH+x) = col
screen_ptr((y+1)*SCR_WIDTH+x) = col
screen_ptr((y-1)*SCR_WIDTH+x) = col
screen_ptr(y*SCR_WIDTH+(x+1)) = col
screen_ptr(y*SCR_WIDTH+(x-1)) = col
screen_ptr((y+1)*SCR_WIDTH+(x+1)) = col
screen_ptr((y+1)*SCR_WIDTH+(x-1)) = col
screen_ptr((y-1)*SCR_WIDTH+(x+1)) = col
screen_ptr((y-1)*SCR_WIDTH+(x-1)) = col
return 0
end function
'relsofts smooth func
function smooth( screen_ptr())
dim maxpixel as integer
dim offset as integer
dim pixel as unsigned integer
dim r as integer
dim g as integer
dim b as integer
dim nr as integer
dim ng as integer
dim nb as integer
maxpixel = ubound(buffer)
for offset = SCR_WIDTH to maxpixel - SCR_WIDTH
pixel = buffer(offset-1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = r shr 2
ng = g shr 2
nb = b shr 2
pixel = buffer(offset+1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset+SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset-SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
buffer(offset) = nr shl 16 or ng shl 8 or nb
next i
return 0
end function
dim shared g_w as integer
dim shared g_h as integer
type PFNWGLSWAPINTERVALFARPROC as sub(byval interval as integer)
dim shared wglSwapIntervalEXT as PFNWGLSWAPINTERVALFARPROC
function ptc_open(byval title as zstring ptr, byval w as integer, byval h as integer) as integer
screenres w,h,32,0,2
wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALFARPROC,wglGetProcAddress("wglSwapIntervalEXT"))
ptc_setflip(1)
glViewport(0, 0, w,h)
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
glOrtho(0,w,h,0,0,1)
glPixelZoom(1,-1)
glRasterPos2i(0,0)
g_w=w
g_h=h
return 0
end function
function ptc_update(byval buff as integer ptr) as integer
glDrawPixels(g_w,g_h,GL_BGRA_EXT,GL_UNSIGNED_BYTE,buff)
flip
return 0
end function
function ptc_close() as integer
return 0
end function
sub ptc_setflip(byval interval as integer)
if wglSwapIntervalExt <> 0 then
wglSwapIntervalEXT(interval)
endif
end sub
Cool!
Drew
Smart stuff Nino and really smooth :)
Nice one Jim. Gonna try all this out.
Wonder if it's possible without the need for including the GFXLib ???
Also what's the default hertz that GFXLib uses with ScreenRes? Just that I get a really thick border around the edges of the screen; which doesnt happen in normal TinyPTC rendering.
Anyone know if it's possible to autodetect what peoples monitor refresh rate is?
Cheers and big thanks,
Clyde.
It's a great idea/work Jim, welldone !
Here a framework for it that will remove fb grafxlib.
Now you will need to use a subroutine 'Main()' for your intro loop, it's not necessary check for 'escape' or a do/while loop the framework will take care of it. And a subroutine 'Init()' to initialyze your intro variables/functions.
PS: DEVMODE structure still bugged, but it will be corrected by Victor in the next freebasic update, for now you see this warning --> warning level 0: Passing different pointer types, at parameter 1 of CHANGEDISPLAYSETTINGS()Ã, and I don't know how to get rid of it by now, but it will compile just fine :)
Exe size: 11 kbytes
'---------------------------------------------------------------------------------
'Ã, Ã, Tinyptc OGL by Jim
'
'Ã, Ã, Window Framework by Rbraz
'
'Ã, Ã, 10 Sept 2006
'---------------------------------------------------------------------------------
#include once "windows.bi"
#include once "gl/gl.bi"
#include once "gl/glext.bi"
#include once "crt.bi"
option explicit
option static
'Screen width x height
Const screenWidthÃ, = 640
Const screenHeight = 480
'Application name
Const AppicationName = "hello"
'DEVMODE bug, found the cure here --> http://www.freebasic.net/forum/viewtopic.php?t=5659&highlight=devmode
'Will be corrected by Victor in the next freebasic update
#undef DEVMODE
Type DEVMODE
Ã, Ã, dmDeviceName As Zstring * CCHDEVICENAME
Ã, Ã, dmSpecVersion As WORD
Ã, Ã, dmDriverVersion As WORD
Ã, Ã, dmSize As WORD
Ã, Ã, dmDriverExtra As WORD
Ã, Ã, dmFields As DWORD
Ã, Ã, dmOrientation As Short
Ã, Ã, dmPaperSize As Short
Ã, Ã, dmPaperLength As Short
Ã, Ã, dmPaperWidth As Short
Ã, Ã, dmScale As Short
Ã, Ã, dmCopies As Short
Ã, Ã, dmDefaultSource As Short
Ã, Ã, dmPrintQuality As Short
Ã, Ã, dmColor As Short
Ã, Ã, dmDuplex As Short
Ã, Ã, dmYResolution As Short
Ã, Ã, dmTTOption As Short
Ã, Ã, dmCollate As Short
Ã, Ã, dmFormName As Zstring * CCHFORMNAME
Ã, Ã, dmLogPixels As WORD
Ã, Ã, dmBitsPerPel As DWORD
Ã, Ã, dmPelsWidth As DWORD
Ã, Ã, dmPelsHeight As DWORD
Ã, Ã, dmDisplayFlags As DWORD
Ã, Ã, dmDisplayFrequency As DWORD
Ã, Ã, dmICMMethod As DWORD
Ã, Ã, dmICMIntent As DWORD
Ã, Ã, dmMediaType As DWORD
Ã, Ã, dmDitherType As DWORD
Ã, Ã, dmReserved1 As DWORD
Ã, Ã, dmReserved2 As DWORD
Ã, Ã, dmPanningWidth As DWORD
Ã, Ã, dmPanningHeight As DWORD
End Type
declare function WinMain ( byval hInstance as HINSTANCE, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval hPrevInstance as HINSTANCE, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, szCmdLine as string, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval iCmdShow as integer ) as integer
Ã, Ã, '
Ã, Ã, ' Entry pointÃ, Ã,
Ã, Ã, '
end WinMain( GetModuleHandle( null ), null, Command$, SW_NORMAL )
declare sub ChangeScreenResolution (byval wwidth as integer, byval hheight as integer, byval bitsPerPixel as integer)
declare function ptc_open(byval width as integer, byval height as integer ) as integer
declare function ptc_update(byval buff as integer ptr) as integer
declare function ptc_close() as integer
declare sub ptc_setflip(byval interval as integer)
declare sub Main()
declare sub Init()
dim shared buffer(screenWidth*screenHeight) as uinteger
dim shared g_w as integer
dim shared g_h as integer
'Global window device context
dim shared hDC as HDC
type PFNWGLSWAPINTERVALFARPROC as sub(byval interval as integer)
dim shared wglSwapIntervalEXT as PFNWGLSWAPINTERVALFARPROC
'' ::::::::
'' name: WndProc
'' desc: Processes windows messages
''
'' ::::::::
function WndProc ( byval hWnd as HWND, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval message as UINT, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval wParam as WPARAM, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval lParam as LPARAM ) as LRESULT
Ã, Ã,
Ã, Ã, function = 0
Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Process messages
Ã, Ã, ''
Ã, Ã, select case( message )
Ã, Ã, Ã, Ã, ''
Ã, Ã, Ã, Ã, '' Window was created
Ã, Ã, Ã, Ã, ''Ã, Ã, Ã, Ã,
Ã, Ã, Ã, Ã, case WM_CREATE
Ã, Ã, Ã, Ã, Ã, Ã, exit function
Ã, Ã, Ã, Ã,
Ã, Ã, Ã, Ã, ''
Ã, Ã, Ã, Ã, '' Windows is being repainted
Ã, Ã, Ã, Ã, ''
Ã, Ã, Ã, Ã, case WM_PAINT
Ã, Ã, Ã, Ã, Ã, Ã, exit functionÃ, Ã, Ã, Ã, Ã, Ã,
Ã, Ã, Ã, Ã,
''
'' Key pressed
''
case WM_KEYDOWN
if( lobyte( wParam ) = 27 ) then
PostMessage( hWnd, WM_CLOSE, 0, 0 )
end if
Ã, Ã, Ã, Ã, ''
Ã, Ã, Ã, Ã, '' Window was closed
Ã, Ã, Ã, Ã, ''
Ã, Ã, case WM_DESTROY
Ã, Ã, Ã, Ã, Ã, Ã, PostQuitMessage( 0 )
Ã, Ã, Ã, Ã, Ã, Ã, exit function
Ã, Ã, end select
Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Message doesn't concern us, send it to the default handler
Ã, Ã, '' and get result
Ã, Ã, ''
Ã, Ã, function = DefWindowProc( hWnd, message, wParam, lParam )Ã, Ã,
Ã, Ã,
end function
'' ::::::::
'' name: WinMain
'' desc: A win32 gui program entry point
''
'' ::::::::
function WinMain ( byval hInstance as HINSTANCE, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval hPrevInstance as HINSTANCE, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, szCmdLine as string, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, byval iCmdShow as integer ) as integerÃ, Ã,
Ã, Ã, Ã,
Ã, Ã, dim wMsg as MSG
Ã, Ã, dim wcls as WNDCLASSÃ, Ã, Ã,
Ã, Ã, dim hWnd as HWND
Ã, Ã, dim windowStyle as DWORD
Ã, Ã, dim windowExtendedStyle as DWORD
Ã, Ã, dim windowRect as RECT
Ã, Ã, dimÃ, pfd as PIXELFORMATDESCRIPTOR
Ã, Ã, Ã,
Ã, Ã, function = 0
Ã, Ã,
'Window size
Ã, Ã, windowRect.leftÃ, Ã, = 0
Ã, Ã, windowRect.topÃ, Ã, = 0
Ã, Ã, windowRect.rightÃ, = screenWidth
Ã, Ã, windowRect.bottom = screenHeight
Ã, Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Setup window class
Ã, Ã, ''
Ã, Ã, with wcls
Ã, Ã, .styleÃ, Ã, Ã, Ã, Ã, = CS_HREDRAW or CS_VREDRAW or CS_OWNDC
Ã, Ã, .lpfnWndProcÃ, Ã, = @WndProc
Ã, Ã, .cbClsExtraÃ, Ã, = 0
Ã, Ã, .cbWndExtraÃ, Ã, = 0
Ã, Ã, .hInstanceÃ, Ã, Ã, = hInstance
Ã, Ã, .hIconÃ, Ã, Ã, Ã, Ã, = LoadIcon( NULL, IDI_APPLICATION )
Ã, Ã, .hCursorÃ, Ã, Ã, Ã, = LoadCursor( NULL, IDC_ARROW )
Ã, Ã, .hbrBackground = GetStockObject( WHITE_BRUSH )
Ã, Ã, .lpszMenuNameÃ, = NULL
Ã, Ã, .lpszClassName = strptr( AppicationName )
Ã, Ã, end with
Ã, Ã, Ã, Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Register the window classÃ, Ã, Ã,
Ã, Ã, ''Ã, Ã, Ã,
Ã, Ã, if( RegisterClass( @wcls ) = FALSE ) then
Ã, Ã, Ã, Ã, MessageBox( NULL, "Failed to register window class!", AppicationName, MB_ICONERROR )
Ã, Ã, Ã, Ã, exit function
Ã, Ã, end if
Ã, Ã,
' Ask The User Which Screen Mode They Prefer
if (MessageBox(NULL,"Fullscreen Mode ?", AppicationName,MB_YESNO or MB_ICONQUESTION)=IDNO) then
Ã, Ã,
Ã, Ã, Ã, Ã, 'Windowed style
Ã, Ã, Ã, Ã, windowStyle =Ã, WS_BORDER or WS_CAPTION or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX
Ã, Ã, Ã, Ã, windowExtendedStyle = WS_EX_APPWINDOWÃ,
Ã, Ã, Ã, Ã, 'Adjust Window, Account For Window Borders
Ã, Ã, Ã, Ã, AdjustWindowRectEx (@windowRect, windowStyle, 0, windowExtendedStyle)
Ã, Ã, Ã, Ã,
Ã, Ã, else
Ã, Ã, Ã, Ã, ShowCursor(false)
Ã, Ã, Ã, Ã, ChangeScreenResolution (screenWidth, screenHeight, 32)
Ã, Ã, Ã, Ã, windowStyle = WS_POPUP or WS_VISIBLE
Ã, Ã, Ã, Ã, windowExtendedStyle = WS_EX_TOPMOST
Ã, Ã, end if
Ã, Ã,
''AppicationName
Ã, Ã, '' Create the window and show it
Ã, Ã, ''
'Create our Window
hWnd =Ã, Ã, CreateWindowEx(windowExtendedStyle, _
AppicationName, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, AppicationName, _
windowStyle, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, 0, 0, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, windowRect.right - windowRect.left, _
Ã, Ã, Ã, Ã, Ã, windowRect.bottom - windowRect.top, _
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, HWND_DESKTOP, 0, _
hInstance, 0)
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã,
Ã, Ã, 'Get window device context
hDC = GetDC(hWnd)
Ã, Ã, 'Set pixel format
Ã, Ã, pfd.cColorBits = pfd.cDepthBits = 32
Ã, Ã, pfd.dwFlagsÃ, Ã, = PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER
Ã, Ã, SetPixelFormat ( hDC, ChoosePixelFormat ( hDC, @pfd) , @pfd )
Ã, Ã, wglMakeCurrent ( hDC, wglCreateContext(hDC) )
Ã, Ã,
Ã, Ã, 'Get actual screen resolution and center screen
Ã, Ã, dim as integer iSw, iSh
Ã, Ã, iSw = (GetSystemMetrics(SM_CXSCREEN)-screenWidth) / 2
Ã, Ã, iSh = (GetSystemMetrics(SM_CYSCREEN)-screenHeight) / 2
Ã, Ã, MoveWindow(hWnd, iSw, iSh, screenWidth, screenHeight, TRUE)
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã,
Ã, Ã, 'Show window/update
Ã, Ã, ShowWindow( hWnd, iCmdShow )
Ã, Ã, UpdateWindow( hWnd )
Ã, Ã,
Ã, Ã, ' Initialyze tinyptc opengl
Ã, Ã, ptc_open(screenWidth,screenHeight)
Ã, Ã,
Ã, Ã, 'Initialyze demo/intro
Ã, Ã, Init()
Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Process windows messages
Ã, Ã, ''
Ã, Ã, while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )Ã, Ã,
Ã, Ã, Ã, Ã, TranslateMessage( @wMsg )
Ã, Ã, Ã, Ã, DispatchMessage( @wMsg )
Ã, Ã, Ã, Ã, Ã, Ã, Main()
Ã, Ã, wend
Ã, Ã,
Ã, Ã, ' Switch Back To Desktop Resolution
Ã, Ã, ChangeDisplaySettings (NULL,0)
Ã, Ã,
Ã, Ã, ' Ends a process and all its threads.
Ã, Ã, ExitProcess(0)
Ã, Ã,
Ã, Ã, ''
Ã, Ã, '' Program has ended
Ã, Ã, ''
Ã, Ã, function = wMsg.wParam
end function
'Change The Screen Resolution
sub ChangeScreenResolution (byval wwidth as integer, byval hheight as integer, byval bitsPerPixel as integer)
dim dmScreenSettings as DEVMODE
ZeroMemory(@dmScreenSettings, sizeof (DEVMODE))
dmScreenSettings.dmSize = sizeof(DEVMODE)
dmScreenSettings.dmPelsWidth = wwidth
dmScreenSettings.dmPelsHeight = hheight
dmScreenSettings.dmBitsPerPel = bitsPerPixel
dmScreenSettings.dmFields = DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT
Ã, Ã, if (ChangeDisplaySettings (@dmScreenSettings, CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL) then
Ã, Ã, Ã, Ã, MessageBox(NULL,"Change Display Error", AppicationName,MB_OK or MB_ICONEXCLAMATION)
end -1
end if
Ã, Ã,
end sub
function ptc_open(byval w as integer, byval h as integer) as integer
Ã, Ã, wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALFARPROC,wglGetProcAddress("wglSwapIntervalEXT"))
Ã, Ã, ptc_setflip(1)
Ã, Ã, glViewport(0, 0, w,h)
Ã, Ã, glMatrixMode(GL_PROJECTION)
Ã, Ã, glLoadIdentity()
Ã, Ã, glOrtho(0,w,h,0,0,1)
Ã, Ã, glPixelZoom(1,-1)
Ã, Ã, glRasterPos2i(0,0)
Ã, Ã, g_w=w
Ã, Ã, g_h=h
return 0
end function
function ptc_update(byval buff as integer ptr) as integer
Ã, Ã, glDrawPixels(g_w,g_h,GL_BGRA_EXT,GL_UNSIGNED_BYTE,buff)
Ã, Ã, SwapBuffers ( hDc )
return 0
end function
function ptc_close() as integer
return 0
end function
sub ptc_setflip(byval interval as integer)
Ã, Ã, if wglSwapIntervalExt <> 0 then
Ã, Ã, Ã, Ã, wglSwapIntervalEXT(interval)
Ã, Ã, endif
end sub
'-------------------------------------------------------------
'Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Initialyze
'-------------------------------------------------------------
sub Init()
Ã, Ã, Ã, 'everything that needed to be initializedÃ, Ã,
end sub
'-------------------------------------------------------------
'Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Main Code
'-------------------------------------------------------------
sub Main()
Ã, Ã, Ã, Ã, dim x as integer
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã,
Ã, Ã, Ã, Ã, Ã, Ã, for x=0 to 639
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, buffer(x)=&hffff0000
Ã, Ã, Ã, Ã, Ã, Ã, next
Ã, Ã, Ã, Ã, Ã, Ã, for x=640 to 640*480-1
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, buffer(x)=&hffffffff
Ã, Ã, Ã, Ã, Ã, Ã, next
Ã, Ã, Ã, Ã, Ã, Ã, ptc_update(@buffer(0))
Ã, Ã, Ã, Ã, Ã, Ã, for x=0 to 639
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, buffer(x)=&hffff0000
Ã, Ã, Ã, Ã, Ã, Ã, next
Ã, Ã, Ã, Ã, Ã, Ã, for x=640 to 640*480-1
Ã, Ã, Ã, Ã, Ã, Ã, Ã, Ã, buffer(x)=&hff000000
Ã, Ã, Ã, Ã, Ã, Ã, next
Ã, Ã, Ã, Ã, Ã, Ã, ptc_update(@buffer(0))
end sub
Great job and effort Rbraz, and cheers :)
->rbraz: would it be possible for WinMain() just to call main() which is where the freebasic code starts, then make the class and window inside ptc_open? Then you could create a thread to pump the messages and hide the whole thing inside a .bi file. Or even build it into a .a file.
A couple of things I'd change
1) set hbrBackground in the class to 0.
2) add
case WM_ERASEBKGND
function=1
exit function
Those two stop any flicker that can happen when Windows decides it needs to erase your window's background.
3) You're using GetMessage(). Right now if there's no messages coming in the app will stop. Either use PeekMessage first or try the thread thing. GetMessage returns -1 on error which isn't being handled though I've never seen that happen IRL.
Good work! I wasn't looking forward to doing all that in basic :D
Jim
Thx Jim, how about this one, I added some of your suggestions and a method to use a .bi, not sure if it's the best way to do that.
And FB still with some bugs for windows gui thing :-\
It'll take some nutting out...the weekend is my best time for a look...
Jim
Still busy at work eh Jim?
Insane.
Bummer :(
Question: I get a really thick border around any effects that are happening, it's slightly smaller but visible in Windowed mode?
Is this to do with me having to set my monitors screen sizes to compensate, or is it a code thang?
Cheers and many thanks,
Clyde.
Can you make a screenshot and point me exactly what is that border, plz ?
It's quite hard to take a screen grab of it, as it's running full screen mode.
basically, theres about a 32 black pixel wide border going down the sides, and about a 3rd at the top and bottom of the screen.
If no one on this planet, is getting the same bordering effect. Then it must be to do with needing to resizing my monitor. Which will then mean that, that program isnt running at 75mhz as my monitor refresh rate is.
Cheers,
Clyde.
Work's fine here, I use a LCD monitor 60hz refresh rate, maybe you need some adjust in your monitor ???