QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Works in Progress v
Webcam Pong v0.01

Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Threaded Mode
Webcam Pong v0.01
madscijr Offline
Mini-Mod
***
Posts: 817
Threads: 116
Joined: Apr 2022
Reputation: 19
#1
10 hours ago (This post was last modified: 5 hours ago by madscijr.)
Thanks to @SpriggsySpriggs for providing the webcam code. 
This makes it possible to control games by waving your hands like with Microsoft Kinect!
Enjoy

EDIT: added some better instructions

EDIT 2: Forgot to add the _FREEIMAGE lines, but now am away from PC... DOH!

EDIT 3: Fixed the _FREEIMAGE and tweaked the input detection, see that update in Reply #8 below

Code: (Select All)
' Webcam Pong by Madscijr (alpha version)
' Thanks to SpriggsySpriggs for figuring out how to program the webcam

' USB Camera? Reply #26 > Help Me! > Code and Stuff > QB64 Rising > QB64 Phoenix Edition
' https://qb64phoenix.com/forum/showthread.php?tid=1163&pid=32337#pid32337
' From: SpriggsySpriggs, Professional Noticer
' Date: 2/26/2025 2:48 PM
' Now you can export straight to memory, mi amigo.
' It should be noted that it has to export to clipboard first and then load to memory.
' So your clipboard will contain the image as well. But that's the nature of the beast.

' USB Camera? Reply #28 > Help Me! > Code and Stuff > QB64 Rising > QB64 Phoenix Edition
' https://qb64phoenix.com/forum/showthread.php?tid=1163&pid=32339#pid32339
' From: SpriggsySpriggs, Professional Noticer
' Date: 2/26/2025 4:01 PM
' Q: I wonder if there's a way to change camera resolution at the API or software level?
' A: YES! If you want to change the settings first, use this code:

Option _Explicit
_Title "Webcam API Test - Parent"

' ================================================================================================================================================================
' CONSTANTS
' ================================================================================================================================================================
Const FPS = 30 ' Not recommended to set this higher than frame rate of webcam/video device

Const MOVEMENT_THRESHOLD = 160

Const CAMERA_WIDTH = 320
Const CAMERA_HEIGHT = 240

Const WS_VISIBLE = &H10000000 '  The window is initially visible.
Const WS_MAXIMIZE = &H1000000 ' The window is initially maximized.
Const WS_MINIMIZE = &H20000000 ' The window is initially minimized.

Const CF_DIB = &H0008

' Capture Driver Constants
Const WM_CAP_START = &H0400
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61
Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41

Const LONG_MIN = -2147483648
Const LONG_MAX = 2147483647

' ================================================================================================================================================================
' UDTs
' ================================================================================================================================================================
Type BITMAPINFOHEADER
    As _Unsigned Long biSize
    As Long biWidth, biHeight
    As _Unsigned Integer biPlanes, biBitCount
    As _Unsigned Long biCompression, biSizeImage
    As Long biXPelsPerMeter, biYPelsPerMeter
    As _Unsigned Long biClrUsed, biClrImportant
End Type

Type BITMAPINFO
    As BITMAPINFOHEADER bmiHeader
End Type

' HOLDS DISPLAY LAYERS (ALL NEED _FREEIMAGE WHEN PROGRAM ENDS)
Type GraphicsType
    imgBackground As Long ' background image
    imgCamera As Long
    imgWalls As Long
    imgStaticText As Long '
    imgDynamicText As Long
    imgSprites As Long
End Type ' GraphicsType

' HOLDS VALUES FOR OPERATING WEBCAM
Type WebcamType
    captureWinText As String
    childID As _Offset
    vidWidth As _Unsigned Long
    vidHeight As _Unsigned Long
    childWin As _Offset
    m As _MEM
    CaptureWindowStyle As _Unsigned Long
End Type ' WebcamType

' HOLDS PLAYER COORDINATES AND INFO
Type PlayerType
    color As _Unsigned Long
    x As Long
    y As Long
    width As Integer
    height As Integer
    score As Integer
    Visible As Integer
End Type ' PlayerType

' HOLDS BALL COORDINATES AND INFO
Type BallType
    color As _Unsigned Long
    size As Integer
    x As Long
    y As Long
    dx As Integer
    dy As Integer
    Visible As Integer
End Type ' BallType

' HOLDS RGB VALUES FOR A PIXEL
Type PixelType
    r As Long
    g As Long
    b As Long
End Type ' PixelType

' ================================================================================================================================================================
' API DEFINITIONS
' ================================================================================================================================================================
Declare CustomType Library
    Sub SendMessage Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Function SendMessage& Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Sub DestroyWindow (ByVal hWnd As _Offset)
    Function GetAsyncKeyState% (ByVal vKey As Long)
    Function mmioStringToFOURCC& (sz As String, ByVal uFlags As _Unsigned Long)
    Function OpenClipboard& (ByVal hWndNewOwner As _Offset)
    Function GetClipboardData%& (ByVal uFormat As _Unsigned Long)
    Sub CloseClipboard ()
    Function GlobalLock%& (ByVal hMem As _Offset)
    Function GlobalUnlock& (ByVal hMem As _Offset)
End Declare

Declare Dynamic Library "Avicap32"
    Function CreateCaptureWindow& Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As _Offset, ByVal dwStyle As _Unsigned Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As _Offset, ByVal nId As Long)
End Declare

' ================================================================================================================================================================
' GLOBAL VARIABLES
' ================================================================================================================================================================
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' GLOBAL VARIABLES TO TRACK ERROR STATE
Dim Shared m_ErrorMessage As String: m_ErrorMessage = ""
'Dim Shared m_RoutineName As String: m_RoutineName = ""
'Dim Shared m_LastStatement As String: m_LastStatement = ""

' GLOBAL VARIABLES FOR SCREEN
Dim Shared m_iScreenWidth As Long: m_iScreenWidth = 1024 ' _DesktopWidth
Dim Shared m_iScreenHeight As Long: m_iScreenHeight = 768 ' _DesktopHeight
Dim Shared m_iTextRows As Long: m_iTextRows = (m_iScreenHeight / _FontHeight)
Dim Shared m_iTextCols As Long: m_iTextCols = (m_iScreenWidth / _FontWidth)
Dim Shared PLAYER_HEIGHT As Long: PLAYER_HEIGHT = 32
Dim Shared MIN_Y As Long: MIN_Y = 44 + 1
Dim Shared MAX_Y As Long: MAX_Y = (m_iScreenHeight - 54) - (PLAYER_HEIGHT + 1)

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' START THE MAIN ROUTINE
main

' FINISH
Print m_ProgramName$ + " finished."

'End
System ' return control to the operating system

' ================================================================================================================================================================
' ROUTINES
' ================================================================================================================================================================

' /////////////////////////////////////////////////////////////////////////////
' MAIN PROGRAM

Sub main
    Dim Graph1 As GraphicsType
    Dim WebCam As WebcamType
    ReDim arrPlayer(1 To 2) As PlayerType ' 1 = left, 2 = right
    ReDim arrComparePixels(CAMERA_WIDTH, CAMERA_HEIGHT) As PixelType
    Dim Ball1 As BallType
    Dim x, y As Integer
    Dim iValue As Integer
    Dim IsCalibrating As Integer
    Dim ShowCamera As Integer
   
    ' INIT SCREEN
    Screen _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
    _ScreenMove 0, 0
   
    ' Show initial detailed instructions
    Cls
    Print "Webcam Pong, a 'computer vision' experiment, v0.01"
    Print "by madscijr, webcam code by spriggsyspriggs"
    Print
    Print "At 'Video Format' popup, values should say:"
    Print "    Resolution                        : 320x240"
    Print "    Pixel Depth (bits) and Compression: YUY2"
    Print "    Size (bytes)                      : 153600"
    Print "Do not change these values, just click [OK]"
    Print
    Print "At 'Video Source' popup, values should say:"
    Print "    Select a Video Device: {your camera name}"
    Print "Click [OK]"
    Print
    Print "1 window should open:"
    Print "    Webcam API Test - Parent"
    Print
    Print "And this window hidden (maybe visible in Task Manager):"
    Print "    Webcam API Test - Child"
    Print
    Print "Point webcam at an empty room or down at a blank sheet of paper,"
    Print "away from you and your friends, and anything that's moving."
    Print "Press Enter to 'calibrate', where program memorizes the room."
    Print "Enter also toggles the camera picture on and off,"
    Print "with the camera on, you can see yourself moving around."
    Print "Try moving something up and down along the left half of the screen,"
    Print "that controls the left paddle. Right half of screen = right paddle."
    Print
    Print "Per SpriggsySpriggs:"
    Print "DO NOT GO CLICKING ALL WILLY-NILLY ON THE PROGRAM WINDOW,"
    Print "ESPECIALLY IF YOUR CURSOR HAS THE LOADING CIRCLE/HOURGLASS."
    Print "For some reason, this will cause it to freeze and crash."
    Print "Why? 'cause Microsoft, that's why."
    Print
    Print "Press any key to start..."
    Sleep
    _KeyClear: '_DELAY 1 ' clear keyboard buffer
   
    ' CLEAR THE SCREEN
    _Dest 0: Cls , cEmpty
    _Display ' update screen with changes & wait for next update
   
    ' INITIALIZE SCREEN
    InitGraphicLayers Graph1
    DrawInstructionsLayer Graph1
   
    ' SET LOWER CAMERA RESOLUTION
    WebCam.vidWidth = CAMERA_WIDTH
    WebCam.vidHeight = CAMERA_HEIGHT
   
    ' CREATE CAPTURE WINDOW (HIDDEN)
    WebCam.captureWinText = "Webcam API Test - Child" + Chr$(0)
    WebCam.CaptureWindowStyle = WS_MINIMIZE ' WS_VISIBLE
    WebCam.childWin = CreateCaptureWindow(_Offset(WebCam.captureWinText), WebCam.CaptureWindowStyle, 0, 0, WebCam.vidWidth, WebCam.vidHeight, _WindowHandle, WebCam.childID)
   
    ' Initialize the driver
    SetupDriver WebCam.childWin, WebCam.vidWidth, WebCam.vidHeight, _FALSE ' change _FALSE to _TRUE to use default settings
   
    ' INIT PLAYERS
    arrPlayer(1).color = cRed
    arrPlayer(1).x = 64
    arrPlayer(1).y = m_iScreenHeight / 2
    arrPlayer(1).width = 8
    arrPlayer(1).height = 32
    arrPlayer(1).score = 0
    arrPlayer(1).Visible = _FALSE
   
    arrPlayer(2).color = cBlue
    arrPlayer(2).x = m_iScreenWidth - 64
    arrPlayer(2).y = m_iScreenHeight / 2
    arrPlayer(2).width = 8
    arrPlayer(2).height = 32
    arrPlayer(2).score = 0
    arrPlayer(2).Visible = _FALSE
   
    ' INIT BALL
    Ball1.color = cWhite
    Ball1.size = 8
    Ball1.x = m_iScreenWidth / 2
    Ball1.y = m_iScreenHeight / 2
    Ball1.Visible = _FALSE
   
    ' RANDOM BALL DIRECTION
    Randomize Timer
    If RandomNumber%(1, 2) = 1 Then
        Ball1.dx = -1
    Else
        Ball1.dx = 1
    End If
    iValue = RandomNumber%(1, 3)
    If iValue = 1 Then
        Ball1.dy = -1
    Else
        If iValue = 2 Then
            Ball1.dy = 0
        Else
            Ball1.dy = 1
        End If
    End If
   
    ' Capture a single frame to window WebCam.childWin
    IsCalibrating = _TRUE
    ShowCamera = _TRUE
    Do
        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' READ KEYBOARD
        ' GetAsyncKeyState is necessary because the capture window steals keyboard focus
       
        ' ENTER = RECALIBRATE + SHOW CAMERA FRAME
        ' PRESSING  ENTER AGAIN HIDES CAMERA FRAME
        If GetAsyncKeyState(&H0D) <> 0 Then ' user pressed Enter
            If ShowCamera = _FALSE Then
                ShowCamera = _TRUE
                IsCalibrating = _TRUE
            Else
                ShowCamera = _FALSE
            End If
        End If
       
        ' ESC = QUIT
        If GetAsyncKeyState(&H1B) <> 0 Then ' user pressed Escape
            KillDriver WebCam.childWin
            Exit Do
        End If
       
        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' CAPTURE FRAME WITH WEBCAM
       
        ' Get still picture from camera to frame
        GrabFrame WebCam.childWin
       
        ' Copy frame from WebCam.childWin to image in memory
        GrabFrameToMemory WebCam.childWin, WebCam.m
       
        ' Remember background (to compare to detect movement)
        If IsCalibrating = _TRUE Then
            SaveFrame WebCam.m.IMAGE, arrComparePixels()
            IsCalibrating = _FALSE
        End If
       
        ' Detect movement with the camera (computer vision)
        DetectMovement WebCam.m.IMAGE, arrComparePixels(), arrPlayer()
       
        ' Display the image
        DrawCameraLayer Graph1, WebCam.m.IMAGE, ShowCamera
        'Screen WebCam.m.IMAGE
       
        ' Draw walls layer
        DrawWallsLayer Graph1
       
        ' Draw sprites layer
        DrawSpritesLayer Graph1, arrPlayer(), Ball1
       
        ' Draw
        DrawDynamicTextLayer Graph1, arrPlayer(), ShowCamera
       
        ' COPY LAYERS TO SCREEN AND UPDATE DISPLAY
        RenderScreen Graph1
       
        ' Keep at steady frames per second
        _Limit FPS
    Loop
   
    ' RETURN TO AUTODISPLAY
    _AutoDisplay
    Cls
   
    ' Disconnect driver
    Print "Disconnecting driver"
    KillDriver WebCam.childWin
   
    ' Free memory
    Print "Freeing memory"
    _MemFree WebCam.m
   
    '' RESUME NORMAL ERROR TRAPPING
    'On Error GoTo 0
   
