mieki256's diary

実行すると以下のようになる。

今回書いたソースは、soil.bi という、テクスチャ画像ファイル読み込み用のライブラリを使っている。以下から libsoil.zip を入手できる。

_Simple OpenGL Image Library Windows/Linux 32/64-bit - freebasic.net

Windowsの場合、解凍して中に入っている soil.bi と *.dll をプロジェクトフォルダにコピーすれば利用できる。


ソースは以下。かなり長くなってしまったけど…。

_opengl_sample1.bas

#ifdef __FB_WIN32__
' use mmsystem. Windows only
#include "windows.bi"
#include "win/mmsystem.bi"
#endif

#include once "fbgfx.bi"
Using FB
#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "soil.bi"

Const IMG_FILE = "ufo.png"

Const OBJ_MAX = 10000
Const SPRITE_SIZE = 128
Const MAX_FPS = 60.0
Const PI = 3.1415926535897932

Dim Shared As Integer obj_num = OBJ_MAX  ' Shared ... global variable

ChDir ExePath()

' get desktop size
Dim shared As Integer scr_w, scr_h, sdepth
ScreenInfo scr_w, scr_h, sdepth

' set window screen size
If Command(1) = "/s" Or Command(2) = "/s" Then
    ' like fullscreen
    ScreenRes scr_w, scr_h, sdepth, ,GFX_OPENGL Or GFX_NO_FRAME
Else
    ' window style
    scr_w *= 0.8
    scr_h *= 0.8
    ScreenRes scr_w, scr_h, sdepth, ,GFX_OPENGL
End If

' obj work type
Type obj
    x As double
    y As double
    dx As double
    dy As Double
    w As Integer
    h As Integer

    Declare Sub init(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal w As Integer, ByVal h As Integer)
    Declare Sub update(ByVal delta As Double)

End Type

' obj init
Sub obj.init(ByVal x As Double, ByVal y As Double, ByVal dx As Double, ByVal dy As Double, ByVal w As Integer, ByVal h As Integer)
    this.x = x
    this.y = y
    this.dx = dx
    this.dy = dy
    this.w = w
    this.h = h
End Sub

' obj update
Sub obj.update(ByVal delta As double)
    this.x += (this.dx * MAX_FPS) * delta
    this.y += (this.dy * MAX_FPS) * delta
    Dim As Integer wh = this.w / 2
    Dim As Integer hh = this.h / 2
    If this.dx < 0.0 And this.x - wh <= 0     Then this.dx *= -1.0
    If this.dx > 0.0 And this.x + wh >= scr_w Then this.dx *= -1.0
    If this.dy < 0.0 And this.y - hh <= 0     Then this.dy *= -1.0
    If this.dy > 0.0 And this.y + hh >= scr_h Then this.dy *= -1.0
End Sub

#ifdef __FB_WIN32__
' Changed timer precision to 1 msec
timeBeginPeriod(1)
#endif

' init objs work
Dim objs(0 To OBJ_MAX) As obj

For i As Integer = 0 To UBound(objs)
    Dim As Double a, spd, dx, dy
    a = (Rnd * 360.0) * PI / 180.0
    spd = (scr_h / (MAX_FPS * 2)) * (Rnd + 0.25)
    dx = spd * Cos(a)
    dy = spd * Sin(a)
    objs(i).init(scr_w / 2, scr_h / 2, dx, dy, SPRITE_SIZE, SPRITE_SIZE)
Next i

obj_num = UBound(objs) / 2

For i As Integer = 1 To 2
    If Command(i) <> "" And Command(i) <> "/s" Then
        obj_num = Valint(Command(i))
        If obj_num < 0 Then obj_num = 0
        If obj_num > UBound(objs) Then obj_num = UBound(objs)
    End If
Next i

' load texture image file
var texture = SOIL_load_OGL_texture(IMG_FILE, SOIL_LOAD_AUTO, SOIL_CREATE_NEW_ID, SOIL_FLAG_POWER_OF_TWO)

' OpenGL Config
glViewport 0, 0, scr_w, scr_h
glMatrixMode(GL_PROJECTION)
glLoadIdentity()

glOrtho(0, scr_w, scr_h, 0, 5.0, -5.0)
' gluPerspective 45.0, w/h, 0.1, 100.0

glMatrixMode(GL_MODELVIEW)
glLoadIdentity()

glClearColor(0.15, 0.3, 0.6, 1)
glShadeModel(GL_SMOOTH)

glDisable(GL_DEPTH_TEST)
' glDepthFunc(GL_LEQUAL)
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)

glEnable(GL_BLEND)
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)

glEnable(GL_TEXTURE_2D)
glBindTexture(GL_TEXTURE_2D, texture)

Dim As Double start_time, prev_time, now_time, next_time, delta
Dim As Integer frame_count, fps_count
Dim As Boolean running

start_time = Timer
prev_time = start_time
next_time = start_time + 1.0 / MAX_FPS
frame_count = 0
fps_count = 0
running = True

