FreeBASIC fbgfx game loop demo test for different timing methods

fbgfx-game-loop-demo-test.bas

'' --------------------------------------------------------
'' FBGFX game loop testing
''
'' from command prompt:
''    $ ./fbgfx-game-loop-demo-test  --help for options
''
'' when running:
''    UP ARROW - select previous item
''  DOWN ARROW - select next item
''       ENTER - select item
''      ESCAPE - back one menu
'' --------------------------------------------------------

#include once "fbgfx.bi"
#include once "vbcompat.bi"

'' --------------------------------------------------------
'' CONSOLE
'' --------------------------------------------------------
sub PrintConsole( byref s as const string )
	dim h as integer = freefile
	open cons for output as #h
	print s
	close #h
end sub

'' --------------------------------------------------------
'' ENUMERATE SCREEN MODES
'' --------------------------------------------------------

union SCREEN_MODE_SIZE
	mode as long
	type field = 1
#ifdef __FB_BIGENDIAN__
		w as ushort '' width - hiword
		h as ushort '' height - loword
#else
		h as ushort '' height - loword
		w as ushort '' width - hiword
#endif
	end type
end union

type SCREEN_MODE extends SCREEN_MODE_SIZE
	d as long '' depth
end type

enum SCREENMODEDEPTH_ID
	SCREENMODEDEPTH_INVALID = -1
	SCREENMODEDEPTH_8
	SCREENMODEDEPTH_15
	SCREENMODEDEPTH_16
	SCREENMODEDEPTH_24
	SCREENMODEDEPTH_32
	SCREENMODEDEPTH_COUNT
end enum

type SCREENMODELIST
	private:
		m_start_depth( 0 to SCREENMODEDEPTH_COUNT-1) as integer
		m_count_depth( 0 to SCREENMODEDEPTH_COUNT-1) as integer
		m_list(any) as SCREEN_MODE
		m_count as integer
		declare sub EnumerateDepthID( byval depth as SCREENMODEDEPTH_ID )
	public:
		declare constructor()
		declare destructor()
		declare function GetDepthID( byval bits as integer ) as SCREENMODEDEPTH_ID
		declare sub Enumerate( byval refresh as boolean = false )
		declare property Count() as integer
		declare function CountDepth( byval depth as SCREENMODEDEPTH_ID ) as integer
		declare function GetModeByDepth( byval depth as SCREENMODEDEPTH_ID, byval index as integer ) as SCREEN_MODE
		declare function GetNearestMode( byval width as long, byval height as long, byval depth as long ) as SCREEN_MODE
		declare function GetDefaultMode() as SCREEN_MODE
end type

dim shared gmodelist as SCREENMODELIST

constructor SCREENMODELIST()
	m_count = 0
	redim m_list(0 to 0) as SCREEN_MODE
end constructor

destructor SCREENMODELIST
	erase m_list
end destructor

sub SCREENMODELIST.EnumerateDepthID( byval depth_id as SCREENMODEDEPTH_ID )
	static depths( 0 to SCREENMODEDEPTH_COUNT-1) as long = { 8, 15, 16, 24, 32 }
	dim depth as long = 0
	if( depth_id >=0 and depth_id < SCREENMODEDEPTH_COUNT ) then
		depth = depths( depth_id )
	else
		exit sub
	end if

	m_count_depth( depth_id ) = 0
	m_start_depth( depth_id ) = -1

	dim start as integer = m_count
	dim m as SCREEN_MODE

	m.mode = Screenlist( depth )
	m.d = depth
	while( m.mode <> 0 )
		redim preserve m_list(0 to m_count) as SCREEN_MODE
		m_list( m_count ) = m
		m_count += 1
		m.mode = Screenlist()
	wend

	'' get any modes at the specified bit depth?
	if( m_count > start ) then
		m_count_depth( depth_id ) = m_count - start
		m_start_depth( depth_id ) = start
	end if
	
end sub

function SCREENMODELIST.GetDepthID( byval bits as integer ) as SCREENMODEDEPTH_ID
	select case bits
	case 8
		function = SCREENMODEDEPTH_8
	case 15
		function = SCREENMODEDEPTH_15
	case 16
		function = SCREENMODEDEPTH_16
	case 24
		function = SCREENMODEDEPTH_24
	case 32
		function = SCREENMODEDEPTH_32
	case else
		function = SCREENMODEDEPTH_INVALID
	end select
end function

sub SCREENMODELIST.Enumerate( byval refresh as boolean = false )
	if( refresh = false and m_count > 0 ) then
		exit sub
	end if
	m_count = 0
	for i as integer = 0 to SCREENMODEDEPTH_COUNT-1
		EnumerateDepthID( i )
	next
end sub

function SCREENMODELIST.CountDepth( byval depth_id as SCREENMODEDEPTH_ID ) as integer
	gmodelist.Enumerate()
	dim c as integer
	if( depth_id >=0 and depth_id < SCREENMODEDEPTH_COUNT ) then
		c = m_count_depth( depth_id )
	end if
	function = c
end function

function SCREENMODELIST.GetModeByDepth( byval depth_id as SCREENMODEDEPTH_ID, byval index as integer ) as SCREEN_MODE
	gmodelist.Enumerate()
	dim m as SCREEN_MODE
	if( depth_id >=0 and depth_id < SCREENMODEDEPTH_COUNT ) then
		m = m_list( m_start_depth( depth_id ) + index )
	end if
	function = m
end function