End Sub ' main

' /////////////////////////////////////////////////////////////////////////////
' COMPARE PIXELS IN CAMERA FRAME AGAINST WHAT IT SAW AT BEGINNING

Sub DetectMovement (imgCamera As Long, arrComparePixels() As PixelType, arrPlayer() As PlayerType)
    Dim iPlayer As Integer
    Dim x As Integer
    Dim y As Integer
    Dim c&
    Dim dr&, dg&, db&
   
    ' LOOK FOR PLAYER 1 IN LEFT HALF OF CAMERA FRAME
    iPlayer = 1
    arrPlayer(iPlayer).Visible = _FALSE
    _Source imgCamera
    For x = (CAMERA_WIDTH - 1) To (CAMERA_WIDTH / 2) Step -1
        For y = 1 To (CAMERA_HEIGHT - 1)
            ' COMPARE AGAINST ORIGINAL PIXEL
            c& = Point(x, y)
            dr& = Abs(arrComparePixels(x, y).r - _Red32(c&))
            dg& = Abs(arrComparePixels(x, y).g - _Green32(c&))
            db& = Abs(arrComparePixels(x, y).b - _Blue32(c&))
            '_Alpha32(c&)
           
            ' DID IT CHANGE ENOUGH?
            If (dr& + dg& + db&) > MOVEMENT_THRESHOLD Then
                'arrPlayer(iPlayer).x = x
                arrPlayer(iPlayer).y = y * (m_iScreenHeight / CAMERA_HEIGHT)
               
                'NO:
                '' Y has to be reversed (up is down & down is up)
                'arrPlayer(iPlayer).y = m_iScreenHeight - (y * (m_iScreenHeight / CAMERA_HEIGHT))
               
                ' Keep within boundaries
                If arrPlayer(iPlayer).y < MIN_Y Then
                    arrPlayer(iPlayer).y = MIN_Y
                ElseIf arrPlayer(iPlayer).y > MAX_Y Then
                    arrPlayer(iPlayer).y = MAX_Y
                End If
               
                ' Done looking
                arrPlayer(iPlayer).Visible = _TRUE
                Exit For
            End If
        Next y
        If arrPlayer(iPlayer).Visible = _TRUE Then
            Exit For
        End If
    Next x
   
    ' LOOK FOR PLAYER 2 IN RIGHT HALF OF CAMERA FRAME
    iPlayer = 2
    arrPlayer(iPlayer).Visible = _FALSE
    _Source imgCamera
    For x = 1 To (CAMERA_WIDTH / 2)
        For y = 1 To (CAMERA_HEIGHT - 1)
            ' COMPARE AGAINST ORIGINAL PIXEL
            c& = Point(x, y)
            dr& = Abs(arrComparePixels(x, y).r - _Red32(c&))
            dg& = Abs(arrComparePixels(x, y).g - _Green32(c&))
            db& = Abs(arrComparePixels(x, y).b - _Blue32(c&))
            '_Alpha32(c&)
           
            ' DID IT CHANGE ENOUGH?
            If (dr& + dg& + db&) > MOVEMENT_THRESHOLD Then
                'arrPlayer(iPlayer).x = x
                arrPlayer(iPlayer).y = y * (m_iScreenHeight / CAMERA_HEIGHT)
               
                'NO:
                '' Y has to be reversed (up is down & down is up)
                'arrPlayer(iPlayer).y = m_iScreenHeight - (y * (m_iScreenHeight / CAMERA_HEIGHT))
               
                ' Keep within boundaries
                If arrPlayer(iPlayer).y < MIN_Y Then
                    arrPlayer(iPlayer).y = MIN_Y
                ElseIf arrPlayer(iPlayer).y > MAX_Y Then
                    arrPlayer(iPlayer).y = MAX_Y
                End If
               
                ' Done looking
                arrPlayer(iPlayer).Visible = _TRUE
                Exit For
            End If
        Next y
        If arrPlayer(iPlayer).Visible = _TRUE Then
            Exit For
        End If
    Next x
   
End Sub ' DetectMovement

' /////////////////////////////////////////////////////////////////////////////
' SAVE RGB OF EACH PIXEL CAMERA SEES BEFORE PLAYERS USE HANDS/LASERS

Sub SaveFrame (imgCamera As Long, arrComparePixels() As PixelType)
    Dim x As Integer
    Dim y As Integer
    Dim c&, r&, g&, b&
    'Dim a&
   
    _Source imgCamera
    For y = 1 To CAMERA_HEIGHT
        For x = 1 To CAMERA_WIDTH
            c& = Point(x, y)
            arrComparePixels(x, y).r = _Red32(c&)
            arrComparePixels(x, y).g = _Green32(c&)
            arrComparePixels(x, y).b = _Blue32(c&)
            'arrComparePixels(x, y).a = _Alpha32(c&)
        Next x
    Next y
End Sub ' SaveFrame

' /////////////////////////////////////////////////////////////////////////////

Sub InitGraphicLayers (Graph1 As GraphicsType)
    ' BACKGROUND = SOLID BLACK
    If Graph1.imgBackground = -1 Or Graph1.imgBackground = 0 Then
        Graph1.imgBackground = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgBackground: Cls , cBlack
    End If
   
    ' CAMERA LAYER
    If Graph1.imgCamera = -1 Or Graph1.imgCamera = 0 Then
        Graph1.imgCamera = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgCamera: Cls , cEmpty
    End If
   
    ' WALLS LAYER
    If Graph1.imgWalls = -1 Or Graph1.imgWalls = 0 Then
        Graph1.imgWalls = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgWalls: Cls , cEmpty
    End If
   
    ' TEXT + INSTRUCTIONS (STATIC TEXT)
    If Graph1.imgStaticText = -1 Or Graph1.imgStaticText = 0 Then
        Graph1.imgStaticText = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgStaticText: Cls , cEmpty
    End If
   
    ' SCORE (CONSTANTLY UPDATED TEXT)
    If Graph1.imgDynamicText = -1 Or Graph1.imgDynamicText = 0 Then
        Graph1.imgDynamicText = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgDynamicText: Cls , cEmpty
    End If
   
    ' HOLDS POINTER LASER MOVES AROUND
    If Graph1.imgSprites = -1 Or Graph1.imgSprites = 0 Then
        Graph1.imgSprites = _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
        _Dest Graph1.imgSprites: Cls , cEmpty
    End If
End Sub ' InitGraphicLayers

' /////////////////////////////////////////////////////////////////////////////

