seems to work correctly....
I can get a max of 3000 FPS with 10% CPU use
At 60 FPS I am at 2% CPU use
Ryzen 5 1600, 6 core, 16gb, 64bit OS (Win10 home)
Code: Select all
const TILEW = 5
const TILEH = 5
const SCRW = 1280
const SCRH = 600
dim shared as integer map(100,100,5)
dim shared as double starttime, endtime
dim shared as long rfps
' PQ_TE = Sorted Array/Stack for Timer Event Stack
dim shared as double PQ_TE(1000,1)
' TE_pntr = Timer Event stack pointer
dim shared as integer TE_pntr
declare sub Refreshscreen
declare sub DrawGrid
declare function PQ_TE_Add(ByVal newtime as double, byval event as double) as integer
declare function PQ_TE_Del(ByVal thisOne as integer) as integer
Declare Function timeBeginPeriod Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function timeEndPeriod Alias "timeEndPeriod" (As Ulong=1) As Long
screenres SCRW,SCRH,32,2 'set up 2 video pages (#0 visible, #1 working)
dim shared as integer FPS, LPS, desiredFPS, Loops, Frames, SleepTImes, NoSleepTimes
dim shared as double TimeStart, OldTime, RefreshTime, EstRefreshdelay, Lastframe, SleepDelay
' Initialize Main Loop
locate 50,20 : input "Desired FPS :";desiredFPS
RefreshTime = 1/desiredFPS
SleepTImes = 0
TE_pntr = 0 ' no events in stack
Loops = 0 : Frames = 0
ScreenSet 1, 0 ' working page #1, visible page #0
DrawGrid
PQ_TE_Add(timer+RefreshTime,100) ' add the next screen refresh to Timer Event Stack (100 = refresh screen event)
' Main Loop
do
Loops = Loops + 1
if timer > PQ_TE(TE_pntr,0) then 'check timer against the next event time
select case PQ_TE(TE_pntr,1) ' figure out what Event needs to be dealt with
case 100 ' this is the code for RefreshScreen Event
Refreshscreen
case 200 ' could be an action or world update or even animation frame change...
end select
end if
' if there is enough time for a minimal sleep (1.5ms) then sleep
if PQ_TE(TE_pntr,0) > (timer + .0015) then
timebeginperiod
sleep 1
timeendperiod
SleepTImes += 1
else
NoSleepTimes +=1
end if
loop until inkey = "q"
end
' some subroutines....
sub Refreshscreen
dim as double t1
t1 = timer
'PQ_TE_Del(TE_pntr) ' remove the Event
TE_pntr -= 1 ' Quick n Dirty remove this event
PQ_TE_Add(t1+RefreshTime,100) ' add a new Scren Refresh Event to Timer Event Stack
' FPS stuff
FPS = 1/(t1 - OldTime) ' time between frames
OldTime = t1 'reset OldTime
locate 3,70 : print "Main Loops per Frame =";Loops;" "
locate 5,70 : print "Display FPS =";FPS;" "
locate 7,70 : print "Timer =";t1;" "
locate 9,70 : print "Refresh Time = ";RefreshTime
locate 11,70 : print "# of times Slept =";SleepTImes
locate 13,70 : print "# of loops with No Sleep =";NoSleepTimes
locate 15,70 : print "SleepDelay =";SleepDelay
ScreenCopy
Loops = 0 'reset Loop counter
end sub
sub DrawGrid
dim as integer x1, y1
dim as ulong c1
cls
' draw grid
for i as integer = 1 to 100
x1 = i*TILEW
for j as integer = 1 to 100
y1 = j*TILEH
c1 = rgb(200,200,200)
select case map(i,j,0)
case 1
c1 = rgb(0,255,0)
case 2
c1 = rgb(255,0,0)
case 3
c1 = rgb(0,0,255)
case 4
c1 = rgb(255,255,0)
end select
line(x1,y1)- step(TILEW-2,TILEH-2),c1,BF
next j
next i
end sub
'
' this is a Sorted Array which maintains an array in sorted order
'
'
function PQ_TE_Add(ByVal newtime as double, byval event as double) as integer
' Adds an event to the Timer Event Stack Sorted Array
' this function uses and alters the shared variables: PQ_TE() & TE_pntr
' ... add it to the end then bubble sort it down...
dim as integer bub, addHere
TE_pntr = TE_pntr + 1
addHere = TE_pntr
PQ_TE(TE_pntr,0) = newtime
PQ_TE(TE_pntr,1) = event
if TE_pntr > 1 then
bub = TE_pntr
do
if PQ_TE(bub,0) > PQ_TE(bub-1,0) then
swap PQ_TE(bub,0) , PQ_TE(bub-1,0)
swap PQ_TE(bub,1) , PQ_TE(bub-1,1)
addHere = bub - 1
else
bub = 2 ' early exit
end if
bub = bub - 1
loop until bub < 2
end if
return addHere
end function
function PQ_TE_Del(ByVal thisOne as integer) as integer
' Deletes an event from the Timer Event Stack Sorted Array
select case thisOne
case is < TE_pntr
for i as integer = thisOne to (TE_pntr-1)
PQ_TE(i,0) = PQ_TE(i+1,0)
PQ_TE(i,1) = PQ_TE(i+1,1)
next i
TE_pntr = TE_pntr - 1
case is = TE_pntr
TE_pntr = TE_pntr - 1
end select
return thisOne
end function