function SCREENMODELIST.GetNearestMode( byval w as long, byval h as long, byval d as long ) as SCREEN_MODE
	gmodelist.Enumerate()
	dim m as SCREEN_MODE
	'' find mode that is closest to width, height depth without being larger
	'' if any parameter is zero, choose largest value
	for i as integer = 0 to m_count - 1
		if( w = 0 or (m_list(i).w <= w and m_list(i).w >= m.w )) then
			if( h = 0 or (m_list(i).h <= h and m_list(i).h >= m.h )) then
				if( d = 0 or (m_list(i).d <= d and m_list(i).d >= m.d )) then
					m = m_list(i)
				end if
			end if
		end if
	next
	function = m
end function

function SCREENMODELIST.GetDefaultMode() as SCREEN_MODE
	gmodelist.Enumerate()
	dim w as integer, h as integer
	'' TODO: does this work in DOS?
	ScreenControl(fb.GET_DESKTOP_SIZE, w, h )
	w -= 1
	h -= 1
	dim m as SCREEN_MODE = GetNearestMode( w, h, 0 )
	function = m
end function

'' --------------------------------------------------------
'' CHECK SCREEN MODES
'' --------------------------------------------------------

function CheckScreenModeValid( byval w as short, byval h as short, byval depth as long ) as boolean

	dim m as SCREEN_MODE_SIZE

	m.mode = Screenlist( depth )

	while( m.mode <> 0 )
		if( m.w = w andalso m.h = h) then
			return true
		end if
		m.mode = Screenlist()
	wend

	return false

end function

function FormatScreenMode( byref m as const SCREEN_MODE_SIZE, byval depth as const long ) as string
	function = m.w & " x " & m.h & " x " & depth & "bit"
end function

sub ListScreenModes( byval w as short, byval h as short, byval depth as long )

	if( depth = 0 ) then
		ListScreenModes( w, h, 8 )
		ListScreenModes( w, h, 15 )
		ListScreenModes( w, h, 16 )
		ListScreenModes( w, h, 24 )
		ListScreenModes( w, h, 32 )
		exit sub
	end if

	dim m as SCREEN_MODE_SIZE

	m.mode = Screenlist( depth )

	while( m.mode <> 0 )
		if((w=0 orelse (w<>0 andalso m.w=w)) andalso (h=0 orelse (h<>0 andalso m.h=h))) then
			PrintConsole( FormatScreenMode( m, depth ) )
		end if
		m.mode = Screenlist()
	wend

end sub

'' --------------------------------------------------------
'' SYSTIMER
'' --------------------------------------------------------

enum MARK_TIMER
	MARK_TIMER_BEGIN
	MARK_TIMER_INPUT
	MARK_TIMER_SYNC1
	MARK_TIMER_LOCK
	MARK_TIMER_DRAWING
	MARK_TIMER_UNLOCK
	MARK_TIMER_SYNC2
	MARK_TIMER_FLIP
	MARK_TIMER_SLEEP

	MARK_TIMER_COUNT
end enum

type SYSTIMER

	tmarks_curr( 0 to MARK_TIMER_COUNT ) as double
	tmarks_last( 0 to MARK_TIMER_COUNT ) as double
	tmark as double

	tcurr as double		'' timer in seconds, current
	tlast as double		'' timer in seconds, last checked
	tdelta as double	'' time (duration) since last frame, in seconds
	tframes as double	'' timing of frames for calculating fps
	nframes as double	'' number of frames for calculating fps
	fps as double		'' frames per second, updated once per second
	
	declare constructor( )
	declare destructor( )
	
	declare sub Update( )
	declare sub Mark( byval index as MARK_TIMER )
	declare function GetMark( byval index as MARK_TIMER ) as double
	
end type

dim shared gtimer as SYSTIMER

constructor SYSTIMER
	tcurr = timer()
	tlast = tcurr - 0.001
	tdelta = 0.001
	tframes = 0
	nframes = 0
	tmark = tcurr
end constructor

destructor SYSTIMER
end destructor

sub SYSTIMER.Update( )

	tlast = tcurr
	tcurr = timer()
	tdelta = tcurr - tlast
	
	tframes += tdelta
	nframes += 1
	
	if tframes >= 1.0 then
		fps = nframes / tframes 
		nframes = 0
		tframes = 0.0

		for i as integer = 0 to MARK_TIMER_COUNT
			tmarks_last(i) = tmarks_curr(i)
		next
	end if

	tmark = tcurr
	tmarks_curr(MARK_TIMER_COUNT) = 0
	
end sub

sub SYSTIMER.Mark( byval index as MARK_TIMER )
	dim tmp as double = TIMER
	tmarks_curr( index ) = tmp - tmark
	tmarks_curr(MARK_TIMER_COUNT) += tmarks_curr( index )
	tmark = tmp
end sub

function SYSTIMER.GetMark( byval index as MARK_TIMER ) as double
	function = tmarks_last(index)
end function

'' --------------------------------------------------------
'' KEYBOARD INPUT
'' --------------------------------------------------------

enum KEECODE

	K_NULL     = 0

	K_ENTER    = 13
	K_SPACE    = 32
	K_ESCAPE   = 27
	

	K_UP       = &h48ff
	K_DOWN     = &h50ff
	K_CLOSE    = &h6Bff

end enum

function GetKeeCode() as KEECODE
	function = cvl( inkey + chr(0) + chr(0) + chr(0) + chr(0) )
end function

'' --------------------------------------------------------
'' COLOUR PALETTE (8bit & RGB)
'' --------------------------------------------------------

enum COLOR_MODE
	COLOR_MODE_8BIT = 0
	COLOR_MODE_RGB  = 1
end enum