Sub DrawCameraLayer (Graph1 As GraphicsType, imgCamera As Long, ShowCamera As Integer)
    Dim dx1, dx2, dy1, dy2 As Integer
   
    _Dest Graph1.imgCamera: Cls , cEmpty
    If ShowCamera = _TRUE Then
        ' Camera image is flipped horizontally (like looking in a mirror)
        '_PutImage ((m_iScreenWidth - CAMERA_WIDTH) / 2, (m_iScreenHeight - CAMERA_HEIGHT) / 2), imgCamera
       
        ' Per: https://qb64phoenix.com/qb64wiki/index.php/PUTIMAGE
        ' To flip the image on the x axis, swap the dx coordinate values:
        ' e.g., _PUTIMAGE (dx2, dy1)-(dx1, dy2), source_handle, dest_handle
        dx1 = (m_iScreenWidth - CAMERA_WIDTH) / 2
        dy1 = (m_iScreenHeight - CAMERA_HEIGHT) / 2
        dx2 = dx1 + CAMERA_WIDTH
        dy2 = dy1 + CAMERA_HEIGHT
        _PutImage (dx2, dy1)-(dx1, dy2), imgCamera, Graph1.imgCamera
       
    End If
End Sub ' DrawCameraLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW THE INSTRUCTIONS LAYER

Sub DrawInstructionsLayer (Graph1 As GraphicsType)
    Dim sMessage As String
    Dim iCol As Integer
   
    _Dest Graph1.imgStaticText: Cls , cEmpty
   
    ' ROW 1: TITLE
    'Color cWhite, cEmpty
    sMessage = "Webcam computer vision Pong"
    iCol = (m_iTextCols / 2) - (Len(sMessage) / 2) ' CENTERED TEXT
    PrintTitle 1, iCol, sMessage
   
    ' ROW 47: INSTRUCTIONS
    iCol = 1
    sMessage = "POINT WEBCAM AT EMPTY ROOM OR WHITE SHEET OF PAPER"
    'iCol = (((m_iTextCols / 3) / 2) - (Len(sMessage) / 2)) ' LEFT THIRD
    Color cBlack, cWhite
    Locate 47, iCol: Print sMessage;
   
    ' ROW 48: INSTRUCTIONS
    iCol = 1
    sMessage = "PRESS ENTER TO CALIBRATE + SHOW/HIDE CAMERA"
    'iCol = (((m_iTextCols / 3) / 2) - (Len(sMessage) / 2)) ' LEFT THIRD
    Color cBlack, cLime
    Locate 48, iCol: Print sMessage;
   
    iCol = iCol + Len(sMessage) + 2
    sMessage = "MOVE HAND UP & DOWN ALONG LEFT AND RIGHT EDGES"
    'iCol = ((m_iTextCols / 2) - (Len(sMessage) / 2)) ' MIDDLE THIRD
    Color cWhite, cRed
    Locate 48, iCol: Print sMessage;
   
    iCol = iCol + Len(sMessage) + 2
    sMessage = "PRESS [ESC] TO EXIT"
    'iCol = (m_iTextCols - ((m_iTextCols / 3) / 2)) - (Len(sMessage) / 2) ' RIGHT THIRD
    Color cWhite, cBlue
    Locate 48, iCol: Print sMessage;
   
End Sub ' DrawInstructionsLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW NON-MOVING STUFF

Sub DrawWallsLayer (Graph1 As GraphicsType)
    Dim iLoop As Integer
    Dim x1, y1, x2, y2 As Integer
   
    ' CLEAR LAYER
    _Dest Graph1.imgWalls: Cls , cEmpty
   
    ' DRAW WALLS
    x1 = 1: y1 = 40: x2 = m_iScreenWidth: y2 = 44
    Line (x1, y1)-(x2, y2), cWhite, BF
    x1 = 1: y1 = m_iScreenHeight - 54: x2 = m_iScreenWidth: y2 = m_iScreenHeight - 50
    Line (x1, y1)-(x2, y2), cWhite, BF
   
    ' DRAW THE NET
    For iLoop = 44 To (m_iScreenHeight - 48) Step 20
        Line ((m_iScreenWidth / 2) - 2, iLoop)-((m_iScreenWidth / 2) + 2, iLoop + 10), cWhite, BF
    Next iLoop
End Sub ' DrawWallsLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW THE SCORE LAYER
' TEXT SCREEN AT 1024 x  768 = 128 x 48 (m_iTextCols x m_iTextRows)

Sub DrawDynamicTextLayer (Graph1 As GraphicsType, arrPlayer() As PlayerType, ShowCamera As Integer)
    Dim y
   
    _Dest Graph1.imgDynamicText: Cls , cEmpty
   
    ' SHOW SCORES
    Color cCyan, cEmpty: Locate 2, 32
    Print _Trim$(Str$(arrPlayer(1).score))
   
    Color cLightPink, cEmpty: Locate 2, 96
    Print _Trim$(Str$(arrPlayer(2).score))
   
    ' SHOW POSITIONS
    If arrPlayer(1).Visible = _TRUE Then
        Color cCyan, cEmpty: Locate 37, 32
        Print "Player 1: x=" + _Trim$(Str$(arrPlayer(1).x)) + " y=" + _Trim$(Str$(arrPlayer(1).y))
    End If
    If arrPlayer(2).Visible = _TRUE Then
        Color cLightPink, cEmpty: Locate 37, 96
        Print "Player 2: x=" + _Trim$(Str$(arrPlayer(2).x)) + " y=" + _Trim$(Str$(arrPlayer(2).y))
    End If
   
    ' SHOW OTHER
    If ShowCamera = _TRUE Then
        'y = ( ( (m_iScreenHeight - CAMERA_HEIGHT) / 2 ) / _FontHeight) - _FontHeight
        'color cBlack, cYellow : Locate y, 60
        Color cBlack, cYellow: Locate 16, 60
        Print "ShowCamera = _TRUE"
    End If
End Sub ' DrawDynamicTextLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW SPRITES (PLAYERS + BALL)

Sub DrawSpritesLayer (Graph1 As GraphicsType, arrPlayer() As PlayerType, Ball1 As BallType)
    _Dest Graph1.imgSprites: Cls , cEmpty
   
    ' If players are visible draw a box at the locations
    If arrPlayer(1).Visible = _TRUE Then
        DrawRectSolid arrPlayer(1).x, arrPlayer(1).y, arrPlayer(1).width, arrPlayer(1).height, arrPlayer(1).color
    End If
    If arrPlayer(2).Visible = _TRUE Then
        DrawRectSolid arrPlayer(2).x, arrPlayer(2).y, arrPlayer(2).width, arrPlayer(2).height, arrPlayer(2).color
    End If
   
    ' If ball is visible, draw it
    If Ball1.Visible = _TRUE Then
        DrawRectSolid Ball1.x, Ball1.y, Ball1.size, Ball1.size, Ball1.color
    End If
End Sub ' DrawSpritesLayer

' /////////////////////////////////////////////////////////////////////////////
' COPY LAYERS TO SCREEN AND UPDATE DISPLAY

Sub RenderScreen (Graph1 As GraphicsType)
    ' CLEAR THE SCREEN
    _Dest 0: Cls , cEmpty
   
    ' Add the background
    _PutImage , Graph1.imgBackground, 0
   
    ' Add the camera image
    _PutImage , Graph1.imgCamera, 0
   
    ' Add the walls
    _PutImage , Graph1.imgWalls, 0
   
    ' Add the instructions
    _PutImage , Graph1.imgStaticText, 0
   
    ' Add the score
    _PutImage , Graph1.imgDynamicText, 0
   
    ' Add the sprites
    _PutImage , Graph1.imgSprites, 0
   
    ' update screen with changes
    _Display
End Sub ' RenderScreen

' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D RECTANGLE (SOLID)

Sub DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)
    Line (iX, iY)-(iX + iSizeW, iY + iSizeH), fgColor, BF ' Draw a solid rectangle
End Sub ' DrawRectSolid

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrame (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End Sub ' GrabFrame

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrameToMemory (hwnd As _Offset, image As _MEM)
    Dim As _Unsigned Long frameSize
    Dim As _Offset hDIB
    Dim As _Offset pDIB
    Dim As _MEM p
    Dim As _Unsigned Long biSize
    Dim As _MEM pBI
    Dim As BITMAPINFO bi
    Dim As Long bytesPerPixel
    Dim As Long stride
    Dim As _MEM m
    Dim As Long y, x, t
    Dim As _Unsigned _Byte pixel24(0 To 2)
    Dim As _Unsigned _Byte pixel32(0 To 3)
    Dim As _Offset pScanLine
    Dim As _Unsigned Long q
    Dim As Long i
    Dim As Long a

    frameSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    If frameSize = 0 Then
        Print "Failed to get video format size"
        KillDriver hwnd
        End
    End If

    SendMessage hwnd, WM_CAP_EDIT_COPY, 0, 0

    If OpenClipboard(0) = 0 Then
        Print "Couldn't open clipboard"
        KillDriver hwnd
        End
    End If

    hDIB = GetClipboardData(CF_DIB)
    If hDIB = 0 Then
        Print "Failed to retrieve bitmap from clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If

    pDIB = GlobalLock(hDIB)
    If pDIB = 0 Then
        Print "Failed to lock the clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If
   
    CloseClipboard
   
    'Print "Frame retrieved"
   
    p = _Mem(pDIB, 4)
    biSize = _MemGet(p, p.OFFSET, _Unsigned Long)
    pBI = _Mem(pDIB, biSize)
    'Print pBI.SIZE
   
    _MemGet pBI, pBI.OFFSET, bi
    _MemFree pBI
    _MemFree p
    'Print bi.bmiHeader.biWidth
    'Print bi.bmiHeader.biHeight
    'Print bi.bmiHeader.biBitCount
   
    bytesPerPixel = (bi.bmiHeader.biBitCount + 7) \ 8
    'Print bytesPerPixel
   
    stride = (((bi.bmiHeader.biWidth * bi.bmiHeader.biBitCount) + 31) And Not 31) \ 8
    'Print stride
    'Print bi.bmiHeader.biSizeImage
   
    m = _Mem(pDIB + Len(bi), bi.bmiHeader.biSizeImage)
   
    i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
    _Dest i
   
    If bi.bmiHeader.biHeight > 0 Then
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, Abs(bi.bmiHeader.biHeight) - 1 - y), q
            Next x
        Next y
    Else
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, y), q
            Next
        Next
    End If
   
    _Dest 0
    image = _MemImage(i)
    a = GlobalUnlock(pDIB)
End Sub ' GrabFrameToMemory

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if value OriginalString$ is numeric.

' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15

' Version 2 by madscijr
' Returns TRUE (-1) if string is an integer, FALSE (0) if not

' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not

