Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
FreeBASIC fbgfx game loop demo test for different timing methods
'' --------------------------------------------------------
'' FBGFX game loop testing
''
'' from command prompt:
'' $ ./canon --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
ScreenControl( fb.GET_SCREEN_SIZE, w, h )
ScreenControl( fb.GET_SCREEN_DEPTH, d )
hColor( 7, 0 )
hPrintAt( x, y, "FPS: " & int(gtimer.fps*1000)/1000 & " W=" & w & " H=" & h & " D=" & d )
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( "vectutor [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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.