' fork FB_ScreenSaverKit.bas
'
' Windows10 x64 22H2 + FreeBASIC 1.10.1 32bit
' Last updated: <2024/02/02 06:00:20 +0900>

#Include "windows.bi"
#Include "fbgfx.bi"

Type SaverInfo
    Bounds As Rect
    Bv4Header As BITMAPV4HEADER
    ClassName As String
    EndDialogPtr As INT_PTR
    hInstance As HINSTANCE
    hDC As HDC
    hMemBM As HBITMAP
    hMemDC As HDC
    hWnd As HWND
    hWndParent As HWND
    IsClosing As BOOL
    IsPreview As BOOL
    Message As MSG
    MouseLocation As POINT
    PaintStruct As PAINTSTRUCT
    ScrWidth As uInteger
    ScrHeight As uInteger
    Style As uInteger
    StyleEx As uInteger
    ' Timer As Double
    ' TimerDelay As Double
    WindowClass As WNDCLASS

    ' add 2024/02/02
    time_msec As Integer
    max_fps As Double
    start_time As Double
    prev_time As Double
    now_time As Double
    delta As Double
    frame_count As Integer
    fps As Integer
End Type

Dim Shared SaverInfo As SaverInfo

Declare Sub SetupScreenMode()
Declare Sub StartConfigDialog()
Declare Sub StartScreenSaver(ByVal time_msec As Double)
Declare Sub WindowThread(ByVal userdata As Any Ptr)
Declare Function AboutDialogProc(ByVal hWndDlg As HWND, ByVal Message As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As BOOL
Declare Function ScreenSaverProc(ByVal hWnd As HWND, ByVal Message As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT

' add 2024/02/02
Declare Sub InitProc()
Declare Sub Render(ByVal delta As Double)
Declare Sub ExitProc()


'''''''''''
'StartScreenSaver
'
'Do Until SaverInfo.IsClosing = TRUE
'PSet(Rnd * SaverInfo.ScrWidth, Rnd * SaverInfo.Scrheight), Rgb(Rnd * 255, Rnd * 255, Rnd * 255)
'Loop
'''''''''''

Sub StartScreenSaver(ByVal time_msec As Double)
    SaverInfo.time_msec = time_msec
    SaverInfo.max_fps = 1000.0 / Cdbl(time_msec)

    Select Case LCase(Command(1))
    Case "/c"
        ' Config
        StartConfigDialog()
        End
    Case "/p"
        ' Preview
        Dim As String tmpHWnd = Command(2)
        SaverInfo.IsPreview = TRUE
        If tmpHWND <> "" Then
            SaverInfo.hWndParent = Cast(HWND__ Ptr, CLng(Val(tmpHWnd)))
        End If
        SetupScreenMode()
        ThreadCreate(@WindowThread)
    Case "/s"
        ' Full screen
        SetupScreenMode()
        ThreadCreate(@WindowThread)
    Case Else
        ' No options. Config
        StartConfigDialog()
        End
    End Select
End Sub

' Sets up GFXLib to be compatible with the screen
Sub SetupScreenMode()
    Dim hScreenDC As HDC

    SaverInfo.ScrWidth = GetSystemMetrics(SM_CXSCREEN)
    SaverInfo.ScrHeight = GetSystemMetrics(SM_CYSCREEN)

    ScreenRes(SaverInfo.ScrWidth, SaverInfo.ScrHeight, 32, 1, FB.GFX_NULL)

    ' This helps Windows convert its BMP format to GFXLib's
    With SaverInfo.Bv4Header
        .bV4Size = Len(BITMAPV4HEADER)
        .bv4width=SaverInfo.ScrWidth
        .bv4height=-(SaverInfo.ScrHeight)   'negative value=>top to bottom bmp
        '(standard BMP's are bottom to top)
        .bv4planes=  1
        .bv4bitcount=32
        .bv4v4compression=0
        .bv4sizeimage=(SaverInfo.ScrWidth)*(SaverInfo.ScrHeight)*4
        .bV4RedMask = &h0F00
        .bV4GreenMask = &h00F0
        .bV4BlueMask = &h000F
        .bV4AlphaMask = &hF000
    End With

    'Set up memory DC and copy screen to it
    hScreenDC = GetWindowDC(GetDesktopWindow)
    SaverInfo.hMemDC = CreateCompatibleDC(hScreenDC)
    SaverInfo.hMemBM = CreateCompatibleBitmap(hScreenDC, SaverInfo.ScrWidth, SaverInfo.ScrHeight)
    SelectObject(SaverInfo.hMemDC, SaverInfo.hMemBM)
    BitBlt(SaverInfo.hMemDC, 0, 0, SaverInfo.ScrWidth, SaverInfo.ScrHeight, hScreenDC, 0, 0, SRCCOPY)

    'Copy memory DC (and consequentially, the screen) to ScreenPtr
    GetDIBits(SaverInfo.hMemDC, SaverInfo.hMemBM, 0, SaverInfo.ScrHeight, ScreenPtr, CPtr(BitmapInfo Ptr, @SaverInfo.Bv4Header), DIB_RGB_COLORS)
End Sub

Sub WindowThread (ByVal userdata As Any Ptr)
    With SaverInfo
        .hInstance = GetModuleHandle(NULL)
        .ClassName = "SCREENSAVERCLASS"

        'Set up window's class
        With .WindowClass
            .hCursor = NULL
            .hIcon = NULL
            .lpszMenuName = NULL
            .lpszClassName = StrPtr(SaverInfo.ClassName)
            .hbrBackground = NULL'GetStockObject(WHITE_BRUSH)
            .hInstance = SaverInfo.hInstance
            .style = CS_VREDRAW Or CS_HREDRAW Or CS_SAVEBITS Or CS_PARENTDC
            .lpfnWndProc = @ScreenSaverProc
            .cbWndExtra = 0
            .cbClsExtra = 0
        End With
    End With

    'Register the window class
    If RegisterClass(@SaverInfo.WindowClass) = 0 Then
        MessageBox(0, "ScreenSaver Failed To Initialize", "Error!", MB_ICONERROR)
        End
    End If

    'Change some settings based on whether or not it's in the preview box
    If SaverInfo.IsPreview = TRUE Then
        SaverInfo.Style = WS_CHILD
        SaverInfo.StyleEx = 0
        GetWindowRect(SaverInfo.hWndParent, @SaverInfo.Bounds)
    Else
        SaverInfo.Style = CuInt(WS_POPUP Or WS_VISIBLE Or WS_MAXIMIZE)
        SaverInfo.StyleEx = WS_EX_TOPMOST
        GetWindowRect(GetDesktopWindow, @SaverInfo.Bounds)
        SetCursor(NULL)
    End If

    'Create and show the window
    SaverInfo.hWnd = CreateWindowEx( _
      SaverInfo.StyleEx, _
      SaverInfo.ClassName,  _
      "SCREENSAVER", _
      SaverInfo.Style, _
      0, _
      0, _
      SaverInfo.Bounds.Right, _
      SaverInfo.Bounds.Bottom, _
      SaverInfo.hWndParent, _
      NULL, _
      SaverInfo.hInstance, _
      NULL _
      )

    ShowWindow(SaverInfo.hWnd, SW_SHOW)
    UpdateWindow(SaverInfo.hWnd)

    'The infamous message loop
    While GetMessage(@SaverInfo.Message, NULL, 0, 0)
        TranslateMessage(@SaverInfo.Message)
        DispatchMessage(@SaverInfo.Message)
    Wend
End Sub

Function ScreenSaverProc(ByVal hWnd As HWND, ByVal Message As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT
    Dim TempMouseLocation As Point

    'If the screensaver is not a preview, then close it in the event of a mouse click
    If SaverInfo.IsPreview = FALSE Then
        Select Case Message
        Case WM_LBUTTONDOWN
            PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
        Case WM_RBUTTONDOWN
            PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
        Case WM_MBUTTONDOWN
            PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
        Case WM_KEYDOWN
            PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
        Case WM_SYSKEYDOWN
            PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
        Case WM_MOUSEMOVE
            'WM_MOUSEMOVE actually happens all the time, so we have to compare
            GetCursorPos(@TempMouseLocation)
            If (TempMouseLocation.x <> SaverInfo.MouseLocation.x) Or _
                  (TempMouseLocation.y <> SaverInfo.MouseLocation.y) Then
                PostMessage(hWnd, WM_CLOSE, 0, 0): Return 0
            End If
        End Select
    End If

    Select Case Message
    Case WM_CREATE
        'Store the cursor
        GetCursorPos(@SaverInfo.MouseLocation)

        'Get the proper bounds, according to the screensaver size
        If SaverInfo.IsPreview Then
            GetWindowRect(SaverInfo.hWndParent, @SaverInfo.Bounds)
        Else
            GetWindowRect(GetDesktopWindow, @SaverInfo.Bounds)
        End If

        With SaverInfo
            .start_time = Timer
            .prev_time = .start_time
            .now_time = .start_time
            .delta = 0.0
            .frame_count = 0
            .fps = 0
        End With

        InitProc()

        'Create a timer
        SetTimer(hWnd, 1, SaverInfo.time_msec, 0)

        Return 0

    Case WM_DESTROY
        KillTimer(hWnd, 1)
        PostQuitMessage(0)
        SaverInfo.IsClosing = True
        ExitProc()
        Return 0

    Case WM_PAINT
        'Copy the GFXLib screen to the actual screen
        SaverInfo.hDC = BeginPaint(hWnd, @SaverInfo.PaintStruct)

        StretchDIBits( _
          SaverInfo.hDC, _
          0, 0, _
          SaverInfo.Bounds.Right - SaverInfo.Bounds.Left, _
          SaverInfo.Bounds.Bottom - SaverInfo.Bounds.Top, _
          0, 0, SaverInfo.ScrWidth, SaverInfo.ScrHeight, _
          ScreenPtr, _
          CPtr(BitmapInfo Ptr, @SaverInfo.Bv4Header), _
          DIB_RGB_COLORS, SRCCOPY _
          )

        EndPaint(hWnd, @SaverInfo.PaintStruct)

        Return 0

    Case WM_TIMER
        'Force the window to update every timer tick

        ' get delta time
        SaverInfo.now_time = Timer
        SaverInfo.delta = SaverInfo.now_time - SaverInfo.prev_time
        SaverInfo.prev_time = SaverInfo.now_time
        If SaverInfo.delta < 0 Then SaverInfo.delta = SaverInfo.time_msec / 1000.0

        ' count FPS
        Dim As Double nowtime = Timer
        If nowtime >= SaverInfo.start_time Then
            If (nowtime - SaverInfo.start_time) >= 1.0 Then
                SaverInfo.fps = SaverInfo.frame_count
                SaverInfo.start_time += 1.0
                SaverInfo.frame_count = 0
            End If
        Else
            SaverInfo.start_time = nowtime
        End If
        SaverInfo.frame_count += 1

        ' Draw to buffer
        ' Rendering
        If SaverInfo.IsClosing <> True Then
            Render(SaverInfo.delta)
        End If

        InvalidateRect(hWnd, NULL, 0)
        UpdateWindow(hWnd)
        Return 0
        
    Case Else
        'Let windows handle the messages we don't care about
        Return DefWindowProc(hWnd, Message, wParam, lParam)
    End Select
End Function

Sub StartConfigDialog()
    'Checks to see if the user included an about dialog
    If FindResource(SaverInfo.hInstance, "FB_SCRNSAVER_ABOUT", RT_DIALOG) Then
        DialogBox(SaverInfo.hInstance, "FB_SCRNSAVER_ABOUT", SaverInfo.hWndParent, @AboutDialogProc)
    Else
        MessageBox(0, "No Settings To Display", "Settings", MB_ICONINFORMATION)
    End If
End Sub

Function AboutDialogProc(ByVal hWndDlg As HWND, ByVal Message As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As BOOL
    'Display some info until the user clicks "OK" or closes the box
    Select Case Message
    Case WM_COMMAND
        Select Case LOWORD(wParam)
        Case IDOK:
            EndDialog(hWndDlg, wParam)
            Return TRUE
        End Select
    End Select
End Function