Function IsNumber% (OriginalString$)
    Dim bResult%: bResult% = _FALSE
    Dim iLoop%
    Dim TestString$
    'Dim bNegative%
    Dim iDecimalCount%
    Dim sNextChar$

    'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
    'TestString$ = _TRIM$(OriginalString$)

    If Len(OriginalString$) > 0 Then
        TestString$ = ""
        If Left$(OriginalString$, 1) = "+" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = FALSE
        ElseIf Left$(OriginalString$, 1) = "-" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = TRUE
        Else
            TestString$ = OriginalString$
            'bNegative% = FALSE
        End If
        If Len(TestString$) > 0 Then
            bResult% = _TRUE
            iDecimalCount% = 0
            For iLoop% = 1 To Len(TestString$)
                sNextChar$ = Mid$(TestString$, iLoop%, 1)
                If sNextChar$ = "." Then
                    iDecimalCount% = iDecimalCount% + 1
                    If iDecimalCount% > 1 Then
                        ' TOO MANY DECIMAL POINTS, INVALID!
                        bResult% = _FALSE
                        Exit For
                    End If
                ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
                    ' NOT A NUMERAL OR A DECIMAL, INVALID!
                    bResult% = _FALSE
                    Exit For
                End If
            Next iLoop%
        End If
    End If
    IsNumber% = bResult%
End Function ' IsNumber%

' /////////////////////////////////////////////////////////////////////////////

Sub KillDriver (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
    DestroyWindow hwnd
End Sub ' KillDriver

' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 0-based.
' See also: PrintString1

Sub PrintString (iRow As Integer, iCol As Integer, MyString As String)
    Dim iX As Integer
    Dim iY As Integer
    iX = _FontWidth * iCol
    iY = _FontHeight * iRow ' (iRow + 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintString

' /////////////////////////////////////////////////////////////////////////////
' Print sMessage in fancy alternating colors
' at row RowNum, column StartCol

Sub PrintTitle (RowNum As Integer, StartCol As Integer, sMessage As String)
    Dim ColNum As Integer
    Dim iLoop As Integer
    Dim fgColor~&
    ColNum = StartCol
    For iLoop = 1 To Len(sMessage)
        If fgColor~& = cBlue Then fgColor~& = cRed Else fgColor~& = cBlue
        Color cWhite, fgColor~&
        Locate RowNum, ColNum: Print Mid$(sMessage, iLoop, 1);
        'PrintString RowNum, ColNum, mid$(sMessage, iLoop, 1)
        ColNum = ColNum + 1
    Next iLoop
End Sub ' PrintTitle

' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.

' Note: random-number generator should be initialized with
'       InitializeRandom or Randomize Timer

Function RandomNumber% (Min%, Max%)
    Dim NumSpread%

    '' SET RANDOM SEED
    ''Randomize ' Initialize random-number generator.
    'Randomize Timer

    NumSpread% = (Max% - Min%) + 1
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%

' /////////////////////////////////////////////////////////////////////////////

Sub SaveBMP (hwnd As _Offset, filename As String)
    filename = filename + Chr$(0)
    SendMessage hwnd, WM_CAP_FILE_SAVEDIB, 0, _Offset(filename)
    'SendMessage hwnd, WM_CAP_EDIT_COPY, 0, 0 ' It is now in the clipboard, too Smile
End Sub ' SaveBMP

' /////////////////////////////////////////////////////////////////////////////

Sub SetupDriver (hwnd As _Offset, videoWidth As _Unsigned Long, videoHeight As _Unsigned Long, defaultSource As _Byte)
    SendMessage hwnd, WM_CAP_DRIVER_CONNECT, 0, 0
    SendMessage hwnd, WM_CAP_SET_SCALE, -1, 0
    SendMessage hwnd, WM_CAP_SET_PREVIEWRATE, 1000 / FPS, 0
    SendMessage hwnd, WM_CAP_SET_PREVIEW, -1, 0
    Dim As _Unsigned Long formatSize: formatSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    Dim As BITMAPINFO bmi
    If Len(bmi) <> formatSize Then
        KillDriver hwnd
        Print "Wrong size"
        Print formatSize, Len(bmi)
        End
    End If

    If SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, formatSize, _Offset(bmi)) = 0 Then
        KillDriver hwnd
        Print "Couldn't get format"
        End
    End If
    bmi.bmiHeader.biWidth = videoWidth
    bmi.bmiHeader.biHeight = videoHeight
    bmi.bmiHeader.biBitCount = 16 'yuy2 format
    bmi.bmiHeader.biCompression = mmioStringToFOURCC("YUY2" + Chr$(0), &H00000010) ' MUST BE YUY2 FORMAT
    bmi.bmiHeader.biSizeImage = videoWidth * videoHeight * 2
    If SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, formatSize, _Offset(bmi)) = 0 Then
        KillDriver hwnd
        Print "Failed to set video format"
        End
    End If
    If defaultSource = _FALSE Then
        SendMessage hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0 'PICK YUY2!!!
        SendMessage hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
    End If
End Sub ' SetupDriver

' /////////////////////////////////////////////////////////////////////////////

' ################################################################################################################################################################
' BEGIN COLOR FUNCTIONS #COLOR
' ################################################################################################################################################################

Function cRed~& ()
    cRed = _RGB32(255, 0, 0)
End Function

Function cOrangeRed~& ()
    cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&

Function cDarkOrange~& ()
    cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&

Function cOrange~& ()
    cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&

Function cGold~& ()
    cGold = _RGB32(255, 215, 0)
End Function ' cGold~&

Function cYellow~& ()
    cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&

' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
    cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&

' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
    cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&

Function cLime~& ()
    cLime = _RGB32(0, 255, 0)
End Function ' cLime~&

Function cMediumSpringGreen~& ()
    cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&

' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
    cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&

Function cCyan~& ()
    cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&

Function cDeepSkyBlue~& ()
    cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&

Function cDodgerBlue~& ()
    cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&

Function cSeaBlue~& ()
    cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&

Function cBlue~& ()
    cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&

Function cBluePurple~& ()
    cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&

Function cDeepPurple~& ()
    cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&

Function cPurple~& ()
    cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&

Function cPurpleRed~& ()
    cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&

Function cDarkRed~& ()
    cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&

Function cBrickRed~& ()
    cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&

Function cDarkGreen~& ()
    cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&

Function cGreen~& ()
    cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&

Function cOliveDrab~& ()
    cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&

Function cLightPink~& ()
    cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&

Function cHotPink~& ()
    cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&

Function cDeepPink~& ()
    cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&

Function cMagenta~& ()
    cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&

Function cBlack~& ()
    cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&

Function cDimGray~& ()
    cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&

Function cGray~& ()
    cGray = _RGB32(128, 128, 128)
End Function ' cGray~&

Function cDarkGray~& ()
    cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&

Function cSilver~& ()
    cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&

Function cLightGray~& ()
    cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&

Function cGainsboro~& ()
    cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&

Function cWhiteSmoke~& ()
    cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&

Function cWhite~& ()
    cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&

Function cDarkBrown~& ()
    cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&

Function cLightBrown~& ()
    cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&

Function cKhaki~& ()
    cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&

Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&

' ################################################################################################################################################################
' END COLOR FUNCTIONS @COLOR
' ################################################################################################################################################################

Click OK when you see the Video Format and Video Source popup forms...


Attached Files Image(s)
       
Find
Reply
SpriggsySpriggs Offline
Professional Noticer
*****
Posts: 797
Threads: 35
Joined: Apr 2022
Reputation: 54
#2
9 hours ago
What can I say except HOLY SHIT. That is some amazing stuff. Who knew that the code could end up being this cool?
The noticing will continue
Find
Reply
SpriggsySpriggs Offline
Professional Noticer
*****
Posts: 797
Threads: 35
Joined: Apr 2022
Reputation: 54
#3
8 hours ago
And what better way to show my appreciation than to try it out myself.
The noticing will continue
Find
Reply
SpriggsySpriggs Offline
Professional Noticer
*****
Posts: 797
Threads: 35
Joined: Apr 2022
Reputation: 54
#4
8 hours ago
I think I might have to look into a callback function for doing better loading to memory. It looks like this program has broken my clipboard. I don't think the clipboard was ever intended to be used as a 30 FPS lossless BMP storage.
The noticing will continue
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 817
Threads: 116
Joined: Apr 2022
Reputation: 19
#5
8 hours ago (This post was last modified: 7 hours ago by madscijr.)
(9 hours ago)SpriggsySpriggs Wrote: What can I say except HOLY SHIT. That is some amazing stuff. Who knew that the code could end up being this cool?

You did the hard part! I'm interested in seeing what kind of uses the other peeps will come up with...

(8 hours ago)SpriggsySpriggs Wrote: And what better way to show my appreciation than to try it out myself.

Ha! I'm honored to have a video, LoL! Great way to demo not just the app but its shortcomings! Yeah, I tested it by getting out of the way of the camera and just putting my hand in the picture on one side or the other (a pen or other object was more accurate). It's not quite smart enough to handle someone just sitting there moving their arms unless they stay perfectly still in the middle (or hunch down so your head is below the lowest spot). I have my laptop connected to an external display "show only on display 2", though the laptop's open so the camera can see. There's a lot that can be improved - the devil's in the details!
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 817
Threads: 116
Joined: Apr 2022
Reputation: 19
#6
7 hours ago
(8 hours ago)SpriggsySpriggs Wrote: I think I might have to look into a callback function for doing better loading to memory. It looks like this program has broken my clipboard. I don't think the clipboard was ever intended to be used as a 30 FPS lossless BMP storage.
Oh wow, I haven't tried using the clipboard while the program was running, but every time it exits the clipboard works, because I constantly used it when updating the code. 

One thing I was gonna ask was, how might those two dialogs that open at the beginning be auto-filled or otherwise hidden? Windows API functions are so mysterious!
Find
Reply
SpriggsySpriggs Offline
Professional Noticer
*****
Posts: 797
Threads: 35
Joined: Apr 2022
Reputation: 54
#7
5 hours ago
(7 hours ago)madscijr Wrote:
(8 hours ago)SpriggsySpriggs Wrote: I think I might have to look into a callback function for doing better loading to memory. It looks like this program has broken my clipboard. I don't think the clipboard was ever intended to be used as a 30 FPS lossless BMP storage.
Oh wow, I haven't tried using the clipboard while the program was running, but every time it exits the clipboard works, because I constantly used it when updating the code. 

One thing I was gonna ask was, how might those two dialogs that open at the beginning be auto-filled or otherwise hidden? Windows API functions are so mysterious!

