I've fleshed out these routines a bit more. Now there's class support, which makes using clock objects much easier. Also, the clocks can now have a parent clock, so if the parent stops updating, so does the child. This is useful if you have various clocks that need to hooked into a master clock. For example, you pause your game, instead of manually stopping each clock, you just stop the master clock and all clocks hooked into it would also stop.
Finally, the syntax has been improved such that you no long have to manually update the clocks each cycle. Instead, you simply call a sync routine each cycle (io_sync). From here, a clock will only update if you request its time. If the clock has a parent clock, it will force the parent to update as well, unless the parent has already updated during the current cycle.
The following example is similar to the previous one, though it demonstrates the parent clock functionality. Each clock is linked to the clock before it. The first clock, therefore, has no parent and is naturally linked to the TIMER. Notice that the child clocks will stop when their parents do. The major differences, to me however, are in the code implementation. The class support simply makes reading, writing and using the code easier.
Code: Select all
' Program: Game Clock Source Code
' Version: 0.08
' Language: FreeBASIC v0.18.3b
' Author: Quinton Roberts (Eclipzer)
' Date: 11-13-06
' Update: 04-20-08
'
' Copyright (c) 2006-2008.
' define arrow keys
#define ASC_UP Chr$(255)+Chr$(72)
#define ASC_DOWN Chr$(255)+Chr$(80)
#define ASC_LEFT Chr$(255)+Chr$(75)
#define ASC_RIGHT Chr$(255)+Chr$(77)
const VERSION="0.08"
' video page constants
Const FX_VIS_PAGE=0
Const FX_WRK_PAGE=1
Const FX_CLR_PAGE=2
' screen mode constants
Const FX_320x240=14
Const FX_640x480=18
Const FX_800x600=19
Const FX_FULLSCREEN=1
' general constants
const IO_NULL=0
' clock constants
const IO_TIMER=0 'define parent clock as FBs TIMER
const IO_TIME=1 'modify clock time
const IO_RESET=2 'reset clock time
const IO_START=3 'modify start time
const IO_ALARM=4 'modify alarm time
const IO_PARENT=5 'modify clock parent
const IO_FORWARD=1 'set clock to count forward
const IO_BACKWARD=0 'set clock to count backward
' clock flags
const fUPDATE=1 '0=off 1=update
const fCOUNT=2 'clock count direction (0=backward 1=forward)
const fPCOUNT=3 'parent clock count direction (0=backward 1=forward)
const fALARM=4 '0=off 1=triggered
const fTIMEOUT=5 '0=off 1=on - set once alaram is triggered
type clockClass
as ulongint sync 'sync value - keeps data samples uniform for each program cycle
as clockClass ptr parent 'clock parent
as integer flags 'clock flags (update,count,alarm,timeout)
as double real 'parent clock sample
as double epoch 'initial time sample (base time)
as double lapse 'sampled difference between real and epoch values
as double start 'clock start time value (user defined)
as double alarm 'clock alarm time value (user defined)
as double value 'dynamic time value
as double curr 'current time
declare sub count(direction as integer=IO_FORWARD)
declare sub inc(hh as double=0,mm as double=0,ss as double=0,clockAttr as integer=IO_TIME)
declare sub pause()
declare sub set overload(hh as double=0,mm as double=0,ss as double=0,newParent as clockClass ptr=IO_TIMER,clockAttr as integer=IO_NULL)
declare sub set (hh as double=0,mm as double=0,ss as double=0,clockAttr as integer)
declare sub set (newParent as clockClass ptr)
declare sub stop()
declare function time() as double
declare sub update()
end type
' Bit-wise function declarations
declare function io_bit ( myVar as ulongint,bitPosition as ubyte) as ubyte
declare sub io_bit_clr overload(byref myVar as ubyte, bitPosition as ubyte)
declare sub io_bit_clr (byref myVar as ushort, bitPosition as ubyte)
declare sub io_bit_clr (byref myVar as uinteger,bitPosition as ubyte)
declare sub io_bit_clr (byref myVar as ulongint,bitPosition as ubyte)
declare sub io_bit_flp overload(byref myVar as ubyte, bitPosition as ubyte)
declare sub io_bit_flp (byref myVar as ushort, bitPosition as ubyte)
declare sub io_bit_flp (byref myVar as uinteger,bitPosition as ubyte)
declare sub io_bit_flp (byref myVar as ulongint,bitPosition as ubyte)
declare function io_bit_get overload( myVar as ubyte, bitPosition as ubyte,bits as ubyte) as ubyte
declare function io_bit_get ( myVar as ushort, bitPosition as ubyte,bits as ubyte) as ushort
declare function io_bit_get ( myVar as uinteger,bitPosition as ubyte,bits as ubyte) as uinteger
declare function io_bit_get ( myVar as ulongint,bitPosition as ubyte,bits as ubyte) as ulongint
declare sub io_bit_put overload(byref myVar as ubyte, bitPosition as ubyte,bits as ubyte,value as ubyte)
declare sub io_bit_put (byref myVar as ushort, bitPosition as ubyte,bits as ubyte,value as ushort)
declare sub io_bit_put (byref myVar as uinteger,bitPosition as ubyte,bits as ubyte,value as uinteger)
declare sub io_bit_put (byref myVar as ulongint,bitPosition as ubyte,bits as ubyte,value as ulongint)
declare sub io_bit_set overload(byref myVar as ubyte, bitPosition as ubyte)
declare sub io_bit_set (byref myVar as ushort, bitPosition as ubyte)
declare sub io_bit_set (byref myVar as uinteger,bitPosition as ubyte)
declare sub io_bit_set (byref myVar as ulongint,bitPosition as ubyte)
' Clock routine declarations
declare sub io_sync()
declare function io_time_hms(tt as double) as string
declare function clock_state(t as clockClass) as string
dim shared as ulongint ioCycleCount
const CLOCKS=4
dim shared as clockClass clock(CLOCKS-1)
dim as string kb,state,div1,div2,div3
dim as integer i,done,xx,yy,idx=0
windowtitle "Game Clock Class v" & VERSION
screen FX_640x480,32,3,0
screenset FX_WRK_PAGE,FX_VIS_PAGE
for i=0 to CLOCKS-1
if i then clock(i).set @clock(i-1) 'make parent clock the prev clock
clock(i).count
next
clock(0).set 0,0, 7.25,IO_ALARM 'set alarm value
clock(1).set 0,0,10.07,IO_ALARM 'set alarm value
clock(2).set 0,0, 3, IO_ALARM 'set alarm value
clock(3).set 0,0,30,IO_TIME
clock(3).set 0,0, 0,IO_ALARM
clock(3).count IO_BACKWARD
div1=" -----------------------------[ ||| eclipzer ||| ]-----------------------------"
div2=" +-----------------------------------------------------------------+"
div3=" | |"
do
io_sync
kb=inkey$
select case kb
case chr$(27): done=1
case "+": clock(idx).inc 0,0,15
case "-": clock(idx).inc 0,0,-15
case " ": clock(idx).pause
case "x","X": clock(idx).stop
case chr$(13): clock(idx).set 0,0,clock(idx).start
case ASC_LEFT: clock(idx).count IO_BACKWARD
case ASC_RIGHT: clock(idx).count IO_FORWARD
case ASC_UP: idx=(idx-1) And (CLOCKS-1)
case ASC_DOWN: idx=(idx+1) And (CLOCKS-1)
case else
end select
ScreenCopy FX_CLR_PAGE,FX_WRK_PAGE
Locate 1,1
?
? " Game Clock Routines"
? div1
?
? div2 ' +----+
For i=0 To CLOCKS
? div3 ' | |
Next
? div2 ' +----+
?
? " Key Controls"
? " UP ....... Cycle active clock (backward)"
? " DOWN ..... Cycle active clock (forward)"
? " LEFT ..... Set active clock to count backward"
? " RIGHT .... Set active clock to count forward"
? " SPACE .... Toggle active clock on/off (pause)"
? " ENTER .... Reset active clock"
? " X ........ Stop active clock"
? " + ........ Add 15 seconds to active clock"
? " - ........ Subtract 15 seconds from active clock"
? " ESC ...... Exit"
?
xx=4
yy=6
locate yy,xx: ? "Clock Time Start Alarm State"
for i=0 To CLOCKS-1
locate ,xx: ? " "& i &" "+io_time_hms(clock(i).time)+" "+io_time_hms(clock(i).start)+" "+io_time_hms(clock(i).alarm)+" "+clock_state(clock(i))
if io_bit(clock(i).flags,fALARM) Then clock(i).stop
next
locate yy+idx+1,xx: ? ">" 'active clock cursor
locate 27,1
? div1
?
? " Copyright (c) Quinton Roberts 2006-2008."
screencopy
loop until done
function clock_state(t as clockClass) as string
select case io_bit(t.flags,fUPDATE)'t.update
case 0: return "Paused"
case 1
select case io_bit(t.flags,fCOUNT)
case IO_FORWARD: return "Count Forward"
case IO_BACKWARD: return "Count Backward"
case else: return "Paused"
end select
end select
end function
' =============================================================================
' Name: .count (04.20.08)
' Returns:
' Parameters:
' [direction]: counting direction [IO_FORWARD] (IO_BACKWARD,IO_FORWARD)
' -----------------------------------------------------------------------------
' Description: Init clock object for updating.
' Comments: Call this routine to start a clock object.
' =============================================================================
sub clockClass.count(direction as integer)
if parent then epoch=parent->curr else epoch=timer 'set clock base time
value=curr 'save current time
real=epoch 'set clock real time
lapse=0 'reset time lapse
io_bit_set(flags,fUPDATE) 'set clock update flag
io_bit_put(flags,fCOUNT,1,direction) 'set clock count direction
end sub
' =============================================================================
' Name: .inc (04.20.08)
' Returns:
' Parameters:
' [hh]: init hours [0]
' [mm]: init minutes [0]
' [ss]: init seconds [0]
' [clockAttr]: clock attribute to increase [IO_TIME] (IO_TIME,IO_START,IO_ALARM)
' -----------------------------------------------------------------------------
' Description: Add set amount of time to specified clock attribute.
' Comments:
' =============================================================================
sub clockClass.inc(hh as double,mm as double,ss as double,clockAttr as integer)
dim as double timeDelta
timeDelta=hh*3600+mm*60+ss 'calculate time delta in seconds
select case clockAttr
case IO_TIME: value+=timeDelta
case IO_START: start+=timeDelta
case IO_ALARM: alarm+=timeDelta
case else
end select
end sub
' =============================================================================
' Name: .pause (04.20.08)
' Returns:
' Parameters:
' -----------------------------------------------------------------------------
' Description: Toggle clock structure for updating.
' Comments:
' =============================================================================
sub clockClass.pause()
io_bit_flp(flags,fUPDATE)
select case io_bit(flags,fUPDATE)
case 0: stop
case 1: count(io_bit(flags,fCOUNT))
end select
end sub
' =============================================================================
' Name: .set (04.20.08)
' Returns:
' Parameters:
' [hh]: init hours [0]
' [mm]: init minutes [0]
' [ss]: init seconds [0]
' [newParent]: pointer to parent clock structure [0] (IO_TIMER=timer)
' [clockAttr]: clock attribute to set [0] (IO_TIME,IO_START,IO_ALARM,IO_RESET,IO_PARENT)
' -----------------------------------------------------------------------------
' Description: Set the attributes of a clock structure.
' Comments: This routines allows you to define the time, start time and
' parent clock of a time structure. Use the clockAttr parameter
' to ONLY modify a specific clock attribute.
'
' clockAttr can take on the following values:
' IO_TIME .... only modify clock time
' IO_START ... only modify clock start time
' IO_ALARM ... only modify clock alarm time
' IO_RESET ... only modify clock time - reset it to clock start time
' IO_PARENT .. only modify clock parent
' =============================================================================
sub clockClass.set(hh as double,mm as double,ss as double,newParent as clockClass ptr,clockAttr as integer)
dim as double newTime,newEpoch
if newParent then parent=newParent 'assign parent clock if specified
if parent then 'if parent clock present...
newEpoch=parent->curr 'get new base time from parent clock
else 'else...
newEpoch=timer 'get new base time from timer
end if
newTime=hh*3600+mm*60+ss 'calculate time in seconds
select case clockAttr
case IO_START: start=newTime
case IO_ALARM: alarm=newTime: io_bit_clr(flags,fTIMEOUT)
case IO_TIME: value=newTime: curr=value: epoch=newEpoch: real=newEpoch
case IO_RESET: value=start: curr=value: epoch=newEpoch: real=newEpoch: io_bit_clr(flags,fTIMEOUT)
case IO_PARENT: epoch=newEpoch: real=newEpoch
case else: value=newTime: curr=value: epoch=newEpoch: real=newEpoch: start=newTime
end select
end sub
sub clockClass.set(hh as double,mm as double,ss as double,clockAttr as integer)
set hh,mm,ss,,clockAttr
end sub
sub clockClass.set(newParent as clockClass ptr)
set ,,,newParent,IO_PARENT
end sub
' =============================================================================
' Name: .stop (04.20.08)
' Returns:
' Parameters:
' -----------------------------------------------------------------------------
' Description: Prevent clock structure from updating.
' Comments:
' =============================================================================
sub clockClass.stop()
value=curr 'save current time
lapse=0 'reset time lapse
io_bit_clr(flags,fUPDATE) 'clear update flag
end sub
' =============================================================================
' Name: .time (04.20.08)
' Returns:
' Parameters:
' -----------------------------------------------------------------------------
' Description: Returns time in seconds of specified clock structure.
' Comments: This routine forces the clock structure to update before
' returning its time value. This removes the need to manually
' update a clock every program cycle.
' =============================================================================
function clockClass.time() as double
update
return curr
end function
' =============================================================================
' Name: .update (04.20.08)
' Returns:
' Parameters:
' -----------------------------------------------------------------------------
' Description: Update specified clock structure.
' Comments: Use the io_sync routine to allow dynamic clock updates.
' =============================================================================
sub clockClass.update()
dim as integer sign,pcount,timeout=0
if sync<>ioCycleCount then
sync=ioCycleCount
if parent then
*parent.update
real=parent->curr
else
real=timer
end if
end if
if io_bit(flags,fUPDATE) then
' account for clock count direction
select case io_bit(flags,fCOUNT)
case IO_FORWARD: sign=1
case IO_BACKWARD: sign=-1
end select
' account for parent clock count direction
if parent then
pcount=io_bit(parent->flags,fCOUNT)
if pcount=IO_BACKWARD then sign=-sign
if io_bit(flags,fPCOUNT)<>pcount then 'if parent clock count direction has changed...
io_bit_put(flags,fPCOUNT,1,pcount) 'set parent clock count direction in child flags
value=curr 'save current time
lapse=0 'reset time lapse
epoch=parent->curr 'reset clock base time
real=epoch 'reset "real" time
end if
end if
lapse=sign*(real-epoch) 'update time lapse
end if
curr=value+lapse 'update current time
io_bit_clr(flags,fALARM) 'clear alarm flag
if io_bit(flags,fTIMEOUT)=0 then
select case start
case is>alarm: if curr<=alarm then timeout=1
case is<alarm: if curr>=alarm then timeout=1
case else
end select
end if
if timeout then
io_bit_set(flags,fALARM) 'set alarm flag
io_bit_set(flags,fTIMEOUT) 'set timeout flag
end if
end sub
' =============================================================================
' Name: io_bit (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' -----------------------------------------------------------------------------
' Description: Returns the bit value at bit position (0=clear 1=set).
' Comments: The 1st bit position is 0.
' =============================================================================
function io_bit (myVar as ulongint,bitPosition as ubyte) as ubyte
return (myVar shr bitPosition) and 1
end function
' =============================================================================
' Name: io_bit_clr (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' -----------------------------------------------------------------------------
' Description: Clear selected bit (value=0).
' Comments:
' =============================================================================
sub io_bit_clr(byref myVar as ubyte,bitPosition as ubyte)
myVar=(myVar and (not (1 shl bitPosition))) 'clear selected bit (set to 0)
end sub
sub io_bit_clr(byref myVar as ushort,bitPosition as ubyte)
myVar=(myVar and (not (1 shl bitPosition))) 'clear selected bit (set to 0)
end sub
sub io_bit_clr(byref myVar as uinteger,bitPosition as ubyte)
myVar=(myVar and (not (1 shl bitPosition))) 'clear selected bit (set to 0)
end sub
sub io_bit_clr(byref myVar as ulongint,bitPosition as ubyte)
myVar=(myVar and (not (1 shl bitPosition))) 'clear selected bit (set to 0)
end sub
' =============================================================================
' Name: io_bit_flp (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' -----------------------------------------------------------------------------
' Description: Toggle selected bit.
' Comments: Toggles a bit between clear and set values. A clear bit
' becomes set (1), while a set bit becomes clear (0).
' =============================================================================
sub io_bit_flp(byref myVar as ubyte,bitPosition as ubyte)
myVar=(myVar xor (1 shl bitPosition)) 'toggle selected bit
end sub
sub io_bit_flp(byref myVar as ushort,bitPosition as ubyte)
myVar=(myVar xor (1 shl bitPosition)) 'toggle selected bit
end sub
sub io_bit_flp(byref myVar as uinteger,bitPosition as ubyte)
myVar=(myVar xor (1 shl bitPosition)) 'toggle selected bit
end sub
sub io_bit_flp(byref myVar as ulongint,bitPosition as ubyte)
myVar=(myVar xor (1 shl bitPosition)) 'toggle selected bit
end sub
' =============================================================================
' Name: io_bit_get (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' bits: number of bits to return (sequence length)
' -----------------------------------------------------------------------------
' Description: Return a sequence of bits from a variable.
' Comments: Useful for extracting packed bit information.
' =============================================================================
function io_bit_get(myVar as ubyte,bitPosition as ubyte,bits as ubyte) as ubyte
return (myVar shr bitPosition) and ((2^bits)-1) 'retrieve bits at selected bit
end function
function io_bit_get(myVar as ushort,bitPosition as ubyte,bits as ubyte) as ushort
return (myVar shr bitPosition) and ((2^bits)-1) 'retrieve bits at selected bit
end function
function io_bit_get(myVar as uinteger,bitPosition as ubyte,bits as ubyte) as uinteger
return (myVar shr bitPosition) and ((2^bits)-1) 'retrieve bits at selected bit
end function
function io_bit_get(myVar as ulongint,bitPosition as ubyte,bits as ubyte) as ulongint
return (myVar shr bitPosition) and ((2^bits)-1) 'retrieve bits at selected bit
end function
' =============================================================================
' Name: io_bit_put (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' bits: number of bits to replace
' value: replacement value
' -----------------------------------------------------------------------------
' Description: Replace a sequence of bits in a variable.
' Comments: Useful for inserting packed bit information.
' =============================================================================
sub io_bit_put(byref myVar as ubyte,bitPosition as ubyte,bits as ubyte,value as ubyte)
myVar=(myVar and (not((2^bits)-1) shl bitPosition)) 'clear selected bits
myVar=(myVar or (value shl bitPosition)) 'store value at selected bit
end sub
sub io_bit_put(byref myVar as ushort,bitPosition as ubyte,bits as ubyte,value as ushort)
myVar=(myVar and (not((2^bits)-1) shl bitPosition)) 'clear selected bits
myVar=(myVar or (value shl bitPosition)) 'store value at selected bit
end sub
sub io_bit_put(byref myVar as uinteger,bitPosition as ubyte,bits as ubyte,value as uinteger)
myVar=(myVar and (not((2^bits)-1) shl bitPosition)) 'clear selected bits
myVar=(myVar or (value shl bitPosition)) 'store value at selected bit
end sub
sub io_bit_put(byref myVar as ulongint,bitPosition as ubyte,bits as ubyte,value as ulongint)
myVar=(myVar and (not((2^bits)-1) shl bitPosition)) 'clear selected bits
myVar=(myVar or (value shl bitPosition)) 'store value at selected bit
end sub
' =============================================================================
' Name: io_bit_set (04.09.08)
' Returns:
' Parameters:
' myVar: variable containing bit data
' bitPosition: bit position
' -----------------------------------------------------------------------------
' Description: Set selected bit (value=1).
' Comments:
' =============================================================================
sub io_bit_set(byref myVar as ubyte,bitPosition as ubyte)
myVar=(myVar or (1 SHL bitPosition)) 'set selected bit (set to 1)
end sub
sub io_bit_set(byref myVar as ushort,bitPosition as ubyte)
myVar=(myVar or (1 SHL bitPosition)) 'set selected bit (set to 1)
end sub
sub io_bit_set(byref myVar as uinteger,bitPosition as ubyte)
myVar=(myVar or (1 SHL bitPosition)) 'set selected bit (set to 1)
end sub
sub io_bit_set(byref myVar as ulongint,bitPosition as ubyte)
myVar=(myVar or (1 SHL bitPosition)) 'set selected bit (set to 1)
end sub
' =============================================================================
' Name: io_sync (04.20.08)
' Returns:
' Parameters:
' -----------------------------------------------------------------------------
' Description: Update global cycle count.
' Comments: This routine must be called once every program cycle. A
' constant cycle count prevents I/O objects from repeatedly
' updating during the same program cycle, thus keeping their data
' values uniform throughout the cycle.
' =============================================================================
sub io_sync()
ioCycleCount=(ioCycleCount+1) and &HFFFFFFFF 'increment cycle count - loop after 2^32 cycles
end sub
' =============================================================================
' Name: io_time_hms (03.23.08)
' Returns: time string
' Parameters:
' tt: time, in seconds, to convert
' -----------------------------------------------------------------------------
' Description: Converts seconds to a string in HH:MM:SS.SSS format.
' Comments:
' =============================================================================
function io_time_hms(tt as double) as string
dim as integer hh=fix(tt/3600): tt-=3600*hh
dim as integer mm=fix(tt/60): tt-=60*mm
dim as integer ss=fix(tt)
dim as integer ms=int(abs(frac(tt)*1000))
dim as string hhn=str$(hh): if len(hhn)<2 then hhn="0"+hhn
dim as string mmn=str$(mm): if len(mmn)<2 then mmn="0"+mmn
dim as string ssn=str$(ss): if len(ssn)<2 then ssn="0"+ssn
dim as string msn=str$(ms): if len(msn)<2 then msn="0"+msn
if len(msn)<3 then msn="0"+msn
return hhn+":"+mmn+":"+ssn+"."+msn
end function