dim shared g_color_mode as COLOR_MODE = COLOR_MODE_8BIT
dim shared g_fore_color as long = 7
dim shared g_back_color as long = 0
dim shared g_qbcolor(0 to 15) as long = _
	{ _
		rgb(  0,  0,  0), rgb(  0,  0,192), rgb(  0,192,  0), rgb(  0,192,192), _
		rgb(192,  0,  0), rgb(192,  0,192), rgb(192, 64,  0), rgb(192,192,192), _
		rgb( 64, 64, 64), rgb( 64, 64,255), rgb( 64,255, 64), rgb( 64,255,255), _
		rgb(255, 64, 64), rgb(255, 64,255), rgb(255,255, 64), rgb(255,255,255) _
	}

function hGetColor( byval index as long ) as long
	if( g_color_mode = COLOR_MODE_8BIT ) then
		return index
	endif
	return g_qbcolor( index mod 16 )
end function

sub hColor( byval f as long, b as long )
	Color hGetColor(f), hGetColor(b)
end sub

'' --------------------------------------------------------
'' GFXSCREEN
'' --------------------------------------------------------

type GFXSCREEN
	width as long
	height as long
	depth as long
	pages as long
	EnableScreenLock as boolean
	EnableScreenSync1 as boolean
	EnableScreenSync2 as boolean
	EnableFullScreen as boolean
	EnableSleep as boolean
	page as long
	declare constructor()
	declare destructor()
	declare sub Init()
end type

constructor GFXSCREEN()
	width = 0
	height = 0
	depth = 0
	pages = 0
	EnableScreenLock = false
	EnableScreenSync1 = false
	EnableScreenSync2 = false
	EnableSleep = true
	EnableFullScreen = false
	page = 0
end constructor

destructor GFXSCREEN()
end destructor

sub GFXSCREEN.Init()

	dim flags as long = 0
	if( EnableFullScreen ) then
		flags or= fb.GFX_FULLSCREEN
	end if
	
	'' always set up 2 pages
	screenres width, height, depth, 2, flags
	
	select case pages
	case 0
		page = 0
		screenset 0, 0
	case 1
		page = 0
		screenset 1, 0
	case 2
		page = 0
		screenset 1, 0
	end select

	if( depth > 8 ) then
		g_color_mode = COLOR_MODE_RGB
	else
		g_color_mode = COLOR_MODE_8BIT
	end if

end sub

dim shared gfx as GFXSCREEN

'' --------------------------------------------------------
'' UI_LISTBOX (ListBox, VB like interface)
'' --------------------------------------------------------

type UI_LISTBOX extends object
	private:
		m_left as integer
		m_top as integer
		m_width as integer
		m_height as integer
		m_topindex as integer
		m_listindex as integer
		m_listcount as integer
		m_items(any) as string
		m_keys(any) as long
		m_newindex as integer
	public:
		declare constructor()
		declare destructor()
		declare sub AddItem( byref text as const string )
		declare const property TopIndex() as integer
		declare property TopIndex( byval index as integer )
		declare const property List( byval index as integer ) as string
		declare property List( byval index as integer, byref value as string )
		declare const property ItemData( byval index as integer ) as integer
		declare property ItemData( byval index as integer, byref value as integer )
		declare const property ListIndex() as integer
		declare property ListIndex( byval index as integer )
		declare const property ListCount() as integer
		declare const property NewIndex() as integer
		declare sub Move( byval l as integer = -1, byval t as integer = -1, byval w as integer = -1, byval h as integer = -1)
		declare const property Left() as integer
		declare const property Top() as integer
		declare const property Width() as integer
		declare const property Height() as integer
		declare function Inputhandler( byref kee as KEECODE ) as boolean
end type

constructor UI_LISTBOX()
	m_left = 0
	m_top = 0
	m_width = 10
	m_height = 20
	m_topindex = 0
	m_listindex = -1
	m_listcount = 0
	m_newindex = -1
	redim m_items(0 to 0) as string
	redim m_keys(0 to 0) as long
end constructor

destructor UI_LISTBOX()
	for i as integer = 0 to m_listcount-1
		m_items(i) = ""
	next
	erase m_items
	erase m_keys
end destructor

sub UI_LISTBOX.AddItem( byref text as const string )
	m_listcount += 1
	redim preserve m_items( 0 to m_listcount-1 ) as string
	redim preserve m_keys( 0 to m_listcount-1 ) as long
	m_items( m_listcount-1 ) = text
	if( m_listindex < 0 ) then
		m_listindex = 0
	end if
	m_newindex = m_listcount-1
end sub

property UI_LISTBOX.TopIndex() as integer
	property = m_topindex
end property

property UI_LISTBOX.TopIndex( byval index as integer )
	if index >= 0 and index < m_listcount then
		m_topindex = index
	end if
end property

property UI_LISTBOX.List( byval index as integer ) as string
	if index >= 0 and index < m_listcount then
		property = m_items(index)
	else
		property = ""
	end if
end property

property UI_LISTBOX.List( byval index as integer, byref text as string )
	if index >= 0 and index < m_listcount then
		m_items(index) = text
	end if
end property

property UI_LISTBOX.ItemData( byval index as integer ) as integer
	if index >= 0 and index < m_listcount then
		property = m_keys(index)
	else
		property = 0
	end if
end property

property UI_LISTBOX.ItemData( byval index as integer, byref value as integer )
	if index >= 0 and index < m_listcount then
		m_keys(index) = value
	end if
end property

property UI_LISTBOX.ListIndex() as integer
	property = m_listindex
end property

property UI_LISTBOX.ListIndex( byval index as integer )
	if index >= -1 and index < m_listcount then
		m_listindex = index
	end if
end property

property UI_LISTBOX.ListCount() as integer
	property = m_listcount