You gotta toggle that _TRUE/_FALSE flag in the SetupDriver call, my dude.
The noticing will continue
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 817
Threads: 116
Joined: Apr 2022
Reputation: 19
#8
5 hours ago (This post was last modified: 5 hours ago by madscijr.)
Seeing @SpriggsySpriggs wanting to control both sides while sitting dead center made me add a setting 
CONST DETECT_WIDTH = 40
at line 38. 

This controls the number of pixels from the left side and the right side of the screen the program watches for input for the respective sides. 

I found that 40 pixels seemed to be a good value for comfortably sitting a couple feet away from the laptop (but still within arm's reach of the keyboard). 

Once you're centered and arm's length from the camera, be sure to press Enter 2 times (keeping your arms away from the right & left edges while you do so) to re-calibrate and re-enable ShowCamera.

I also added the missing _FREEIMAGE lines!

Here is v0.03:

Code: (Select All)
' Webcam Pong by Madscijr (alpha version)
' Thanks to SpriggsySpriggs for figuring out how to program the webcam

' TODO:
' * Auto-fill & hide the Video Format & Video Source forms that open in the beginning
' * Enable clipboard while the program is running?
' * Enable program to lose and regain focus gracefully?

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' USB Camera? Reply #26 > Help Me! > Code and Stuff > QB64 Rising > QB64 Phoenix Edition
' https://qb64phoenix.com/forum/showthread.php?tid=1163&pid=32337#pid32337
' From: SpriggsySpriggs, Professional Noticer
' Date: 2/26/2025 2:48 PM
' Now you can export straight to memory, mi amigo.
' It should be noted that it has to export to clipboard first and then load to memory.
' So your clipboard will contain the image as well. But that's the nature of the beast.
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' USB Camera? Reply #28 > Help Me! > Code and Stuff > QB64 Rising > QB64 Phoenix Edition
' https://qb64phoenix.com/forum/showthread.php?tid=1163&pid=32339#pid32339
' From: SpriggsySpriggs, Professional Noticer
' Date: 2/26/2025 4:01 PM
' Q: I wonder if there's a way to change camera resolution at the API or software level?
' A: YES! If you want to change the settings first, use this code:
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

Option _Explicit
_Title "Webcam API Test - Parent"

' ================================================================================================================================================================
' CONSTANTS
' ================================================================================================================================================================
Const FPS = 30 ' Not recommended to set this higher than frame rate of webcam/video device

Const MOVEMENT_THRESHOLD = 160

Const CAMERA_WIDTH = 320
Const CAMERA_HEIGHT = 240
Const DETECT_WIDTH = 40 ' # pixels from right/left edges of screen to scan for movement

Const WS_VISIBLE = &H10000000 '  The window is initially visible.
Const WS_MAXIMIZE = &H1000000 ' The window is initially maximized.
Const WS_MINIMIZE = &H20000000 ' The window is initially minimized.

Const CF_DIB = &H0008

' Capture Driver Constants
Const WM_CAP_START = &H0400
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61
Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41

Const LONG_MIN = -2147483648
Const LONG_MAX = 2147483647

' ================================================================================================================================================================
' UDTs
' ================================================================================================================================================================
Type BITMAPINFOHEADER
    As _Unsigned Long biSize
    As Long biWidth, biHeight
    As _Unsigned Integer biPlanes, biBitCount
    As _Unsigned Long biCompression, biSizeImage
    As Long biXPelsPerMeter, biYPelsPerMeter
    As _Unsigned Long biClrUsed, biClrImportant
End Type

Type BITMAPINFO
    As BITMAPINFOHEADER bmiHeader
End Type

' HOLDS DISPLAY LAYERS (ALL NEED _FREEIMAGE WHEN PROGRAM ENDS)
Type GraphicsType
    imgBackground As Long ' background image
    imgCamera As Long
    imgWalls As Long
    imgStaticText As Long '
    imgDynamicText As Long
    imgSprites As Long
End Type ' GraphicsType

' HOLDS VALUES FOR OPERATING WEBCAM
Type WebcamType
    captureWinText As String
    childID As _Offset
    vidWidth As _Unsigned Long
    vidHeight As _Unsigned Long
    childWin As _Offset
    m As _MEM
    CaptureWindowStyle As _Unsigned Long
End Type ' WebcamType

' HOLDS PLAYER COORDINATES AND INFO
Type PlayerType
    color As _Unsigned Long
    x As Long
    y As Long
    width As Integer
    height As Integer
    score As Integer
    Visible As Integer
End Type ' PlayerType

' HOLDS BALL COORDINATES AND INFO
Type BallType
    color As _Unsigned Long
    size As Integer
    x As Long
    y As Long
    dx As Integer
    dy As Integer
    Visible As Integer
End Type ' BallType

' HOLDS RGB VALUES FOR A PIXEL
Type PixelType
    r As Long
    g As Long
    b As Long
End Type ' PixelType

' ================================================================================================================================================================
' API DEFINITIONS
' ================================================================================================================================================================
Declare CustomType Library
    Sub SendMessage Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Function SendMessage& Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
    Sub DestroyWindow (ByVal hWnd As _Offset)
    Function GetAsyncKeyState% (ByVal vKey As Long)
    Function mmioStringToFOURCC& (sz As String, ByVal uFlags As _Unsigned Long)
    Function OpenClipboard& (ByVal hWndNewOwner As _Offset)
    Function GetClipboardData%& (ByVal uFormat As _Unsigned Long)
    Sub CloseClipboard ()
    Function GlobalLock%& (ByVal hMem As _Offset)
    Function GlobalUnlock& (ByVal hMem As _Offset)
End Declare

Declare Dynamic Library "Avicap32"
    Function CreateCaptureWindow& Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As _Offset, ByVal dwStyle As _Unsigned Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As _Offset, ByVal nId As Long)
End Declare

' ================================================================================================================================================================
' GLOBAL VARIABLES
' ================================================================================================================================================================
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' GLOBAL VARIABLES TO TRACK ERROR STATE
Dim Shared m_ErrorMessage As String: m_ErrorMessage = ""
'Dim Shared m_RoutineName As String: m_RoutineName = ""
'Dim Shared m_LastStatement As String: m_LastStatement = ""

' GLOBAL VARIABLES FOR SCREEN
Dim Shared m_iScreenWidth As Long: m_iScreenWidth = 1024 ' _DesktopWidth
Dim Shared m_iScreenHeight As Long: m_iScreenHeight = 768 ' _DesktopHeight
Dim Shared m_iTextRows As Long: m_iTextRows = (m_iScreenHeight / _FontHeight)
Dim Shared m_iTextCols As Long: m_iTextCols = (m_iScreenWidth / _FontWidth)
Dim Shared PLAYER_HEIGHT As Long: PLAYER_HEIGHT = 32
Dim Shared MIN_Y As Long: MIN_Y = 44 + 1
Dim Shared MAX_Y As Long: MAX_Y = (m_iScreenHeight - 54) - (PLAYER_HEIGHT + 1)

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' START THE MAIN ROUTINE
main

' FINISH
Print m_ProgramName$ + " finished."

'End
System ' return control to the operating system

' ================================================================================================================================================================
' ROUTINES
' ================================================================================================================================================================

' /////////////////////////////////////////////////////////////////////////////
' MAIN PROGRAM