' main loop
While running
    ' get delta time
    now_time = Timer
    delta = now_time - prev_time
    If delta < 0 Then delta = 1.0 / MAX_FPS
    prev_time = now_time
    next_time = now_time + 1.0 / MAX_FPS

    ' count fps
    If now_time < start_time Then start_time = now_time
    If (now_time - start_time) >= 1.0 Then
        fps_count = frame_count  ' get FPS
        start_time += 1.0
        frame_count = 0
    End If
    frame_count += 1

    Dim As String k = inkey$
    If k = Chr$(27) Or k = "q" Or k = Chr$(255) + "k" Then
        running = False
    End If

    If MultiKey(SC_UP  ) Then obj_num += 20
    If MultiKey(SC_DOWN) Then obj_num -= 20
    If obj_num < 0 Then obj_num = 0
    If obj_num > UBound(objs) Then obj_num = UBound(objs)

    ' update objs
    For i As Integer = 0 To obj_num
        objs(i).update(delta)
    Next i

    ' draw
    glClear GL_COLOR_BUFFER_BIT

    For i As Integer = 0 To obj_num
        Dim As Integer swh = objs(i).w / 2, shh = objs(i).h / 2

        glLoadIdentity()
        glTranslatef(objs(i).x, objs(i).y, -1)

        glBegin GL_QUADS
        glTexCoord2f 0, 0 : glVertex3f -swh, -shh, 0
        glTexCoord2f 1, 0 : glVertex3f  swh, -shh, 0
        glTexCoord2f 1, 1 : glVertex3f  swh,  shh, 0
        glTexCoord2f 0, 1 : glVertex3f -swh,  shh, 0
        glEnd
    Next i

    ' draw String (10, 10), "FPS " & fps_count, RGB(255, 255, 255)
    WindowTitle("FPS:" & fps_count & " obj:" & obj_num)

    flip  ' double buffer flip

    ' wait
    If Timer < next_time Then
        Dim As Double wait_msec = cast( Integer, (next_time - Timer) * 1000.0)
        If wait_msec > 0 Then sleep wait_msec
    End If
Wend

#ifdef __FB_WIN32__
timeEndPeriod(1)
#endif

使用画像は以下。

_ufo.png


fbc opengl_sample1.bas でコンパイル。opengl_sample1.exe が生成される。

使い方は以下。

Usage: 
    opengl_sample1.exe [/s] [OBJ_NUM]

      * /s : Full screen
      * OBJ_NUM : objects number. 0 - 10000

以下の環境で動作確認してみた。

• メインPC、AMD Ryzen 5 5600X (6C12T, 3.7 - 4.6GHz) + GeForec GTX 1060 6GB, デスクトップ解像度 1920x1080
• サブPC、Athlon 5350 (4C4T, 2GHz, TDP 25W, Jaguar Core) + On-board VGA (Radeon R3, GCN), デスクトップ解像度 1920x1200

結果としては…。

• メインPC上では、128x128のスプライト相当を4,000個ほど出しても60FPSが出た。10,000個出すと50FPS台になった。
• サブPC上では、128x128個のスプライト相当を50個までなら60FPSが出たけれど、60個になると50FPS台になってしまった。100個ほど出すと30FPS台。

サブPCの結果が予想以上に酷かった。ここまで差が出るとは思ってなかった…。

タスクマネージャで確認したところ、CPU負荷はそれほどでもなかったけれど、GPU負荷がすぐに80%を超え始めて60FPSが出ない状態になっているように見えた。



つまり、それなりのスペックのGPUを積んでいるPCなら、OpenGLを使うことで描画速度も改善されるけれど、非力な内蔵GPUでは期待した効果は得られないようだなと…。 OpenGLを使ってもソフトウェア描画と五十歩百歩になる場面もありそうな気配がする…。

ただ、今回、OBS Studio 30.0.2 64bit で画面をキャプチャした際、OpenGL を使ってるはずなのに画面が一時的に暗くなっていない点が気になった。今まで OpenGL を使ったプログラムをキャプチャした際は、最初の数秒はキャプチャできなかったのに…。

そこからの邪推だけど、FreeBASIC で OpenGL を使う場合、OpenGL でVRAM上に描画した結果を、メインメモリ上の画像バッファにキャプチャして、その画像バッファをデスクトップに表示していたりしないかと…。そして、VRAM からメインメモリに持ってくるあたりで負荷がかかってるのではないかと。いや、自信無いけど。ただ、C言語等でOpenGLを利用する時とはちょっと違う仕組みになっていてもおかしくなさそうな気もする。

当初、メインループの最後でうっかり sleep を入れ忘れてしまったのだけど、その状態でも60FPS前後で動いてしまった。sleep を入れてもその状態からさほど変わらず。

もしかすると、ダブルバッファを切り替える flip の中で、独自に時間待ち処理をして 60FPS になるようにしてあるのかも。ひょっとして、処理内容としては vsync をチェックしてるつもり、だったりするのかな…。

FreeBASIC は、標準グラフィック画面上で文字を描画する際に、 draw string を使える。今回も draw string で画面に文字描画できないかなと期待したけれど、OpenGL利用時はそういうことはできないっぽい。仕方ないので、ウインドウタイトルにFPS等を表示して誤魔化したけど…。

となると、FreeBASIC で OpenGL を利用する時は、文字描画処理を自前で書かないといけないようだなと…。

OpenGLに、glOrtho() を使って平行投影を指示する際、画面の左上が (0, 0)、画面の右下が (w, h) になるように値を指定すれば、ウインドウサイズの2D描画面がそこにあるように見せかけられると知ったのでメモ。