end property

property UI_LISTBOX.NewIndex() as integer
	property = m_newindex
end property

sub UI_LISTBOX.Move( byval l as integer = -1, byval t as integer = -1, byval w as integer = -1, byval h as integer = -1)
	if( l > 0 ) then m_left = l
	if( t > 0 ) then m_top = t
	if( w > 0 ) then m_width = w
	if( h > 0 ) then m_height = h
end sub

property UI_LISTBOX.Left() as integer
	property = m_left
end property

property UI_LISTBOX.Top() as integer
	property = m_top
end property

property UI_LISTBOX.Width() as integer
	property = m_width
end property

property UI_LISTBOX.Height() as integer
	property = m_height
end property

function UI_LISTBOX.InputHandler( byref kee as KEECODE ) as boolean

	select case kee
	case K_UP
		with this
			if( .ListIndex > 0 ) then
				.ListIndex = .ListIndex - 1
				if( .ListIndex < .TopIndex ) then
					.TopIndex = .ListIndex
				end if
			end if
		end with
		return true

	case K_DOWN
		with this
			if( .ListIndex < .ListCount-1 ) then
				.ListIndex = .ListIndex + 1
				if( .ListIndex > .TopIndex + .Height - 1 ) then
					.TopIndex = .ListIndex - .Height + 1
				end if
			end if
		end with
		return true

	end select

	return false

end function

'' --------------------------------------------------------
'' cheap & dirty UI renderer
'' --------------------------------------------------------

sub hPrintAt( byval x as integer, byval y as integer, byref s as const string )
	'' for simplicity, just using locate to position text
	locate y+1,x+1
	print s;
end sub

sub hDrawFrame( byval l as integer, byval t as integer, byval w as integer, byval h as integer, byref title as string = "" )
	if( title > "" ) then
		hPrintAt( l-1, t-3, chr(218) + string(w, 196) + chr(191) )
		hPrintAt( l-1, t-2, chr(179) + left( title & space(w), w ) + chr(179) )
		hPrintAt( l-1, t-1, chr(195) + string(w, 196) + chr(180) )
	else
		hPrintAt( l-1, t-1, chr(218) + string(w, 196) + chr(191) )
	end if
	for row as integer = 0 to h-1
		hPrintAt( l-1, t+row, chr(179) )
		hPrintAt( l+w, t+row, chr(179) )
	next
	hPrintAt( l-1, t+h, chr(192) + string(w, 196) + chr(217) )
end sub

sub hDrawListBox( byref lst as const UI_LISTBOX )
	dim s as string
	dim t as integer

	for row as integer = 0 to lst.Height-1
		t = lst.TopIndex + row
		if( t < lst.ListCount ) then
			s = left( lst.List(t) & space(lst.Width), lst.Width )
		else
			s = space(lst.Width)
		end if
		if( t = lst.ListIndex ) then
			hColor 0, 7
		else
			hColor 7, 0
		end if
		locate lst.Top + row + 1, lst.Left + 1
		print s;
	next

end sub

'' --------------------------------------------------------
'' MENUBOX - extends listbox with frame and title
'' --------------------------------------------------------

enum MENUID
	MENUID_INVALID = 0
	MENUID_EXIT
	MENUID_MAIN
	MENUID_SET_DRAW_METHOD
	MENUID_SETMODE_8
	MENUID_SETMODE_15
	MENUID_SETMODE_16
	MENUID_SETMODE_24
	MENUID_SETMODE_32

	MENUID_COUNT
end enum

enum MENUITEMID
	IDM_NOACTION = 0
	
	IDM_SUBMENU_SET_DRAW_METHOD
	IDM_SUBMENU_SETMODE_8
	IDM_SUBMENU_SETMODE_15
	IDM_SUBMENU_SETMODE_16
	IDM_SUBMENU_SETMODE_24
	IDM_SUBMENU_SETMODE_32
	IDM_SUBMENU_EXIT

	IDM_TOGGLE_SCREENSYNC1
	IDM_TOGGLE_SCREENSYNC2
	IDM_TOGGLE_SCREENLOCK
	IDM_TOGGLE_SLEEP
	IDM_TOGGLE_FULLSCREEN
	IDM_TOGGLE_SHOWSTATS
	IDM_TOGGLE_SHOWLOOP
	IDM_EXIT_OK
	IDM_CANCEL

	IDM_DRAW_METHOD_RAW
	IDM_DRAW_METHOD_SYNC
	IDM_DRAW_METHOD_LOCK
	IDM_DRAW_METHOD_DBLBUFF
	IDM_DRAW_METHOD_PAGEFLIP

	IDM_SETMODE_8
	IDM_SETMODE_15
	IDM_SETMODE_16
	IDM_SETMODE_24
	IDM_SETMODE_32

end enum

type MENUBOX extends UI_LISTBOX
	private:
		m_title as string
	public:
		declare sub AddMenuItem( byref text as const string, byval id as MENUITEMID )
		declare property Title() as string
		declare property Title( byref value as const string )
		declare sub Draw()
		declare function Inputhandler( byval kee as KEECODE ) as boolean
end type

sub MENUBOX.AddMenuItem( byref text as const string, byval id as MENUITEMID )
	AddItem( text )
	ItemData( NewIndex ) = id
end sub

property MENUBOX.Title() as string
	property = m_title
end property

property MENUBOX.Title( byref value as const string )
	m_title = value
end property

sub MENUBOX.Draw()
	hColor 7, 0
	hDrawFrame( this.Left, this.Top, this.Width, this.Height, this.Title ) 
	hDrawListBox this
end sub