Sub main
    Dim Graph1 As GraphicsType
    Dim WebCam As WebcamType
    ReDim arrPlayer(1 To 2) As PlayerType ' 1 = left, 2 = right
    ReDim arrComparePixels(CAMERA_WIDTH, CAMERA_HEIGHT) As PixelType
    Dim Ball1 As BallType
    Dim x, y As Integer
    Dim iValue As Integer
    Dim IsCalibrating As Integer
    Dim ShowCamera As Integer
   
    ' INIT SCREEN
    Screen _NewImage(m_iScreenWidth, m_iScreenHeight, 32)
    _ScreenMove 0, 0
   
    ' Show initial detailed instructions
    Cls
    Print "Webcam Pong, a 'computer vision' experiment, v0.01"
    Print "by madscijr, webcam code by spriggsyspriggs"
    Print
    Print "At 'Video Format' popup, values should say:"
    Print "    Resolution                        : 320x240"
    Print "    Pixel Depth (bits) and Compression: YUY2"
    Print "    Size (bytes)                      : 153600"
    Print "Do not change these values, just click [OK]"
    Print
    Print "At 'Video Source' popup, values should say:"
    Print "    Select a Video Device: {your camera name}"
    Print "Click [OK]"
    Print
    Print "1 window should open:"
    Print "    Webcam API Test - Parent"
    Print
    Print "And this window hidden (maybe visible in Task Manager):"
    Print "    Webcam API Test - Child"
    Print
    Print "Point webcam at an empty room or down at a blank sheet of paper,"
    Print "away from you and your friends, and anything that's moving."
    Print "Press Enter to 'calibrate', where program memorizes the room."
    Print "Enter also toggles the camera picture on and off,"
    Print "with the camera on, you can see yourself moving around."
    Print "Try moving something up and down along the left half of the screen,"
    Print "that controls the left paddle. Right half of screen = right paddle."
    Print
    Print "Per SpriggsySpriggs:"
    Print "DO NOT GO CLICKING ALL WILLY-NILLY ON THE PROGRAM WINDOW,"
    Print "ESPECIALLY IF YOUR CURSOR HAS THE LOADING CIRCLE/HOURGLASS."
    Print "For some reason, this will cause it to freeze and crash."
    Print "Why? 'cause Microsoft, that's why."
    Print
    Print "Also note that this version has the following QUIRKS while running:"
    Print "* clipboard is not available in other programs"
    Print "* when changing focus to another program, to switch back, you must minimize the other program for this to be visible again"
    Print
    Print "Press any key to start..."
    Sleep
    _KeyClear: '_DELAY 1 ' clear keyboard buffer

    ' CLEAR THE SCREEN
    _Dest 0: Cls , cEmpty
    _Display ' update screen with changes & wait for next update

    ' INITIALIZE SCREEN
    InitGraphicLayers Graph1
    DrawInstructionsLayer Graph1

    ' SET LOWER CAMERA RESOLUTION
    WebCam.vidWidth = CAMERA_WIDTH
    WebCam.vidHeight = CAMERA_HEIGHT

    ' CREATE CAPTURE WINDOW (HIDDEN)
    WebCam.captureWinText = "Webcam API Test - Child" + Chr$(0)
    WebCam.CaptureWindowStyle = WS_MINIMIZE ' WS_VISIBLE
    WebCam.childWin = CreateCaptureWindow(_Offset(WebCam.captureWinText), WebCam.CaptureWindowStyle, 0, 0, WebCam.vidWidth, WebCam.vidHeight, _WindowHandle, WebCam.childID)

    ' Initialize the driver
    SetupDriver WebCam.childWin, WebCam.vidWidth, WebCam.vidHeight, _FALSE ' change _FALSE to _TRUE to use default settings
   
    ' INIT PLAYERS
    arrPlayer(1).color = cRed
    arrPlayer(1).x = 64
    arrPlayer(1).y = m_iScreenHeight / 2
    arrPlayer(1).width = 8
    arrPlayer(1).height = 32
    arrPlayer(1).score = 0
    arrPlayer(1).Visible = _FALSE
   
    arrPlayer(2).color = cBlue
    arrPlayer(2).x = m_iScreenWidth - 64
    arrPlayer(2).y = m_iScreenHeight / 2
    arrPlayer(2).width = 8
    arrPlayer(2).height = 32
    arrPlayer(2).score = 0
    arrPlayer(2).Visible = _FALSE
   
    ' INIT BALL
    Ball1.color = cWhite
    Ball1.size = 8
    Ball1.x = m_iScreenWidth / 2
    Ball1.y = m_iScreenHeight / 2
    Ball1.Visible = _FALSE
   
    ' RANDOM BALL DIRECTION
    Randomize Timer
    If RandomNumber%(1, 2) = 1 Then
        Ball1.dx = -1
    Else
        Ball1.dx = 1
    End If
    iValue = RandomNumber%(1, 3)
    If iValue = 1 Then
        Ball1.dy = -1
    Else
        If iValue = 2 Then
            Ball1.dy = 0
        Else
            Ball1.dy = 1
        End If
    End If
   
    ' Capture a single frame to window WebCam.childWin
    IsCalibrating = _TRUE
    ShowCamera = _TRUE
    Do
        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' READ KEYBOARD
        ' GetAsyncKeyState is necessary because the capture window steals keyboard focus
       
        ' ENTER = RECALIBRATE + SHOW CAMERA FRAME
        ' PRESSING  ENTER AGAIN HIDES CAMERA FRAME
        If GetAsyncKeyState(&H0D) <> 0 Then ' user pressed Enter
            If ShowCamera = _FALSE Then
                ShowCamera = _TRUE
                IsCalibrating = _TRUE
            Else
                ShowCamera = _FALSE
            End If
        End If
       
        ' ESC = QUIT
        If GetAsyncKeyState(&H1B) <> 0 Then ' user pressed Escape
            KillDriver WebCam.childWin
            Exit Do
        End If
       
        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
        ' CAPTURE FRAME WITH WEBCAM
       
        ' Get still picture from camera to frame
        GrabFrame WebCam.childWin
       
        ' Copy frame from WebCam.childWin to image in memory
        GrabFrameToMemory WebCam.childWin, WebCam.m
       
        ' Remember background (to compare to detect movement)
        If IsCalibrating = _TRUE Then
            SaveFrame WebCam.m.IMAGE, arrComparePixels()
            IsCalibrating = _FALSE
        End If
       
        ' Detect movement with the camera (computer vision)
        DetectMovement WebCam.m.IMAGE, arrComparePixels(), arrPlayer()
       
        ' Display the image
        DrawCameraLayer Graph1, WebCam.m.IMAGE, ShowCamera
        'Screen WebCam.m.IMAGE
       
        ' Draw walls layer
        DrawWallsLayer Graph1
       
        ' Draw sprites layer
        DrawSpritesLayer Graph1, arrPlayer(), Ball1
       
        ' Draw
        DrawDynamicTextLayer Graph1, arrPlayer(), ShowCamera
       
        ' COPY LAYERS TO SCREEN AND UPDATE DISPLAY
        RenderScreen Graph1
       
        ' Keep at steady frames per second
        _Limit FPS
    Loop
   
    ' RETURN TO AUTODISPLAY
    _AutoDisplay
    Cls
   
    ' Disconnect driver
    Print "Disconnecting driver"
    KillDriver WebCam.childWin
   
    ' Free memory
    Print "Freeing memory"
    _MemFree WebCam.m
   
    ' Free images
    Print "Freeing images"
    FreeImage Graph1.imgBackground
    FreeImage Graph1.imgCamera
    FreeImage Graph1.imgWalls
    FreeImage Graph1.imgStaticText
    FreeImage Graph1.imgDynamicText
    FreeImage Graph1.imgSprites
   
    '' RESUME NORMAL ERROR TRAPPING
    'On Error GoTo 0
   
End Sub ' main

' /////////////////////////////////////////////////////////////////////////////
' COMPARE PIXELS IN CAMERA FRAME AGAINST WHAT IT SAW AT BEGINNING

Sub DetectMovement (imgCamera As Long, arrComparePixels() As PixelType, arrPlayer() As PlayerType)
    Dim iPlayer As Integer
    Dim x As Integer
    Dim y As Integer
    Dim c&
    Dim dr&, dg&, db&
   
    ' LOOK FOR PLAYER 1 IN LEFT HALF OF CAMERA FRAME
    iPlayer = 1
    arrPlayer(iPlayer).Visible = _FALSE
    _Source imgCamera
    'For x = (CAMERA_WIDTH - 1) To (CAMERA_WIDTH / 2) Step -1
    For x = (CAMERA_WIDTH - 1) To (CAMERA_WIDTH - 1) - DETECT_WIDTH Step -1
        For y = 1 To (CAMERA_HEIGHT - 1)
            ' COMPARE AGAINST ORIGINAL PIXEL
            c& = Point(x, y)
            dr& = Abs(arrComparePixels(x, y).r - _Red32(c&))
            dg& = Abs(arrComparePixels(x, y).g - _Green32(c&))
            db& = Abs(arrComparePixels(x, y).b - _Blue32(c&))
            '_Alpha32(c&)
           
            ' DID IT CHANGE ENOUGH?
            If (dr& + dg& + db&) > MOVEMENT_THRESHOLD Then
                'arrPlayer(iPlayer).x = x
                arrPlayer(iPlayer).y = y * (m_iScreenHeight / CAMERA_HEIGHT)
               
                'NO:
                '' Y has to be reversed (up is down & down is up)
                'arrPlayer(iPlayer).y = m_iScreenHeight - (y * (m_iScreenHeight / CAMERA_HEIGHT))
               
                ' Keep within boundaries
                If arrPlayer(iPlayer).y < MIN_Y Then
                    arrPlayer(iPlayer).y = MIN_Y
                ElseIf arrPlayer(iPlayer).y > MAX_Y Then
                    arrPlayer(iPlayer).y = MAX_Y
                End If
               
                ' Done looking
                arrPlayer(iPlayer).Visible = _TRUE
                Exit For
            End If
        Next y
        If arrPlayer(iPlayer).Visible = _TRUE Then
            Exit For
        End If
    Next x
   
    ' LOOK FOR PLAYER 2 IN RIGHT HALF OF CAMERA FRAME
    iPlayer = 2
    arrPlayer(iPlayer).Visible = _FALSE
    _Source imgCamera
    'For x = 1 To (CAMERA_WIDTH / 2)
    For x = 1 To DETECT_WIDTH
        For y = 1 To (CAMERA_HEIGHT - 1)
            ' COMPARE AGAINST ORIGINAL PIXEL
            c& = Point(x, y)
            dr& = Abs(arrComparePixels(x, y).r - _Red32(c&))
            dg& = Abs(arrComparePixels(x, y).g - _Green32(c&))
            db& = Abs(arrComparePixels(x, y).b - _Blue32(c&))
            '_Alpha32(c&)
           
            ' DID IT CHANGE ENOUGH?
            If (dr& + dg& + db&) > MOVEMENT_THRESHOLD Then
                'arrPlayer(iPlayer).x = x
                arrPlayer(iPlayer).y = y * (m_iScreenHeight / CAMERA_HEIGHT)
               
                'NO:
                '' Y has to be reversed (up is down & down is up)
                'arrPlayer(iPlayer).y = m_iScreenHeight - (y * (m_iScreenHeight / CAMERA_HEIGHT))
               
                ' Keep within boundaries
                If arrPlayer(iPlayer).y < MIN_Y Then
                    arrPlayer(iPlayer).y = MIN_Y
                ElseIf arrPlayer(iPlayer).y > MAX_Y Then
                    arrPlayer(iPlayer).y = MAX_Y
                End If
               
                ' Done looking
                arrPlayer(iPlayer).Visible = _TRUE
                Exit For
            End If
        Next y
        If arrPlayer(iPlayer).Visible = _TRUE Then
            Exit For
        End If
    Next x
   
End Sub ' DetectMovement

' /////////////////////////////////////////////////////////////////////////////
' SAVE RGB OF EACH PIXEL CAMERA SEES BEFORE PLAYERS USE HANDS/LASERS

Sub SaveFrame (imgCamera As Long, arrComparePixels() As PixelType)
    Dim x As Integer
    Dim y As Integer
    Dim c&, r&, g&, b&
    'Dim a&
   
    _Source imgCamera
    For y = 1 To CAMERA_HEIGHT
        For x = 1 To CAMERA_WIDTH
            c& = Point(x, y)
            arrComparePixels(x, y).r = _Red32(c&)
            arrComparePixels(x, y).g = _Green32(c&)
            arrComparePixels(x, y).b = _Blue32(c&)
            'arrComparePixels(x, y).a = _Alpha32(c&)
        Next x
    Next y
End Sub ' SaveFrame

' /////////////////////////////////////////////////////////////////////////////

Sub InitGraphicLayers (Graph1 As GraphicsType)
    ' BACKGROUND = SOLID BLACK
    InitImage Graph1.imgBackground, m_iScreenWidth, m_iScreenHeight, cBlack
   
    ' CAMERA LAYER
    InitImage Graph1.imgCamera, m_iScreenWidth, m_iScreenHeight, cEmpty
   
    ' WALLS LAYER
    InitImage Graph1.imgWalls, m_iScreenWidth, m_iScreenHeight, cEmpty
   
    ' STATIC TEXT (TITLE, INSTRUCTIONS, ETC.)
    InitImage Graph1.imgStaticText, m_iScreenWidth, m_iScreenHeight, cEmpty
   
    ' CONSTANTLY UPDATED TEXT (SCORE, LIVES, ETC.)
    InitImage Graph1.imgDynamicText, m_iScreenWidth, m_iScreenHeight, cEmpty
   
    ' HOLDS SPRITES
    InitImage Graph1.imgSprites, m_iScreenWidth, m_iScreenHeight, cEmpty
