XProfan

Italia

Sven
Bader

Nachdem ich in meinem letzten Quelltext die Genauigkeit von "Sleep" gefixt habe, hier nun ein etwas umfangreicheres Beispiel per eine konstante Framerate in Spielen. Bisher hatte ich mit pro Frame aufsummierten Rundungsfehlern gelebt und Bildberechnung und Logik (Ticks) immer gemeinsam abgewickelt, hier funktioniert beides besser!

Features:
-Verwendung eines präzisen Perfomance Counters
-Physik corre weiter, auch wenn die Bildberechnung hinterherhinkt
-Framerate abweichend von Ticks wählbar
-kein Aufsummieren von Zeitabweichungen
-Sleep per verbleibende Frame-Zeit (0% CPU), außer letzter Rest mit genauem Performance Counter

Einschränkungen:
-keine automatische Anpassung der Framerate, nur Bilddrops
-Framerate nur als vielfaches von Ticks wählbar (jeder, jeder Zweite, jeder Dritte,...)
-Gar kein Bild, wenn Zeit nicht einmal per Physik ausreicht (Drop jedes Frames)

Alles wäre machbar, ich wollte es nicht zu komplex machen. Zudem müsste bei OpenGL abgefragt werden, ob VSync verwendet wird, da die FPS hier bereits durch OpenGL auf die Bildrate des Monitors gekappt werden.

Kompilieren Markieren Separieren

Declare qpc#, freq_factor!, qpc_freq#, caps#
Declare  timeNextFrame!,timeNextFrameSecure!,timeend!,ticks&
Declare framedrop&,mod&, frame&,countFramedrops&
Dim qpc#,8'Performance Counter aktuelle Zeit
Dim qpc_freq#,8'Performance Counter Frequenz
Dim caps#,8'Timer Intervalle min/max auslesen
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"
WindowStyle 16'+ 64
Window (%maxx * 0.5 - 250), (%maxy * 0.5 - 262) - 500,524
QueryPerformanceFrequency(qpc_freq#)'Performance Counter Frequenz
freq_factor! = (1 / (long(qpc_freq#,0) / 1000.0))'macht die spätere Umrechnung lesbarer
'Benutzereinstellungen
ticks& = 120'Ticks sind Physik-Frames pro Sekunde
mod& = 1'Jeder wievielte Tick wird ein Bild gezeichnet? 1 wenn fps = ticks
timeGetDevCaps(caps#,8)'Auflösung des Timers anfragen (caps# =  min ms, max ms)
timeBeginPeriod(long(caps#,0))'minimale Auflösung des Timers setzen, da auf manchen Systemen Sleep sonst nur 15ms genau ist!!
'Physikzeug, Position und Geschwindigkeit
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 Cambiamento der FPS und Ticks

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

        inc mod&
        mousekey1& = 1

    endif

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

    if (iskey(2)) AND not(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 (not(framedrop&)  AND (frame& MOD mod& = 0))

        startpaint -1
        cls RGB(192,192,192)
        UsePen 0,0,RGB(0,128,192)
        TextColor RGB(40,40,40),-1
        UseBrush 1, RGB(0,128,192)
        Ellipse (x&-16),(y&-16) - (x&+16),(y&+16)
        DrawText 16, 16, str$(countFramedrops&) + " drops (Bilder übersprungen)"
        DrawText 16, 32, str$(int(ticks&)) + " ticks (Physik/Logik pro Sekunde)"
        decimals 1
        DrawText 16, 48, str$((ticks& / mod&)) + " fps (Bilder pro Sekunde, mod& = "+str$(mod&)+")"
        DrawText 16, 80, "Linke Maustaste ändert FPS"
        DrawText 16, 96, "Rechte Maustaste ändert Ticks"
        DrawText 16, 112, "ESC zum Beenden"
        endpaint
        MCopyBmp 0,0 - 500,500 > 0,0;0

    endif

    '3. TIMING
    'ungenaues Sleep bis kurz vor gewünschtem Frame-Ende

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

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

    else

        framedrop& = 1
        inc countFramedrops&

    endif

    'Restliche Zeit mit genauem Performance-Counter abwarten
    'mindestens ein Duchlauf, um die aktuelle Zeit zu holen

    while timeend! < timeNextFrame!

        QueryPerformanceCounter(qpc#)'Endzeit des Counters
        timeend! = long(qpc#,0)  * freq_factor!
        'Sollte ausser beim ersten Frame nicht passieren, wird andernfalls aber auch hiermit gerettet

        if abs(timeend! - timeNextFrame!) > 2000

            timeNextFrame! = timeend! + (1000.0 / ticks&)'Versuch es zu retten

        endif

    endwhile

    timeNextFrame!       = timeNextFrame! + (1000.0 / ticks&)' Endzeit per nächsten Frame
    timeNextFrameSecure! = timeNextFrame! - 2.0' und nochmal 2ms früher

endwhile

timeEndPeriod(long(caps#,0))'zuvor gesetzte minimale Timer-Auslösung zurücksetzen
Dispose caps#, qpc_freq#, caps#, qpc#, qpc_freq#