function MENUBOX.Inputhandler( byval kee as KEECODE ) as boolean
	function = base.InputHandler( kee )
end function

'' --------------------------------------------------------
'' MENUSTACK - menu navigation
'' --------------------------------------------------------

type MENUSTACK
	private:
		const MAX_DEPTH = 9
		m_count as integer
		m_menus(any) as MENUBOX
		m_stack(0 to MAX_DEPTH) as integer
		m_index as integer = 0
		m_action as MENUITEMID = IDM_NOACTION
	public:
		declare constructor()
		declare destructor()
		declare function AddMenu() byref as MENUBOX
		declare sub Push( byval id as const MENUID )
		declare sub Pop()
		declare property Count as integer
		declare property TopMenu() byref as MENUBOX
		declare sub Draw()
		declare function Inputhandler( byref kee as KEECODE ) as boolean
		declare property Action() as MENUITEMID
end type

dim shared gmenu as MENUSTACK

constructor MENUSTACK()
	m_count = 0
	'' zero entry is reserved for invalid menu
	redim m_menus(0 to m_count) as MENUBOX
	m_stack(0) = MENUID_INVALID
end constructor

destructor MENUSTACK()
end destructor

function MENUSTACK.AddMenu() byref as MENUBOX
	m_count += 1
	redim preserve m_menus(0 to m_count) as MENUBOX
	function = m_menus(m_count)
end function

sub MENUSTACK.Push( byval id as const MENUID )
	if( m_index < MAX_DEPTH ) then
		if( id > MENUID_INVALID and id < MENUID_COUNT ) then
			m_index += 1
			m_stack(m_index) = id

			if( m_index > 1 ) then
				with m_menus( m_stack( m_index-1 ))
					TopMenu.Move .Left + 3, .Top + 3
				end with
			end if
		end if
	end if
end sub

sub MENUSTACK.Pop()
	if( m_index > 0 ) then
		m_index -= 1
	end if
end sub

property MENUSTACK.Count() as integer
	property = m_index
end property

property MENUSTACK.TopMenu() byref as MENUBOX
	return m_menus( m_stack( m_index ) )
end property

sub MENUSTACK.Draw()
	if( m_index > 0 ) then
		for i as integer = 1 to m_index
			m_menus( m_stack(i) ).Draw
		next
	end if
end sub

function MENUSTACK.InputHandler( byref kee as KEECODE ) as boolean
	
	m_action = IDM_NOACTION

	if( m_index = 0 ) then
		return false
	end if

	if( TopMenu.InputHandler( kee ) ) then
		return true
	else
		select case kee
		case K_ENTER
			m_action = TopMenu.ItemData( TopMenu.ListIndex )
			return true

		case K_ESCAPE
			Pop()
			return true

		end select
	end if

	return false
end function

property MENUSTACK.Action() as MENUITEMID
	property = m_action
end property

'' --------------------------------------------------------
'' MENUS
'' --------------------------------------------------------

sub menu_init()

	'' Menus added in same order as ENUM MENUID

	'' MENUID_EXIT
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 10, 10 )
			.Title = "EXIT?"
			.AddMenuItem "OK", IDM_EXIT_OK
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_MAIN
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 26, 15 )
			.Title = "Main Menu"
			.AddMenuItem "Set Draw Method", IDM_SUBMENU_SET_DRAW_METHOD
			.AddMenuItem "Set 8 Bit Mode", IDM_SUBMENU_SETMODE_8
			.AddMenuItem "Set 15 Bit Mode", IDM_SUBMENU_SETMODE_15
			.AddMenuItem "Set 16 Bit Mode", IDM_SUBMENU_SETMODE_16
			.AddMenuItem "Set 24 Bit Mode", IDM_SUBMENU_SETMODE_24
			.AddMenuItem "Set 32 Bit Mode", IDM_SUBMENU_SETMODE_32
			.AddMenuItem "Toggle ScreenSync 1", IDM_TOGGLE_SCREENSYNC1
			.AddMenuItem "Toggle ScreenLock", IDM_TOGGLE_SCREENLOCK
			.AddMenuItem "Toggle ScreenSync 2", IDM_TOGGLE_SCREENSYNC2
			.AddMenuItem "Toggle Sleep", IDM_TOGGLE_SLEEP
			.AddMenuItem "Toggle Full Screen", IDM_TOGGLE_FULLSCREEN
			.AddMenuItem "Toggle Show Stats", IDM_TOGGLE_SHOWSTATS
			.AddMenuItem "Toggle Show Loop", IDM_TOGGLE_SHOWLOOP
			.AddMenuItem "Exit", IDM_SUBMENU_EXIT
		end with
	end scope

	'' MENUID_SET_DRAW_METHOD
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 10 )
			.Title = "Set Draw Method"
			.AddMenuItem "Raw Coding", IDM_DRAW_METHOD_RAW
			.AddMenuItem "Synchronizing", IDM_DRAW_METHOD_SYNC
			.AddMenuItem "Locking", IDM_DRAW_METHOD_LOCK
			.AddMenuItem "Double Buffering", IDM_DRAW_METHOD_DBLBUFF
			.AddMenuItem "Page Flipping", IDM_DRAW_METHOD_PAGEFLIP
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_SETMODE_8
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 20 )
			.Title = "Choose 8 bit Screen Mode"
			for i as integer = 0 to gmodelist.CountDepth( SCREENMODEDEPTH_8 ) -1
				.AddMenuItem FormatScreenMode( gmodelist.GetModeByDepth( SCREENMODEDEPTH_8, i ), 8 ), IDM_SETMODE_8
			next
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_SETMODE_15
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 20 )
			.Title = "Choose 15 bit Screen Mode"
			for i as integer = 0 to gmodelist.CountDepth( SCREENMODEDEPTH_15 ) -1
				.AddMenuItem FormatScreenMode( gmodelist.GetModeByDepth( SCREENMODEDEPTH_15, i ), 15 ), IDM_SETMODE_15
			next
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_SETMODE_16
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 20 )
			.Title = "Choose 16 bit Screen Mode"
			for i as integer = 0 to gmodelist.CountDepth( SCREENMODEDEPTH_16 ) -1
				.AddMenuItem FormatScreenMode( gmodelist.GetModeByDepth( SCREENMODEDEPTH_16, i ), 16 ), IDM_SETMODE_16
			next
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_SETMODE_24
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 20 )
			.Title = "Choose 24 bit Screen Mode"
			for i as integer = 0 to gmodelist.CountDepth( SCREENMODEDEPTH_24 ) -1
				.AddMenuItem FormatScreenMode( gmodelist.GetModeByDepth( SCREENMODEDEPTH_24, i ), 24 ), IDM_SETMODE_24
			next
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	'' MENUID_SETMODE_32
	scope
		dim byref m as MENUBOX = gmenu.AddMenu()
		with m
			.move( 5, 5, 20, 20 )
			.Title = "Choose 32 bit Screen Mode"
			for i as integer = 0 to gmodelist.CountDepth( SCREENMODEDEPTH_32 ) -1
				.AddMenuItem FormatScreenMode( gmodelist.GetModeByDepth( SCREENMODEDEPTH_32, i ), 32 ), IDM_SETMODE_32
			next
			.AddMenuItem "Cancel", IDM_CANCEL
		end with
	end scope

	gmenu.Push( MENUID_MAIN )

