mieki256's diary

まず、本当に画像バッファに対して描画できるのか試してみた。

_draw2image.bas

'Const SCRW = 320 : Const SCRH = 180
Const SCRW = 320 : Const SCRH = 240

#include "fbgfx.bi"
Using fb

' set screen depth
Dim As Integer sdepth = 32
Select Case Command(1)
Case "8"  : sdepth = 8
Case "16" : sdepth = 16
Case "32" : sdepth = 32
End Select

' get desktop size
Dim As Integer dispw, disph
ScreenInfo dispw, disph

' get scale (Integer)
Dim As Double dscale = dispw / SCRW
If dscale > (disph / SCRH) Then dscale = disph / SCRH

ScreenRes dispw, disph, sdepth, , GFX_NO_FRAME
Dim As Any Ptr gbuf = ImageCreate(SCRW, SCRH)

Color RGB(255, 255, 255), RGB(0, 0, 0)
cls

Const PI = 3.1415926535897932
Dim As Double angle = 0.0
Dim As Boolean running = True

' Main Loop

While running
    If Inkey <> "" Then running = False

    ' draw to image buffer
    line gbuf, (0, 0) - (SCRW - 1, SCRH - 1), RGB(30, 60, 120), BF ' clear image buffer
    
    Circle gbuf, (SCRW \ 2, SCRH \ 2), (SCRH \ 2 - 1), RGB(0, 255, 0)

    Dim As Integer x, y, r
    r = SCRH / 4
    x = (SCRW / 2 - r - 1) * Cos(angle * PI / 180.0) + (SCRW / 2)
    y = (SCRH / 2 - r - 1) * Sin(angle * PI / 180.0) + (SCRH / 2)
    Circle gbuf, (x, y), r, RGB(0, 255, 255)

    Draw String gbuf, (0, 0), Str(SCRW) & "x" & SCRH, RGB(255, 255, 255)

    ' draw to screen
    ScreenLock
    Put (0, 0), gbuf, Pset
    ScreenUnlock
    
    angle += 1.0

    sleep 10
Wend

ソース内に出てくる gbuf が、画像バッファのポインタ。円を描画する Circle、テキストを描画する Draw String で gbuf を指定してるので、画像バッファに描画することになる。


fbc draw2image.bas でコンパイル。実行結果は以下。




デスクトップの左上のほうに、画像バッファを Put() している。

これで、画像バッファに対して描画できることが分かった。

この小さい画像を画面全体に拡大描画してみる。拡大描画処理は、 _先日試したImageScale() を ―― 画像から画像に拡大する処理を少し改造して、画像からスクリーンに拡大するように変更して使ってみた。画像から画像に変換する処理のままだと、拡大時に1回、拡大した画像をスクリーンに転送する際に1回と、デスクトップ画面の解像度 1920x1080 で無意味に数回描画することになってしまうので…。


拡大描画の実処理部分。ImageScale2Screen()。

_imagescale2screen.bi


拡大描画を使うサンプル。

_draw2image2.bas

'Const SCRW = 320 : Const SCRH = 180
Const SCRW = 320 : Const SCRH = 240
'Const SCRW = 640 : Const SCRH = 480

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

#include "fbgfx.bi"
Using fb

#include "imagescale2screen.bi"

#ifdef __FB_WIN32__
' Timer accuracy 1ms
timeBeginPeriod(1)
#endif

' set screen depth
Dim As Integer sdepth = 32
Select Case Command(1)
Case "8"  : sdepth = 8
Case "16" : sdepth = 16
Case "32" : sdepth = 32
End Select

' get desktop size
Dim As Integer dispw, disph
ScreenInfo dispw, disph

' get scale (Integer)
Dim As Double dscale = dispw / SCRW
If dscale > (disph / SCRH) Then dscale = disph / SCRH

' get dest image size
Dim As Integer tgtscrw, tgtscrh
tgtscrw = Int(SCRW * dscale)
tgtscrh = Int(SCRH * dscale)
If tgtscrw > dispw Then tgtscrw = dispw
If tgtscrh > disph Then tgtscrh = disph

' set screen size. like fullscreen
ScreenRes dispw, disph, sdepth, 2, GFX_NO_FRAME
Dim As Any Ptr gbuf = ImageCreate(SCRW, SCRH)

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

Const PI = 3.1415926535897932

#define MAX_FPS   60.0
Dim As Double start_time, prev_time, now_time, delta, next_time
Dim As Integer frame_count, fps_count

' save start time
start_time = Timer
prev_time = start_time
frame_count = 0
fps_count = 0

Dim As Integer workpage = 1
ScreenSet workpage, (workpage + 1) And &H01

' 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)

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

    If Inkey <> "" Then running = False

    angle += (1.0 * MAX_FPS) * delta

    ' draw to image buffer
    
    ' clear screen
    line gbuf, (0, 0) - (SCRW - 1, SCRH - 1), RGB(30, 60, 120), BF
    ' cls

    Circle gbuf, (SCRW \ 2, SCRH \ 2), (SCRH \ 2 - 1), RGB(0, 255, 0)

    Dim As Integer x, y, r
    r = SCRH / 4
    x = (SCRW / 2 - r - 1) * Cos(angle * PI / 180.0) + (SCRW / 2)
    y = (SCRH / 2 - r - 1) * Sin(angle * PI / 180.0) + (SCRH / 2)
    Circle gbuf, (x, y), r, RGB(0, 255, 255)

    Draw String gbuf, (0, 0), Str(SCRW) & "x" & SCRH & " (" & tgtscrw & "x" & tgtscrh & ") FPS:" & fps_count, RGB(255, 255, 255)
    
    ' draw to screen
    ScreenLock
    
    Color RGB(255, 255, 255), RGB(0, 0, 0)
    cls

    Dim As Integer ox, oy
    ox = (dispw - tgtscrw) / 2
    oy = (disph - tgtscrh) / 2
    ImageScale2screen(gbuf, ox, oy, tgtscrw, tgtscrh)
    
    ScreenUnlock

    workpage = (workpage + 1) And &H01
    ScreenSet workpage, (workpage + 1) And &H01
    
    If Timer < next_time Then
        ' sleep
        Dim As long wait_ms = (next_time - Timer) * 1000
        If wait_ms > 0 Then sleep wait_ms
    End If
Wend

#ifdef __FB_WIN32__
' reset timer accuracy
timeEndPeriod(1)
#endif

正確に時間待ちをするために、ソースがちょっと長くなってしまっている。

fbc draw2image2.bas でコンパイル。実行結果は以下。




それらしい描画になった。

ただ、60FPS前後で描画してるはずなのに、動きの滑らかさが無いような気もする…。なんだかガクガクしながら動いてるというか…。

当初、ScreenLock, ScreenUnlock を使うだけではダメなのかなと、ScreenRes() で描画ページと表示ページの2ページを用意して、ダブルバッファを切り替える感じに変更してみた。しかし、改善されたようには見えなかった。

もしかすると、ScreenRes で用意した表示用バッファから実際のデスクトップに転送する処理がCPUで行われていて、その処理が行われるタイミングが60FPSになってないのかもしれない…。

でもまあ、当初の目的通り、小さい画面を拡大している見た目にはなってるから、これはこれで。