Screen Syncing with TinyPTC()

[Rbz]

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

Code Select Expand

'---------------------------------------------------------------------------------
'Ã,  Ã, 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

[Clyde]

Great job and effort Rbraz, and cheers

[Jim]

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

Code Select Expand


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

Jim

[Rbz]

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   

[Jim]

It'll take some nutting out...the weekend is my best time for a look...

Jim

[Shockwave]

Still busy at work eh Jim?

[Jim]

Insane.

[Shockwave]

Bummer

[Clyde]

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.

[Rbz]

Can you make a screenshot and point me exactly what is that border, plz ?

[Clyde]

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.

[Rbz]

Work's fine here, I use a LCD monitor 60hz refresh rate, maybe you need some adjust in your monitor