end sub

'' --------------------------------------------------------
'' GAME
'' --------------------------------------------------------

type GAME
	ExitFlag as boolean = false
	NewMode as boolean = false
	ShowStats as boolean = true
	ShowLoop as boolean = true
end type

dim shared gopt as GAME

type BAR
	x as double
	y as double
	dx as double
	dy as double
	c1 as long
	c2 as long
end type

sub game_frame( byval dt as double )

	const size = 40

	static bars(1 to 4) as BAR = { _
		( 0, 0, 60, 60, 1, 2 ), _
		( 0, 0,100,100, 3, 4 ), _
		( 0, 0,120,120, 5, 6 ), _
		( 0, 0,200,200, 7, 8 ) _
	}

	for i as integer = 1 to 4
		with bars(i)

			if( .x < 0 and .dx < 0 ) then .dx = -.dx
			if( (.x + size) >= gfx.width and .dx > 0 ) then .dx = -.dx
			if( .y < 0 and .dy < 0 ) then .dy = -.dy
			if( (.y + size) >= gfx.height and .dy > 0 ) then .dy = -.dy

			.x += .dx * dt
			.y += .dy * dt

			line (.x,0) - (.x+size,gfx.height-1), hGetColor(.c1), bf
			line (0,.y) - (gfx.width-1,.y+size), hGetColor(.c2), bf

		end with
	next
	

end sub

