XProfan

English

Sven
Bader

after I in my last View source The accuracy of "Sleep" gefixt have, here now one something umfangreicheres Example for a konstante Framerate in play. yet I had with per Frame aufsummierten Rundungsfehlern lived and Bildberechnung and Logik (Ticks) always together abgewickelt, here functions both rather!

Features:
-usage one präzisen Perfomance Counters
-Physics runs moreover, even if The Bildberechnung hinterherhinkt
-Framerate abweichend of Ticks wählbar
-no Aufsummieren of Zeitabweichungen
-Sleep for verbleibende Frame-Time (0% CPU), except last remainder with genauem performance Counter

Einschränkungen:
-no automatic Anpassung the Framerate, only Bilddrops
-Framerate only as multiple of Ticks wählbar (eachone, eachone second, eachone Dritte,...)
-quite no Image, if Time not even for Physics ausreicht (Drop each Frames)

everything would machbar, I wished not To komplex make. additionally should with OpenGL quizzed go, whether VSync is used, since the FPS here already through OpenGL on The Bildrate the Monitors gekappt go.

Compile Mark Separation

Declare qpc#, freq_factor!, qpc_freq#, caps#
Declare  timeNextFrame!,timeNextFrameSecure!,timeend!,ticks&
Declare framedrop&,mod&, frame&,countFramedrops&
Dim qpc#,8'performance Counter actually Time
Dim qpc_freq#,8'performance Counter frequency
Dim caps#,8'Timer Intervalle mins/max read
Def timeGetDevCaps(2) !"winmm","timeGetDevCaps"
Def timeBeginPeriod(1) !"winmm","timeBeginPeriod"
Def timeEndPeriod(1) !"winmm","timeEndPeriod"
Def QueryPerformanceFrequency(1) !"Kernel32","QueryPerformanceFrequency"
Def QueryPerformanceCounter(1) !"Kernel32","QueryPerformanceCounter"
Window Style 16'+ 64
Window (%maxx * 0.5 - 250), (%maxy * 0.5 - 262) - 500,524
QueryPerformanceFrequency(qpc_freq#)'performance Counter frequency
freq_factor! = (1 / (long(qpc_freq#,0) / 1000.0))'power The later Umrechnung lesbarer
'Benutzereinstellungen
ticks& = 120'Ticks are Physics-Frames per second
mod& = 1'eachone wievielte Tick becomes one Image drawn? 1 if fps = ticks
timeGetDevCaps(caps#,8)'dissolution the Timers inquire (caps# =  mins ms, max ms)
timeBeginPeriod(long(caps#,0))'minimale dissolution the Timers settle, there on manchen Systemen Sleep otherwise only 15ms exactly!!
'Physikzeug, position and speed
declare x&,y&,speedx&,speedy&
speedx& = 1
speedy& = 1
x& = 77
y& = 299
declare mousekey1&,mousekey2&
timeNextFrameSecure! = 1
mcls 500,500

whilenot iskey(27)'ESC

    inc frame&
    'Manuelle Änderung the FPS and Ticks

    if (iskey(1)) AND hardship(mousekey1&)

        inc mod&
        mousekey1& = 1

    endif

    casenot (iskey(1)) : mousekey1& = 0
    case mod& > 8 : mod& = 1

    if (iskey(2)) AND hardship(mousekey2&)

        ticks& = ticks& + 30.0
        mousekey2& = 1

    endif

    casenot (iskey(2)) : mousekey2& = 0
    case ticks& > 240 : ticks& = 30.0
    '1. PHYSIK
    case (x& <= 16)  OR (x& >= 484)  : speedx& = speedx& * (-1)
    case (y& <= 16)  OR (y& >= 484)  : speedy& = speedy& * (-1)
    x& = x&+speedx&
    y& = y&+speedy&
    '2. GRAFIK

    if (frame& = 1) OR (hardship(framedrop&)  AND (frame& MOD mod& = 0))

        startpaint -1
        cls RGB(192,192,192)
        USEP 0,0,RGB(0,128,192)
        Text Color RGB(40,40,40),-1
        UseBrush 1, RGB(0,128,192)
        ellipsis (x&-16),(y&-16) - (x&+16),(y&+16)
        DrawText 16, 16, st$(countFramedrops&) + " drops (Images übersprungen)"
        DrawText 16, 32, st$(int(ticks&)) + " ticks (Physics/Logik per second)"
        decimals 1
        DrawText 16, 48, st$((ticks& / mod&)) + " fps (Images per second, mod& = "+st$(mod&)+")"
        DrawText 16, 80, "Linke Mouse button changes FPS"
        DrawText 16, 96, "Rechte Mouse button changes Ticks"
        DrawText 16, 112, "ESC to that Beenden"
        endpaint
        MCopyBmp 0,0 - 500,500 > 0,0;0

    endif

    '3. TIMING
    'ungenaues Sleep To short to gewünschtem Frame-end

    if int(timeend!) < int(timeNextFrameSecure!)

        sleep int(timeNextFrameSecure!) - int(timeend!)
        framedrop& = 0

    else

        framedrop& = 1
        inc countFramedrops&

    endif

    'Restliche Time with genauem performance-Counter to wait it out
    'at least one Duchlauf, around the actually Time To fetch

    while timeend! < timeNextFrame!

        QueryPerformanceCounter(qpc#)'Endzeit the Counters
        timeend! = long(qpc#,0)  * freq_factor!
        'ought to except at first Frame not occur, becomes otherwise but too herewith rescued

        if abs(timeend! - timeNextFrame!) > 2000

            timeNextFrame! = timeend! + (1000.0 / ticks&)'try it To saving

        endif

    endwhile

    timeNextFrame!       = timeNextFrame! + (1000.0 / ticks&)' Endzeit for next Frame
    timeNextFrameSecure! = timeNextFrame! - 2.0' and again 2ms former

endwhile

timeEndPeriod(long(caps#,0))'before gesetzte minimale Timer-release zurücksetzen
Dispose caps#, qpc_freq#, caps#, qpc#, qpc_freq#