' FreeBASIC OpenGL sample
'
' Usage: opengl_sample1.exe [/s] [OBJ_NUM]
'    /s : Full screeen
'    OBJ_NUM : 0 - 10000
'
' by mieki256, License: CC0 / Public Domain
' soil.bi License : Public Domain, https://web.archive.org/web/20200728145723/http://lonesock.net/soil.html
' Last updated: <2024/02/23 22:00:41 +0900>

#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