sub game_input( byref kee as KEECODE )

	if( gmenu.InputHandler( kee ) ) then

		select case gmenu.Action
		case IDM_CANCEL
			gmenu.Pop()

		case IDM_SUBMENU_EXIT
			gmenu.Push( MENUID_EXIT )

		case IDM_SUBMENU_SET_DRAW_METHOD
			gmenu.Push( MENUID_SET_DRAW_METHOD )

		case IDM_SUBMENU_SETMODE_8
			gmenu.Push( MENUID_SETMODE_8 )

		case IDM_SUBMENU_SETMODE_15
			gmenu.Push( MENUID_SETMODE_15 )

		case IDM_SUBMENU_SETMODE_16
			gmenu.Push( MENUID_SETMODE_16 )

		case IDM_SUBMENU_SETMODE_24
			gmenu.Push( MENUID_SETMODE_24 )

		case IDM_SUBMENU_SETMODE_32
			gmenu.Push( MENUID_SETMODE_32 )

		case IDM_EXIT_OK
			gopt.ExitFlag = true

		case IDM_SETMODE_8
			dim m as SCREEN_MODE = gmodelist.GetModeByDepth( SCREENMODEDEPTH_8, gmenu.TopMenu.listIndex )
			gfx.width = m.w
			gfx.height = m.h
			gfx.depth = 8
			gopt.NewMode = true
			
		case IDM_SETMODE_15
			dim m as SCREEN_MODE = gmodelist.GetModeByDepth( SCREENMODEDEPTH_15, gmenu.TopMenu.listIndex )
			gfx.width = m.w
			gfx.height = m.h
			gfx.depth = 8
			gopt.NewMode = true

		case IDM_SETMODE_16
			dim m as SCREEN_MODE = gmodelist.GetModeByDepth( SCREENMODEDEPTH_16, gmenu.TopMenu.listIndex )
			gfx.width = m.w
			gfx.height = m.h
			gfx.depth = 8
			gfx.depth = 16
			gopt.NewMode = true

		case IDM_SETMODE_24
			dim m as SCREEN_MODE = gmodelist.GetModeByDepth( SCREENMODEDEPTH_24, gmenu.TopMenu.listIndex )
			gfx.width = m.w
			gfx.height = m.h
			gfx.depth = 8
			gfx.depth = 24
			gopt.NewMode = true

		case IDM_SETMODE_32
			dim m as SCREEN_MODE = gmodelist.GetModeByDepth( SCREENMODEDEPTH_32, gmenu.TopMenu.listIndex )
			gfx.width = m.w
			gfx.height = m.h
			gfx.depth = 8
			gfx.depth = 32
			gopt.NewMode = true

		case IDM_TOGGLE_SCREENSYNC1
			gfx.EnableScreenSync1 = not gfx.EnableScreenSync1

		case IDM_TOGGLE_SCREENSYNC2
			gfx.EnableScreenSync2 = not gfx.EnableScreenSync2

		case IDM_TOGGLE_SLEEP
			gfx.EnableSleep = not gfx.EnableSleep

		case IDM_TOGGLE_SCREENLOCK
			gfx.EnableScreenLock = not gfx.EnableScreenLock

		case IDM_TOGGLE_FULLSCREEN
			gfx.EnableFullScreen = not gfx.EnableFullScreen
			gopt.NewMode = true

		case IDM_TOGGLE_SHOWSTATS
			gopt.ShowStats = not gopt.ShowStats

		case IDM_TOGGLE_SHOWLOOP
			gopt.ShowLoop = not gopt.ShowLoop

		case IDM_DRAW_METHOD_RAW
			gfx.EnableScreenSync1 = false
			gfx.EnableScreenSync2 = false
			gfx.EnableScreenLock = false
			gfx.EnableSleep = true
			gfx.pages = 0
			gfx.page = 0
			screenset 0, 0

		case IDM_DRAW_METHOD_SYNC
			gfx.EnableScreenSync1 = true
			gfx.EnableScreenSync2 = false
			gfx.EnableScreenLock = false
			gfx.EnableSleep = true
			gfx.pages = 0
			gfx.page = 0
			screenset 0, 0

		case IDM_DRAW_METHOD_LOCK
			gfx.EnableScreenSync1 = false
			gfx.EnableScreenSync2 = false
			gfx.EnableScreenLock = true
			gfx.EnableSleep = true
			gfx.pages = 0
			gfx.page = 0
			screenset 0, 0

		case IDM_DRAW_METHOD_DBLBUFF
			gfx.EnableScreenSync1 = false
			gfx.EnableScreenSync2 = false
			gfx.EnableScreenLock = false
			gfx.EnableSleep = true
			gfx.pages = 1
			gfx.page = 0
			screenset 1, 0

		case IDM_DRAW_METHOD_PAGEFLIP
			gfx.EnableScreenSync1 = false
			gfx.EnableScreenSync2 = false
			gfx.EnableScreenLock = false
			gfx.EnableSleep = true
			gfx.pages = 2
			gfx.page = 0
			screenset 1, 0

		end select

	end if

end sub

sub hPrintStats( byval x as integer, byval y as integer )

	dim w as integer, h as integer, d as integer, driver_name as string
	ScreenControl( fb.GET_SCREEN_SIZE, w, h )
	ScreenControl( fb.GET_SCREEN_DEPTH, d )
	ScreenControl( fb.GET_DRIVER_NAME, driver_name )
	hColor( 7, 0 )
	hPrintAt( x, y, "FPS: " & int(gtimer.fps*1000)/1000 & " W=" & w & " H=" & h & " D=" & d )
	hPrintAt( x, y+1, "Driver: " & driver_name )

end sub

sub hPrintTimeMark( byval index as MARK_TIMER )
	print "  " & right( space(8) & format( (int( gtimer.GetMark( index ) * 1000000)/1000), "0.000" ), 8 ) & " msec"
end sub

sub hPrintGameLoop( byval x as integer, byval y as integer )

	dim yy as integer = y, xx as integer = x

	select case gfx.pages
	case 0
	case 1
		hPrintAt( xx, yy, "screenset 1,0" )
		yy += 1
	case 2
		hPrintAt( xx, yy, "screenset 1,0" )
		yy += 1
		hPrintAt( xx, yy, "p=0" )
		yy += 1
	end select
	
	hPrintAt( x, yy, "do" )
	yy += 1
	xx += 2

		hPrintAt( xx, yy, "input             " )
		hPrintTimeMark( MARK_TIMER_INPUT )
		yy += 1

	if( gfx.EnableScreenSync1 ) then
		hPrintAt( xx, yy, "screensync        " )
		hPrintTimeMark( MARK_TIMER_SYNC1 )
		yy += 1
	end if
	if( gfx.EnableScreenLock ) then
		hPrintAt( xx, yy, "screenlock        " )
		hPrintTimeMark( MARK_TIMER_LOCK )
		yy += 1
	end if

		hPrintAt( xx, yy, "draw              " )
		hPrintTimeMark( MARK_TIMER_DRAWING )
		yy += 1

	if( gfx.EnableScreenLock ) then
		hPrintAt( xx, yy, "screenunlock      " )
		hPrintTimeMark( MARK_TIMER_UNLOCK )
		yy += 1
	end if
	if( gfx.EnableScreenSync2 ) then
		hPrintAt( xx, yy, "screensync        " )
		hPrintTimeMark( MARK_TIMER_SYNC2 )
		yy += 1
	end if

	select case gfx.pages
	case 0
	case 1
		hPrintAt( xx, yy, "screencopy        " )
		hPrintTimeMark( MARK_TIMER_FLIP )
		yy += 1
	case 2
		hPrintAt( xx, yy, "screenset p, 1-p  " )
		hPrintTimeMark( MARK_TIMER_FLIP )
		yy += 1
		hPrintAt( xx, yy, "p = 1-p           " )
		yy += 1
	end select

	if( gfx.EnableSleep ) then
		hPrintAt( xx, yy, "sleep 1           " )
		hPrintTimeMark( MARK_TIMER_SLEEP )
		yy += 1
	end if

	xx -= 2
	hPrintAt( x, yy, "loop                " )
	hPrintTimeMark( MARK_TIMER_COUNT )
	yy += 1

