mieki256's diary

時間の取得には、Timer という関数が使える。

_Timer

特定の時間からの経過時間を秒(sec)で返す。小数点以下の値も返してくるので、ミリ秒(msec)やマイクロ秒も測定できる。もっとも、精度についてはどこまで正確なのか分からんけど…。

Windowsの場合はPCが起動してからの経過時間を返してくるようだけど、プラットフォームによっては真夜中からの時間を返してくるものもある、と書いてある…。前フレームの測定時間が、現在フレームの測定時間より過去にあるとは限らない、という前提で処理を書いておかないといかんのだろうな…。


時間待ちについては、Sleep という関数が使える。

_Sleep

ミリ秒(msec)単位で待ち時間を指定する模様。

ちなみに、値を指定しないで呼ぶと、キー入力があるまで待つ、という処理になるらしい。

そんなわけで、Timer と Sleep を使って、メインループっぽいものを書いてみた。1秒間ループさせてみて、何回処理が通ったかをカウントする。また、ループ1回あたりに何秒かかっているかを出力する。

_timer.bas

Dim As Double start_time, prev_time, now_time, diff_time
Dim As Integer frame_count

frame_count = 0
start_time = Timer
prev_time = start_time

' 1秒間ループする
Do
    now_time = Timer
    diff_time = now_time - prev_time
    prev_time = now_time
    Print "Diff: "; diff_time
    
    sleep 10.0
    frame_count += 1
Loop until (now_time - start_time) > 1.0

Print "frame_count=" & frame_count

Print "Push Any Key"

sleep

fbc timer.bas と打てば、timer.exe ができる。実行してみる。

> timer.exe
Diff:  1.00000761449337e-007
Diff:  0.01270929999918735
...
Diff:  0.01561659999970289
Diff:  0.01563919999898644
frame_count=62
Push Any Key

一見それらしく動いてるようだけど、実はおかしい。ループの最後で Sleep を使って、問答無用で 10.0ミリ秒時間待ちせよ、と書いているのだから、1秒間処理させたらフレームカウントは100前後になるはずでは…？

このあたり、各OSのタイマー精度が関係してる。Windows10 の場合、15msec程度の精度しかないらしい。 *1 だから、Slepp 10.0 を指定しても、15msec ぐらい Sleep していて、こういう結果になる模様。これがLinuxなら1msecの精度があるらしいのだけど…。

_Timer (Win32 and Win64) - freebasic.net
_Speed - freebasic.net
_Constant Framerate - freebasic.net

※ 2024/01/24追記。Ubuntu Linux 20.04 LTS上で上記のサンプルを動かしてみたところ、フレームカウントが 96 になった。100前後の値が出ているので、Sleep はちゃんとミリ秒単位で動いてくれている模様。

前述の問題の解決策として、一時的にタイマー精度を1msecに細かくしてしまうことができるらしい。マルチメディア関係の機能を使うのだとか。この時点で Windows に特化したプログラムになってしまうけど、背に腹は代えられない…。

• timeBeginPeriod(1) ... タイマー精度を1msecに向上させる
• timeEndPeriod(1) ... タイマー精度を本来のスペックに戻す。

FreeBASIC で上記の機能を使うためには、以下のヘッダーファイルを include しておく必要がある。

#include "windows.bi"
#include "win/mmsystem.bi"

また、必要な処理が終わったら、元の精度に戻しておかないといけない。この点はちょっと忘れがちなので注意。

そんなわけで、手直ししたのが以下。

_timer2.bas

' mmsystem(マルチメディア関連ライブラリ)を利用して、
' Windows上のタイマー精度を一時的に 1msec に向上させる。
' 処理が終わったら本来のタイマー精度に戻すこと。

' mmsystemを利用
#include "windows.bi"
#include "win/mmsystem.bi"

Dim As Double start_time, prev_time, now_time, diff_time, one_frame
Dim frame_count As Integer 

' タイマー精度を1msecに向上
timeBeginPeriod(1)

' 1フレームあたりの本来の時間
one_frame = 1.0 / 60.0

frame_count = 0
start_time = Timer
prev_time = start_time

' 1秒間ループさせる
Do
    now_time = Timer
    diff_time = now_time - prev_time
    prev_time = now_time
    Print "Diff: "; diff_time

    If Timer < (now_time + one_frame) Then
        ' 本来のフレーム時間がまだ経過してないので sleep させる
        sleep ((now_time + one_frame) - Timer) * 1000.0
    End If
    frame_count += 1
Loop until (now_time - start_time) >= 1.0

' タイマー精度を本来のスペックに戻す
timeEndPeriod(1)

Print "frame_count=" & frame_count

Print "Push Any Key"

sleep

fbc timer2.bas と打てば、timer2.exe が生成される。実行してみる。

> timer2.exe
Diff:  1.00000761449337e-007
Diff:  0.01655399999981455
Diff:  0.01653780000015104
...
Diff:  0.01651980000133335
Diff:  0.01651969999875291
Diff:  0.01650789999985136
Diff:  0.01652210000065679
frame_count=62
Push Any Key

16msec前後でループが回っているように見える。これでどうにかなりそう。

画像を何かしら描画して、ゲームのメインループっぽい感じに見える処理を書いてみる。

png画像の読み込みには FBImage というライブラリを使った。導入の仕方は、昨日の日記にメモしてある。

_FreeBASICで画像描画 - mieki256's diary

さておき、サンプルソースは以下。