End Sub ' InitGraphicLayers

' /////////////////////////////////////////////////////////////////////////////

Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)
    If ThisImage& = -1 Or ThisImage& = 0 Then
        ThisImage& = _NewImage(iWidth&, iHeight&, 32)
        _Dest ThisImage&: Cls , bgColor~&
    End If
End Sub ' InitImage

' /////////////////////////////////////////////////////////////////////////////

Sub FreeImage (ThisImage&)
    If ThisImage& < -1 Or ThisImage& > 0 Then _FreeImage ThisImage&
End Sub ' FreeImage

' /////////////////////////////////////////////////////////////////////////////

Sub DrawCameraLayer (Graph1 As GraphicsType, imgCamera As Long, ShowCamera As Integer)
    Dim dx1, dx2, dy1, dy2 As Integer
   
    _Dest Graph1.imgCamera: Cls , cEmpty
    If ShowCamera = _TRUE Then
        ' Camera image is flipped horizontally (like looking in a mirror)
        '_PutImage ((m_iScreenWidth - CAMERA_WIDTH) / 2, (m_iScreenHeight - CAMERA_HEIGHT) / 2), imgCamera
       
        ' Per: https://qb64phoenix.com/qb64wiki/index.php/PUTIMAGE
        ' To flip the image on the x axis, swap the dx coordinate values:
        ' e.g., _PUTIMAGE (dx2, dy1)-(dx1, dy2), source_handle, dest_handle
        dx1 = (m_iScreenWidth - CAMERA_WIDTH) / 2
        dy1 = (m_iScreenHeight - CAMERA_HEIGHT) / 2
        dx2 = dx1 + CAMERA_WIDTH
        dy2 = dy1 + CAMERA_HEIGHT
        _PutImage (dx2, dy1)-(dx1, dy2), imgCamera, Graph1.imgCamera
       
    End If
End Sub ' DrawCameraLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW THE INSTRUCTIONS LAYER

Sub DrawInstructionsLayer (Graph1 As GraphicsType)
    Dim sMessage As String
    Dim iCol As Integer
   
    _Dest Graph1.imgStaticText: Cls , cEmpty
   
    ' ROW 1: TITLE
    'Color cWhite, cEmpty
    sMessage = "Webcam computer vision Pong"
    iCol = (m_iTextCols / 2) - (Len(sMessage) / 2) ' CENTERED TEXT
    PrintTitle 1, iCol, sMessage
   
    ' ROW 47: INSTRUCTIONS
    iCol = 1
    sMessage = "POINT WEBCAM AT EMPTY ROOM OR WHITE SHEET OF PAPER"
    'iCol = (((m_iTextCols / 3) / 2) - (Len(sMessage) / 2)) ' LEFT THIRD
    Color cBlack, cWhite
    Locate 47, iCol: Print sMessage;
   
    ' ROW 48: INSTRUCTIONS
    iCol = 1
    sMessage = "PRESS ENTER TO CALIBRATE + SHOW/HIDE CAMERA"
    'iCol = (((m_iTextCols / 3) / 2) - (Len(sMessage) / 2)) ' LEFT THIRD
    Color cBlack, cLime
    Locate 48, iCol: Print sMessage;
   
    iCol = iCol + Len(sMessage) + 2
    sMessage = "MOVE HAND UP & DOWN ALONG LEFT AND RIGHT EDGES"
    'iCol = ((m_iTextCols / 2) - (Len(sMessage) / 2)) ' MIDDLE THIRD
    Color cWhite, cRed
    Locate 48, iCol: Print sMessage;
   
    iCol = iCol + Len(sMessage) + 2
    sMessage = "PRESS [ESC] TO EXIT"
    'iCol = (m_iTextCols - ((m_iTextCols / 3) / 2)) - (Len(sMessage) / 2) ' RIGHT THIRD
    Color cWhite, cBlue
    Locate 48, iCol: Print sMessage;
   
End Sub ' DrawInstructionsLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW NON-MOVING STUFF

Sub DrawWallsLayer (Graph1 As GraphicsType)
    Dim iLoop As Integer
    Dim x1, y1, x2, y2 As Integer
   
    ' CLEAR LAYER
    _Dest Graph1.imgWalls: Cls , cEmpty
   
    ' DRAW WALLS
    x1 = 1: y1 = 40: x2 = m_iScreenWidth: y2 = 44
    Line (x1, y1)-(x2, y2), cWhite, BF
    x1 = 1: y1 = m_iScreenHeight - 54: x2 = m_iScreenWidth: y2 = m_iScreenHeight - 50
    Line (x1, y1)-(x2, y2), cWhite, BF
   
    ' DRAW THE NET
    For iLoop = 44 To (m_iScreenHeight - 48) Step 20
        Line ((m_iScreenWidth / 2) - 2, iLoop)-((m_iScreenWidth / 2) + 2, iLoop + 10), cWhite, BF
    Next iLoop
End Sub ' DrawWallsLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW THE SCORE LAYER
' TEXT SCREEN AT 1024 x  768 = 128 x 48 (m_iTextCols x m_iTextRows)

Sub DrawDynamicTextLayer (Graph1 As GraphicsType, arrPlayer() As PlayerType, ShowCamera As Integer)
    Dim y
   
    _Dest Graph1.imgDynamicText: Cls , cEmpty
   
    ' SHOW SCORES
    Color cCyan, cEmpty: Locate 2, 32
    Print _Trim$(Str$(arrPlayer(1).score))
   
    Color cLightPink, cEmpty: Locate 2, 96
    Print _Trim$(Str$(arrPlayer(2).score))
   
    ' SHOW POSITIONS
    If arrPlayer(1).Visible = _TRUE Then
        Color cCyan, cEmpty: Locate 37, 32
        Print "Player 1: x=" + _Trim$(Str$(arrPlayer(1).x)) + " y=" + _Trim$(Str$(arrPlayer(1).y))
    End If
    If arrPlayer(2).Visible = _TRUE Then
        Color cLightPink, cEmpty: Locate 37, 96
        Print "Player 2: x=" + _Trim$(Str$(arrPlayer(2).x)) + " y=" + _Trim$(Str$(arrPlayer(2).y))
    End If
   
    ' SHOW OTHER
    If ShowCamera = _TRUE Then
        'y = ( ( (m_iScreenHeight - CAMERA_HEIGHT) / 2 ) / _FontHeight) - _FontHeight
        'color cBlack, cYellow : Locate y, 60
        Color cBlack, cYellow: Locate 16, 60
        Print "ShowCamera = _TRUE"
    End If
End Sub ' DrawDynamicTextLayer

' /////////////////////////////////////////////////////////////////////////////
' DRAW SPRITES (PLAYERS + BALL)

Sub DrawSpritesLayer (Graph1 As GraphicsType, arrPlayer() As PlayerType, Ball1 As BallType)
    _Dest Graph1.imgSprites: Cls , cEmpty
   
    ' If players are visible draw a box at the locations
    If arrPlayer(1).Visible = _TRUE Then
        DrawRectSolid arrPlayer(1).x, arrPlayer(1).y, arrPlayer(1).width, arrPlayer(1).height, arrPlayer(1).color
    End If
    If arrPlayer(2).Visible = _TRUE Then
        DrawRectSolid arrPlayer(2).x, arrPlayer(2).y, arrPlayer(2).width, arrPlayer(2).height, arrPlayer(2).color
    End If
   
    ' If ball is visible, draw it
    If Ball1.Visible = _TRUE Then
        DrawRectSolid Ball1.x, Ball1.y, Ball1.size, Ball1.size, Ball1.color
    End If
End Sub ' DrawSpritesLayer

' /////////////////////////////////////////////////////////////////////////////
' COPY LAYERS TO SCREEN AND UPDATE DISPLAY

Sub RenderScreen (Graph1 As GraphicsType)
    ' CLEAR THE SCREEN
    _Dest 0: Cls , cEmpty
   
    ' Add the background
    _PutImage , Graph1.imgBackground, 0
   
    ' Add the camera image
    _PutImage , Graph1.imgCamera, 0
   
    ' Add the walls
    _PutImage , Graph1.imgWalls, 0
   
    ' Add the instructions
    _PutImage , Graph1.imgStaticText, 0
   
    ' Add the score
    _PutImage , Graph1.imgDynamicText, 0
   
    ' Add the sprites
    _PutImage , Graph1.imgSprites, 0
   
    ' update screen with changes
    _Display
End Sub ' RenderScreen

' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D RECTANGLE (SOLID)

Sub DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)
    Line (iX, iY)-(iX + iSizeW, iY + iSizeH), fgColor, BF ' Draw a solid rectangle
End Sub ' DrawRectSolid

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrame (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End Sub ' GrabFrame

' /////////////////////////////////////////////////////////////////////////////

Sub GrabFrameToMemory (hwnd As _Offset, image As _MEM)
    Dim As _Unsigned Long frameSize
    Dim As _Offset hDIB
    Dim As _Offset pDIB
    Dim As _MEM p
    Dim As _Unsigned Long biSize
    Dim As _MEM pBI
    Dim As BITMAPINFO bi
    Dim As Long bytesPerPixel
    Dim As Long stride
    Dim As _MEM m
    Dim As Long y, x, t
    Dim As _Unsigned _Byte pixel24(0 To 2)
    Dim As _Unsigned _Byte pixel32(0 To 3)
    Dim As _Offset pScanLine
    Dim As _Unsigned Long q
    Dim As Long i
    Dim As Long a

    frameSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    If frameSize = 0 Then
        Print "Failed to get video format size"
        KillDriver hwnd
        End
    End If

    SendMessage hwnd, WM_CAP_EDIT_COPY, 0, 0

    If OpenClipboard(0) = 0 Then
        Print "Couldn't open clipboard"
        KillDriver hwnd
        End
    End If

    hDIB = GetClipboardData(CF_DIB)
    If hDIB = 0 Then
        Print "Failed to retrieve bitmap from clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If

    pDIB = GlobalLock(hDIB)
    If pDIB = 0 Then
        Print "Failed to lock the clipboard"
        CloseClipboard
        KillDriver hwnd
        End
    End If
   
    CloseClipboard
   
    'Print "Frame retrieved"
   
    p = _Mem(pDIB, 4)
    biSize = _MemGet(p, p.OFFSET, _Unsigned Long)
    pBI = _Mem(pDIB, biSize)
    'Print pBI.SIZE
   
    _MemGet pBI, pBI.OFFSET, bi
    _MemFree pBI
    _MemFree p
    'Print bi.bmiHeader.biWidth
    'Print bi.bmiHeader.biHeight
    'Print bi.bmiHeader.biBitCount
   
    bytesPerPixel = (bi.bmiHeader.biBitCount + 7) \ 8
    'Print bytesPerPixel
   
    stride = (((bi.bmiHeader.biWidth * bi.bmiHeader.biBitCount) + 31) And Not 31) \ 8
    'Print stride
    'Print bi.bmiHeader.biSizeImage
   
    m = _Mem(pDIB + Len(bi), bi.bmiHeader.biSizeImage)
   
    i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
    _Dest i
   
    If bi.bmiHeader.biHeight > 0 Then
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, Abs(bi.bmiHeader.biHeight) - 1 - y), q
            Next x
        Next y
    Else
        For y = 0 To Abs(bi.bmiHeader.biHeight) - 1
            pScanLine = m.OFFSET + (y * stride)
            For x = 0 To bi.bmiHeader.biWidth - 1
                If bi.bmiHeader.biBitCount = 24 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel24()
                    q = _RGB32(pixel24(2), pixel24(1), pixel24(0))
                ElseIf bi.bmiHeader.biBitCount = 32 Then
                    _MemGet m, pScanLine + (x * bytesPerPixel), pixel32()
                    q = _RGBA32(pixel32(2), pixel32(1), pixel32(0), pixel32(3))
                Else
                    q = _RGB32(255, 255, 255)
                End If
                PSet (x, y), q
            Next
        Next
    End If
   
    _Dest 0
    image = _MemImage(i)
    a = GlobalUnlock(pDIB)