end sub

sub game_loop()

	dim last_kee as KEECODE
	dim kee as KEECODE

	do
		'' UPDATE SYSTEM TIMER
		
		gtimer.update()

		'' INPUT
		gtimer.mark( MARK_TIMER_BEGIN )

		kee = GetKeeCode()
		if( kee <> K_NULL ) then
			last_kee = kee
		end if
		if( gmenu.Count = 0 and kee = K_ESCAPE ) then
			gmenu.Push( MENUID_MAIN )
		elseif( kee = K_CLOSE ) then
			gopt.ExitFlag = true
		else
			game_input( kee )
		end if
		gtimer.mark( MARK_TIMER_INPUT )

		'' DRAWING

		if( gfx.EnableScreenSync1 ) then
			screensync
			gtimer.mark( MARK_TIMER_SYNC1 )
		end if
		
		if( gfx.EnableScreenLock ) then
			screenlock
			gtimer.mark( MARK_TIMER_LOCK )
		end if

		cls
		game_frame( gtimer.tdelta )
		gmenu.Draw()
		
		if( gopt.ShowStats ) then
			hPrintStats( 40, 1 )
			print " KEE=" & hex(last_kee)
		end if

		if( gopt.ShowLoop ) then
			hPrintGameLoop( 40, 3 )
		end if

		gtimer.mark( MARK_TIMER_DRAWING )

		'' DISPLAY

		if( gfx.EnableScreenLock ) then
			screenunlock
			gtimer.mark( MARK_TIMER_UNLOCK )
		end if
		
		if( gfx.EnableScreenSync2 ) then
			screensync
			gtimer.mark( MARK_TIMER_SYNC2 )
		end if

		select case gfx.pages
		case 0
		case 1
			screencopy
			gtimer.mark( MARK_TIMER_FLIP )
		case 2
			screenset gfx.page, 1-gfx.page
			gfx.page = 1-gfx.page
			gtimer.mark( MARK_TIMER_FLIP )
		end select

		if( gfx.EnableSleep ) then
			sleep 1
			gtimer.mark( MARK_TIMER_SLEEP )
		end if
		
	loop until gopt.ExitFlag or gopt.NewMode

end sub

sub game_main()

	menu_init()

	gfx.EnableScreenSync1 = true

	do
		gfx.init()
		gopt.NewMode = false

		game_loop()

	loop until gopt.ExitFlag

end sub

'' --------------------------------------------------------
'' WINDOWS SPECIFIC
'' --------------------------------------------------------

#ifdef __FB_WIN32__

	#include once "windows.bi"

	'' if not running from command line, add SLEEP statment

	sub MaybeSleep()
		dim as HWND consoleWnd = GetConsoleWindow()
		dim as DWORD dwProcessId
		GetWindowThreadProcessId(consoleWnd, @dwProcessId)
		if( GetCurrentProcessId() = dwProcessId ) then
			locate 1, 1
			hColor 15, 0
			print "PRESS ANY KEY TO EXIT ...     "
			sleep
		end if
	end sub

#else

	#define MaybeSleep()

#endif

#macro end_program( exit_code )
	MaybeSleep()
	end exit_code
#endmacro

'' --------------------------------------------------------
'' MAIN ENTRY POINT
'' --------------------------------------------------------

dim as integer opt_width = 0
dim as integer opt_height = 0
dim as integer opt_depth = 0
dim as boolean opt_list_modes = false
dim as boolean opt_help = false

dim i as integer = 1
while( command(i) > "" )
	select case left(command(i),1)
	case "-"
		select case command(i)
		case "-h", "--help"
			opt_help = true
		case "-listmodes"
			opt_list_modes = true
		case "-dw"
			i += 1: opt_width = cint(command(i))
		case "-dh"
			i += 1: opt_height = cint(command(i))
		case "-dd"
			i += 1: opt_depth = cint(command(i))
		case "-listmodes"
			opt_list_modes = true
		case else
			PrintConsole( "unrecognized option '" & command(i) & "'" )
			end_program(1)
		end select
	case else
		print "unexpected option '" & command(i) & "'"
	end select
	i += 1
wend

if( opt_help ) then
	PrintConsole( "fbgfx-game-loop-demo [options]" )
	PrintConsole( "options:" )
	PrintConsole( "   -h, --help     show help" )
	PrintConsole( "   -dw WIDTH      set display width" )
	PrintConsole( "   -dh HEIGHT     set display height" )
	PrintConsole( "   -dd DEPTH      set display depth" )
	PrintConsole( "   -listmodes     list all screen modes" )
	end_program(0)
end if

gmodelist.Enumerate()

if( opt_list_modes ) then
	ListScreenModes( opt_width, opt_height, opt_depth )
	end_program(0)
end if

scope
	dim m as SCREEN_MODE 
	if( opt_width = 0 and opt_height = 0 and opt_depth = 0 ) then	
		m = gmodelist.GetDefaultMode()
	else
		m = gmodelist.GetNearestMode( opt_width, opt_height, opt_depth )
	end if
	opt_width = m.w
	opt_height = m.h
	opt_depth = m.d
end scope

if( CheckScreenModeValid( opt_width, opt_height, opt_depth ) = false ) then
	PrintConsole( "Invalid screen mode " & opt_width & "x" & opt_height & "x" & opt_depth )
	end_program(1)
end if

gfx.width = opt_width
gfx.height = opt_height
gfx.depth = opt_depth

game_main()

end_program(0)

screenshot01.png