_mainloop.bas

' mmsystemを利用
#include "windows.bi"
#include "win/mmsystem.bi"

' fbgfxモードを使う
#Include "fbgfx.bi"
Using fb

' 画像読み込み用ライブラリ FBImage を使う
#include once "FBImage.bi"

' 円周率を定義
Const PI As Double = 3.1415926535897932

Dim As Double start_time, prev_time, now_time, diff_time, one_frame
Dim As Integer frame_count
Dim As String fps_text = "FPS"
Dim As Integer scrw, scrh, imgw, imgh

' カレントディレクトリを exeファイルのある場所にする
chdir exepath()

' ウインドウサイズと色深度を指定
scrw = 1280
scrh = 720
Screenres scrw, scrh, 32

' 画像読み込み
var img = LoadRGBAFile("image_circle_96x96.png")

' 画像の幅と高さを取得
imageinfo img, imgw, imgh

' タイマー精度を1msecに向上
timeBeginPeriod(1)

' 1フレームあたりの本来の時間
Dim As Double MAX_FPS = 60.0
one_frame = 1.0 / MAX_FPS

start_time = Timer
prev_time = start_time
frame_count = 0

Dim As Boolean running = True
Dim As Double angle = 0.0

' メインループ
While (running)

    ' 前回のフレームから何秒経過しているのかを取得。単位は秒(小数点以下有り)
    now_time = Timer
    If now_time >= prev_time Then
        diff_time = now_time - prev_time
    Else
        diff_time = one_frame
    End If
    prev_time = now_time

    If now_time >= start_time Then
        If (now_time - start_time) >= 1.0 Then
            ' FPSを取得
            fps_text = "FPS: " & frame_count
            start_time += 1.0
            frame_count = 0
        End If
    Else
        start_time = now_time
    End If

    If inkey() <> "" Then
        ' 何かのキーが押されたのでループ終了
        running = False
    End If

    angle += (1.0 * MAX_FPS) * diff_time

    ' 描画開始
    ScreenLock

    ' 画面クリア
    color RGB(255, 255, 255), RGB(30, 60, 120)
    cls

    ' 画像群を描画
    Dim As Integer x, y
    For i As Integer = 0 To 48
        Dim As Double ang = (angle + (i * 5.0)) * PI / 180.0
        x = (scrh * 0.4) * Cos(ang) + (scrw / 2) - (imgw / 2)
        y = (scrh * 0.4) * sin(ang) + (scrh / 2) - (imgh / 2)

        Put (x, y), img, TRANS  ' 画像を描画
    Next i

    ' 文字列を描画
    Draw String (10, 10), fps_text

    ' 描画終了
    ScreenUnlock

    If Timer < (now_time + one_frame) Then
        ' 本来のフレーム時間がまだ経過してないので sleep させる
        sleep ((now_time + one_frame) - Timer) * 1000.0
    End If

    frame_count += 1
Wend

' タイマー精度を本来のスペックに戻す
timeEndPeriod(1)

' 画像を使い終わったので破棄
ImageDestroy img

' 最後まで処理が来たのか確認するためにメッセージボックスを表示してみる
' MB_TOPMOST Or MB_SETFOREGROUND を指定しないと、メインウインドウの後ろに隠れてしまう
' MessageBox(NULL, "Cleanup", "Message", MB_OK Or MB_TOPMOST Or MB_SETFOREGROUND)

使用画像ファイルは以下。

_image_circle_96x96.png

fbc mainloop.bas と打てば、mainloop.exe が生成される。実行結果は以下。




一応、60FPS前後で動いてくれた。なんだか動きがガクガクしているような気もするけれど…。でもまあ、一応それっぽい処理を書けそうではあるかな…。

ウインドウ内に色々描画する際にチラついたら嫌なのでダブルバッファ処理をしてみたいと思ったのだけど。ググってみたら FreeBASIC は、 fbgfx なるソレを使っている場合、デフォルトでダブルバッファに対応しているそうで。

描画開始時に ScreenLock を呼んで、描画終了時に ScreenUnlock を呼べば、ダブルバッファになってくれるよ、という話を目にした。

_Double Buffered window? - freebasic.net
_Double buffer for grpahics. - freebasic.net

ちなみに、OpenGL で描画してる場合は、flip を呼ぶことでダブルバッファの切り替えになるらしい。

ところで、このプログラムは、何かのキーを押したら終了するように作ってあるのだけど。ウインドウの右上の閉じるボタンを押したときは、プログラムの最後のあたりの終了処理を ―― 画像を破棄したり、タイマー精度を元に戻したりするあたりを通ってくれるのだろうか、という不安が湧いてきた。

ググったところ、FreeBASIC においては、ウインドウの閉じるボタンを押した際、特定のキー入力として入ってくるようになっているらしい。

_The close button in windowed-mode - freebasic.net
_Windows 10 Window Close - freebasic.net
_Close window - freebasic.net

chr(255) & "k"、もしくは、chr(255, 107)、あるいはもしかすると、chr(0) & "k" が Inkey() で検知された場合、それはウインドウの閉じるボタンが押された状態だよ、ということになっているそうで。

実際、前述プログラムの一番最後の行、MessageBox の行のコメントアウトを外して動作確認したところ、ウインドウの閉じるボタンを押した時も MessageBox が表示された。

メインループを抜ける条件の一つとして、件のキーが入ったかどうかをチェックするようにしておけば、問題は無さそうだなと…。