End Sub ' GrabFrameToMemory

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if value OriginalString$ is numeric.

' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15

' Version 2 by madscijr
' Returns TRUE (-1) if string is an integer, FALSE (0) if not

' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not

Function IsNumber% (OriginalString$)
    Dim bResult%: bResult% = _FALSE
    Dim iLoop%
    Dim TestString$
    'Dim bNegative%
    Dim iDecimalCount%
    Dim sNextChar$

    'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
    'TestString$ = _TRIM$(OriginalString$)

    If Len(OriginalString$) > 0 Then
        TestString$ = ""
        If Left$(OriginalString$, 1) = "+" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = FALSE
        ElseIf Left$(OriginalString$, 1) = "-" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = TRUE
        Else
            TestString$ = OriginalString$
            'bNegative% = FALSE
        End If
        If Len(TestString$) > 0 Then
            bResult% = _TRUE
            iDecimalCount% = 0
            For iLoop% = 1 To Len(TestString$)
                sNextChar$ = Mid$(TestString$, iLoop%, 1)
                If sNextChar$ = "." Then
                    iDecimalCount% = iDecimalCount% + 1
                    If iDecimalCount% > 1 Then
                        ' TOO MANY DECIMAL POINTS, INVALID!
                        bResult% = _FALSE
                        Exit For
                    End If
                ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
                    ' NOT A NUMERAL OR A DECIMAL, INVALID!
                    bResult% = _FALSE
                    Exit For
                End If
            Next iLoop%
        End If
    End If
    IsNumber% = bResult%
End Function ' IsNumber%

' /////////////////////////////////////////////////////////////////////////////

Sub KillDriver (hwnd As _Offset)
    SendMessage hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
    DestroyWindow hwnd
End Sub ' KillDriver

' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 0-based.
' See also: PrintString1

Sub PrintString (iRow As Integer, iCol As Integer, MyString As String)
    Dim iX As Integer
    Dim iY As Integer
    iX = _FontWidth * iCol
    iY = _FontHeight * iRow ' (iRow + 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintString

' /////////////////////////////////////////////////////////////////////////////
' Print sMessage in fancy alternating colors
' at row RowNum, column StartCol

Sub PrintTitle (RowNum As Integer, StartCol As Integer, sMessage As String)
    Dim ColNum As Integer
    Dim iLoop As Integer
    Dim fgColor~&
    ColNum = StartCol
    For iLoop = 1 To Len(sMessage)
        If fgColor~& = cBlue Then fgColor~& = cRed Else fgColor~& = cBlue
        Color cWhite, fgColor~&
        Locate RowNum, ColNum: Print Mid$(sMessage, iLoop, 1);
        'PrintString RowNum, ColNum, mid$(sMessage, iLoop, 1)
        ColNum = ColNum + 1
    Next iLoop
End Sub ' PrintTitle

' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.

' Note: random-number generator should be initialized with
'       InitializeRandom or Randomize Timer

Function RandomNumber% (Min%, Max%)
    Dim NumSpread%

    '' SET RANDOM SEED
    ''Randomize ' Initialize random-number generator.
    'Randomize Timer

    NumSpread% = (Max% - Min%) + 1
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%

' /////////////////////////////////////////////////////////////////////////////

Sub SaveBMP (hwnd As _Offset, filename As String)
    filename = filename + Chr$(0)
    SendMessage hwnd, WM_CAP_FILE_SAVEDIB, 0, _Offset(filename)
    'SendMessage hwnd, WM_CAP_EDIT_COPY, 0, 0 ' It is now in the clipboard, too Smile
End Sub ' SaveBMP

' /////////////////////////////////////////////////////////////////////////////

Sub SetupDriver (hwnd As _Offset, videoWidth As _Unsigned Long, videoHeight As _Unsigned Long, defaultSource As _Byte)
    SendMessage hwnd, WM_CAP_DRIVER_CONNECT, 0, 0
    SendMessage hwnd, WM_CAP_SET_SCALE, -1, 0
    SendMessage hwnd, WM_CAP_SET_PREVIEWRATE, 1000 / FPS, 0
    SendMessage hwnd, WM_CAP_SET_PREVIEW, -1, 0
    Dim As _Unsigned Long formatSize: formatSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
    Dim As BITMAPINFO bmi
    If Len(bmi) <> formatSize Then
        KillDriver hwnd
        Print "Wrong size"
        Print formatSize, Len(bmi)
        End
    End If

    If SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, formatSize, _Offset(bmi)) = 0 Then
        KillDriver hwnd
        Print "Couldn't get format"
        End
    End If
    bmi.bmiHeader.biWidth = videoWidth
    bmi.bmiHeader.biHeight = videoHeight
    bmi.bmiHeader.biBitCount = 16 'yuy2 format
    bmi.bmiHeader.biCompression = mmioStringToFOURCC("YUY2" + Chr$(0), &H00000010) ' MUST BE YUY2 FORMAT
    bmi.bmiHeader.biSizeImage = videoWidth * videoHeight * 2
    If SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, formatSize, _Offset(bmi)) = 0 Then
        KillDriver hwnd
        Print "Failed to set video format"
        End
    End If
    If defaultSource = _FALSE Then
        SendMessage hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0 'PICK YUY2!!!
        SendMessage hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
    End If
End Sub ' SetupDriver

' /////////////////////////////////////////////////////////////////////////////

' ################################################################################################################################################################
' BEGIN COLOR FUNCTIONS #COLOR
' ################################################################################################################################################################

Function cRed~& ()
    cRed = _RGB32(255, 0, 0)
End Function

Function cOrangeRed~& ()
    cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&

Function cDarkOrange~& ()
    cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&

Function cOrange~& ()
    cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&

Function cGold~& ()
    cGold = _RGB32(255, 215, 0)
End Function ' cGold~&

Function cYellow~& ()
    cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&

' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
    cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&

' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
    cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&

Function cLime~& ()
    cLime = _RGB32(0, 255, 0)
End Function ' cLime~&

Function cMediumSpringGreen~& ()
    cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&

' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
    cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&

Function cCyan~& ()
    cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&

Function cDeepSkyBlue~& ()
    cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&

Function cDodgerBlue~& ()
    cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&

Function cSeaBlue~& ()
    cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&

Function cBlue~& ()
    cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&

Function cBluePurple~& ()
    cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&

Function cDeepPurple~& ()
    cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&

Function cPurple~& ()
    cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&

Function cPurpleRed~& ()
    cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&

Function cDarkRed~& ()
    cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&

Function cBrickRed~& ()
    cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&

Function cDarkGreen~& ()
    cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&

Function cGreen~& ()
    cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&

Function cOliveDrab~& ()
    cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&

Function cLightPink~& ()
    cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&

Function cHotPink~& ()
    cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&

Function cDeepPink~& ()
    cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&

Function cMagenta~& ()
    cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&

Function cBlack~& ()
    cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&

Function cDimGray~& ()
    cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&

Function cGray~& ()
    cGray = _RGB32(128, 128, 128)
End Function ' cGray~&

Function cDarkGray~& ()
    cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&

Function cSilver~& ()
    cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&

Function cLightGray~& ()
    cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&

Function cGainsboro~& ()
    cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&

Function cWhiteSmoke~& ()
    cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&

Function cWhite~& ()
    cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&

Function cDarkBrown~& ()
    cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&

Function cLightBrown~& ()
    cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&

Function cKhaki~& ()
    cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&

Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&

' ################################################################################################################################################################
' END COLOR FUNCTIONS @COLOR
' ################################################################################################################################################################
Find
Reply
SpriggsySpriggs Offline
Professional Noticer
*****
Posts: 797
Threads: 35
Joined: Apr 2022
Reputation: 54
#9
5 hours ago
Guess, what, my dude? I've figured out how to read the raw pixel data from the camera without the clipboard. I just have to get the colors correct. But I'm reading raw pixels straight to memory now. I'll give you code when I get it fixed.
The noticing will continue
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 817
Threads: 116
Joined: Apr 2022
Reputation: 19
#10
5 hours ago (This post was last modified: 4 hours ago by madscijr.)
SpriggsySpriggs dateline="Guess, what, my dude? I've figured out how to 1740723970' Wrote: read the raw pixel data from the camera without the clipboard. I just have to get the colors correct. But I'm reading raw pixels straight to memory now. I'll give you code when I get it fixed.
Sweet! 
Soon we may be able to cut and paste by gesturing rudely at the computer!
I don't think HAL 9000 had a clipboard!

(This could actually open up some strange possibilities for new kinds of desktop environment for navigating this brave new world... And by the way, where is QB64PE for the Meta Quest, Apple Vision Pro and all that jazz? I want to program virtual reality in BASIC, dammit!! Tongue)
Find
Reply




Users browsing this thread: 9 Guest(s)