Hi all, new here, and relatively new to programming. I've been working for about a week on a 2D RPG engine, and even AI (of various sorts) can't see to help me on certain issues.

The first issue is that I can't figure out how to take a screenshot of one particular area of the screen. When I use _ScreenImage it just takes a shot of the last window that was open OTHER than the game I'm working on. GET seems useless for whatever reason, and _NewImage only starts from 0, 0, which is useless to me. And I don't even understand _CopyImage.

I'm working in a 32-bit window.

The purpose of this is for the second issue, and for all I know isn't needed at all. I made code to animate the opening of a text box by splitting it into thirds. It appears from top to bottom over a certain period of frames. But the problem is that the only way I've been able to make those images disappear is by making them all disappear at the same time. However I simply want the animation to reverse itself so the box appears to be closing.

I must've worked seven hours today to try and make this happen, to no avail. And Claude, ChatGPT, and Gemini were all of no help. I'm desperate here!

Thank you.

Vespin

Hi
I'm not sure if the post  must be in this section (Games) or in Utilities.
It is a simple demonstration on how setup keys used for input in a game and how to use them into the game.
Here the game is just moving a character made by a full block in the limits of the screen (screen 0 -->25x80)

here the code

Rem selfdefinition of input from keyboard

DefStr S

Dim sKeyUP, sKeyDOWN, sKeyLeft, sKeyRight

_Title "Self Assignment Input Key Demo"

Print "inizialization"

KeyInit sKeyUP, sKeyDOWN, sKeyLeft, sKeyRight

Print "keys' setup done"

_Delay 2

Xc% = 2

Yc% = 1

Cls

Locate 1, 1

sInput = sKeyUP + sKeyDOWN + sKeyLeft + sKeyRight

Print "Move the character using these keys "; sInput

Print "°";

Do

    sInp = InKey$

    If InStr(sInput, sInp) Then

        If sInp = sKeyUP Then

            If Xc% > 1 Then

                Printstring Xc%, Yc%, " "

                Xc% = Xc% - 1

                Printstring Xc%, Yc%, "°"

            End If

        ElseIf sInp = sKeyDOWN Then

            If Xc% < 25 Then

                Printstring Xc%, Yc%, " "

                Xc% = Xc% + 1

                Printstring Xc%, Yc%, "°"

            End If

        ElseIf sInp = sKeyLeft Then

            If Yc% > 1 Then

                Printstring Xc%, Yc%, " "

                Yc% = Yc% - 1

                Printstring Xc%, Yc%, "°"

            End If

        ElseIf sInp = sKeyRight Then

            If Yc% < 80 Then

                Printstring Xc%, Yc%, " "

                Yc% = Yc% + 1

                Printstring Xc%, Yc%, "°"

            End If

        End If

    End If

Loop

End



Sub Printstring (X%, Y%, sS)

    Locate X%, Y%

    Print sS;

End Sub



Sub KeyInit (sUp, sDown, sLeft, sRight)

    Print "Press the key for going UP"

    Do

        sUp = ""

        Do

            sUp = InKey$

        Loop While sUp = ""

        Print " you have choosen "; sUp

    Loop Until Confirm$ = "y"



    Print "Press the key for going DOWN"

    Do

        sDown = ""

        Do

            sDown = InKey$

        Loop While sDown = ""

        Print " you have choosen "; sDown

    Loop Until Confirm$ = "y"



    Print "Press the key for going Left"

    Do

        sLeft = ""

        Do

            sLeft = InKey$

        Loop While sLeft = ""

        Print " you have choosen "; sLeft

    Loop Until Confirm$ = "y"



    Print "Press the key for going Right"

    Do

        sRight = ""

        Do

            sRight = InKey$

        Loop While sRight = ""

        Print " you have choosen "; sRight

    Loop Until Confirm$ = "y"







End Sub



Function Confirm$

    Print "Do you  confirm your choice?  Y/N"

    sInp = ""

    While sInp = ""

        sInp = LCase$(InKey$)

        If sInp <> "" And InStr("yn", sInp) = 0 Then sInp = ""

    Wend

    Confirm$ = sInp

End Function

_OpenFileDialog$()

So let's say I use this beat new addition to qb. It opens my local directory (c:\QB64pe), but now I use that dialog box to go to a different folder: c:\Pete's Tremendous-Steve's-Just-Amazing and I open a file from that location. So what do I query to get that non-local directory into a string variable like dir$ in my code?

Pete

The thing I miss most about my assembly writing days is the compiler command to Xref a source file.  On extremely large or multi-module assembly programs knowing all the source lines referencing a variable or value was fantastic.  It was easy to get to all source lines that contained something found in the xref list.  So easy, if a re-write or bug hunt was needed.  It was like shooting fish in a barrel.   Likely the 'C' compiler used in QB64 has that function.  But referencing back to the source would be problematic.

Has someone found or created Xref for QB64 ?

I've been working on a new way to manage QBJS samples:
   
You can check it out here: https://boxgaming.github.io/qbjs-samples

You can filter by category or author and run the sample in either production or the development instance.  It's hosted right out of the github project where the samples are maintained and is itself built in QBJS.

I would be interested in any feedback or suggestions and, of course, submissions of any additional examples that we could add to the collection.

For @Dimster.  (Beta Version).

Note: Formerly incorrectly titled as a Remline clone. Thanks ahenry for the heads up!

This one lets you use the clipboard to add the path and file name, but if you prefer to just open a dialog box and select the file, I combined my remover with Steve's open dialog in post #14, here: https://qb64phoenix.com/forum/showthread...3#pid29513

_Title "Pete's Remark-Disable"

Width 80, 25

_Font 16

_ScreenMove 20, 0

Dim i As _Integer64

Dim col As Integer

_Clipboard$ = "C:\qb64pe\steve-junk.bas"

If Len(_Clipboard$) > 100 Then

    Print "Warning: This application will erase your current clipboard contents."

    Print: Print "Press Enter to continue or Esc to quit..."

    Do

        b$ = InKey$

        If Len(b$) Then

            If b$ = Chr$(27) Then System

            If b$ = Chr$(13) Then Exit Do

        End If

        _Limit 60

    Loop

    _Clipboard$ = Chr$(0)

Else

    hold$ = _Clipboard$

    _Clipboard$ = Chr$(0)

End If

Cls

Do

    redo1:

    While -1

        Locate 1, 1: View Print CsrLin To _Height - 1: Cls 2: View Print

        Locate 1, 1: Print "Paste directory name: ": Locate 3, 1, 1, 7, 30

        Do

            _Limit 60

            b$ = InKey$

            If Len(b$) Then

                _Limit 10

                Select Case b$

                    Case Chr$(27): System

                    Case Chr$(13): dir1$ = _CWD$: Exit Do

                    Case Chr$(32): GoSub manual: If x$ = "" Then redo = 1: b$ = Chr$(8): Exit While

                End Select

            End If

            If Len(_Clipboard$) Then GoSub clip: dir1$ = x$: Exit Do

        Loop

        _Clipboard$ = Chr$(0)

        If Right$(dir1$, 1) <> "\" Then dir1$ = dir1$ + "\"

        Locate 3, 1: Print dir1$

        If _DirExists(dir1$) Then Exit While Else Print "Directory not found: "; dir1$; " Any key to redo...";: Sleep

    Wend

    If b$ = Chr$(8) Then Exit Do

    redo2:

    While -1

        Locate 5, 1: View Print CsrLin To _Height - 1: Cls 2: View Print

        Locate 5, 1: Print "Paste file name: ": Locate 7, 1

        If Len(filehold$) Then

            file1$ = filehold$: filehold$ = ""

        Else

            Do

                _Limit 60

                b$ = InKey$

                If Len(b$) Then

                    Select Case b$

                        Case Chr$(27): System

                        Case Chr$(8): redo = 1: Exit While

                        Case Chr$(32): GoSub manual: If x$ = "" Then redo = 2: b$ = Chr$(8): Exit While

                    End Select

                End If

                If Len(_Clipboard$) Then GoSub clip: file1$ = x$: Exit Do

            Loop

        End If

        _Clipboard$ = Chr$(0)

        If InStr(file1$, ".") = 0 Then file1$ = file1$ + ".bas"

        Print file1$

        If _FileExists(dir1$ + file1$) Then Exit Do Else Print "File not found: "; dir1$ + file1$; " Any key to redo...";: Sleep

    Wend

    If b$ = Chr$(8) Then Exit Do

Loop

If b$ = Chr$(8) Then GoTo redo1

If _FileExists(dir1$ + file1$) Then Else Print: Print "Error. File not found: "; dir1$ + file1$: End

Open dir1$ + file1$ For Binary As #1

a$ = Space$(LOF(1))

Get #1, , a$

Close #1

quote = 0: col = 0: i = 0: new$ = ""

Do

    i = i + 1

    x$ = Mid$(a$, i, 1)

    If Asc(x$) > 32 Then col = col + 1

    x2$ = LCase$(Mid$(a$, i, 4))

    If Mid$(x2$, 1, 1) = "'" Then

        If LTrim$(Mid$(a$, i + 2, 1)) = "$" Then x2$ = ""

    ElseIf x2$ = "rem " Then

        If Mid$(a$, i + 4, 1) <> "$" Then x2$ = "'" Else x2$ = ""

    End If

    If LCase$(Mid$(a$, i, 5)) = "data " Then dta = -1

    Select Case Mid$(x2$, 1, 1)

        Case "'"

            If quote = 0 And dta = 0 Then

                q = InStr(i, a$ + Chr$(13), Chr$(13))

                If col = 1 Then lineout% = 2 Else lineout% = 0

                i = q + lineout% - 1

                new$ = RTrim$(new$)

                If Right$(new$, 1) = ":" Then

                    new$ = Mid$(new$, 1, Len(new$) - 1) ' Remove trailing colon.

                End If

                col = 0

                _Continue

            End If

        Case Chr$(34)

            If dta = 0 Then quote = 1 - quote

        Case ":"

            If dta Then dta = 0

        Case Chr$(13), Chr$(10)

            quote = 0: col = 0: dta = 0

    End Select

    new$ = new$ + x$

Loop Until i >= Len(a$)

_Clipboard$ = a$

GoSub makefile

_KeyClear

Sleep 5

System



clip:

x$ = _Trim$(_Clipboard$)

If InStr(x$, Chr$(13)) Then x$ = Mid$(x$, 1, InStr(x$, Chr$(13)) - 1)

If InStr(x$, ".") And InStr(x$, "\") <> 0 Then

    If dir1$ = "" Then

        filehold$ = Mid$(x$, _InStrRev(x$, "\") + 1)

        x$ = Mid$(x$, 1, _InStrRev(x$, "\"))

    ElseIf dir2$ = "" Then

        filehold$ = Mid$(x$, _InStrRev(x$, "\") + 1)

        x$ = Mid$(x$, 1, _InStrRev(x$, "\"))

    End If

End If

Return



manual:

y = CsrLin: x = 12

Line Input "Type name: ", x$: Locate y, x

If Len(x$) Then _Clipboard$ = x$ Else _Clipboard$ = Chr$(0)

Return



makefile:

file1_nc$ = Mid$(file1$, 1, InStr(file1$, ".") - 1) + "_nc" + Mid$(file1$, InStr(file1$, "."))

If _FileExists(dir1$ + file1_nc$) Then

    x$ = "File: " + file1_nc$ + " already exists. Overwrite? Y/N: "

    Print: Print x$;

    Do

        _Limit 30

        b$ = InKey$

        If Len(b$) Then

            Select Case UCase$(b$)

                Case "Y": Print "Y": Exit Do

                Case "N", Chr$(27): Print: Print "File creation aborted by user...": End

            End Select

        End If

    Loop

End If

Open dir1$ + file1_nc$ For Output As #3

Print #3, new$

Close #3

Print: Print "Loading "; file1_nc$

Shell _DontWait _Hide "QB64pe.exe " + file1_nc$

Rem Shell _DontWait _Hide "notepad " + file1_nc$

Return

  ' $Dynamic

    Rem $Dynamic

  ' Simple rem line.

  ' "***": for i = 1 to 5

  Print " ' this should not be removed. Rem 123" rem this should be removed.

    a$ = "apple": ' apple

      b$ = "orange": Rem orange

        c$ = "pear" ' pear

  d$ = "banana" Rem banana

  ' line 1

      ' line 2

  Rem line 3

  Data don't

  Data "don't"

    Data "don't": ' remark.

        Data "don't": Rem remark.

    Data don't ' remark is part of data and should stay.

  Data don't rem remark is part of data and should stay, too.

I tend to have a number of smaller well commented codes which eventually I roll together into a finished larger program. These smaller code sections can have quite a few lines of code and comments which get copied and pasted into the larger program. To remove the comments from the finished larger program I have been hunting and highlighting the comments and deleting them as I find them. I was thinking the IDE may be more helpful in this regard if there was an option under the EDIT to Remove ALL COMMENTS.

Option _Explicit

'$CONSOLE:ONLY

'_DEST _CONSOLE

'Window Style Constants

Const WS_BORDER = &H00800000

Const WS_CAPTION = &H00C00000

Const WS_CHILD = &H40000000

Const WS_CHILDWINDOW = WS_CHILD

Const WS_CLIPCHILDREN = &H02000000

Const WS_CLIPSIBLINGS = &H04000000

Const WS_DISABLED = &H08000000

Const WS_DLGFRAME = &H00400000

Const WS_GROUP = &H00020000

Const WS_HSCROLL = &H00100000

Const WS_ICONIC = &H20000000

Const WS_MAXIMIZE = &H01000000

Const WS_MAXIMIZEBOX = &H00010000

Const WS_MINIMIZE = &H20000000

Const WS_MINIMIZEBOX = &H00020000

Const WS_OVERLAPPED = &H00000000

Const WS_POPUP = &H80000000

Const WS_SIZEBOX = &H00040000

Const WS_SYSMENU = &H00080000

Const WS_TABSTOP = &H00010000

Const WS_THICKFRAME = &H00040000

Const WS_TILED = &H00000000

Const WS_VISIBLE = &H10000000

Const WS_VSCROLL = &H00200000

Const WS_TILEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

Const WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU

Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

'------------------------------------------------------------------------------------------------------------------------------

'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_GRAB_FRAME = WM_CAP_START + 60

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_STOP = WM_CAP_START + 68

Const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14

Const WM_CAP_GET_STATUS = WM_CAP_START + 54

Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45

Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41

Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44

Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42

Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43

Const WM_CAP_SEQUENCE = WM_CAP_START + 62

Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61

Const WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_START + 20

Const WM_CAP_SINGLE_FRAME = WM_CAP_START + 70

Const WM_CAP_SET_AUDIOFORMAT = WM_CAP_START + 35

Const WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46

'------------------------------------------------------------------------------------------------------------------------------

'Window Pos Constants

Const SWP_ASYNCWINDOWPOS = &H4000

Const SWP_DEFERERASE = &H2000

Const SWP_DRAWFRAME = &H0020

Const SWP_FRAMECHANGED = &H0020

Const SWP_HIDEWINDOW = &H0080

Const SWP_NOACTIVATE = &H0010

Const SWP_NOCOPYBITS = &H0100

Const SWP_NOMOVE = &H0002

Const SWP_NOOWNERZORDER = &H0200

Const SWP_NOREDRAW = &H0008

Const SWP_NOREPOSITION = &H0200

Const SWP_NOSENDCHANGING = &H0400

Const SWP_NOSIZE = &H0001

Const SWP_NOZORDER = &H0004

Const SWP_SHOWWINDOW = &H0040

'------------------------------------------------------------------------------------------------------------------------------

Const WAVE_FORMAT_PCM = 1

Type CapDriverCaps

    DeviceIndex As _Unsigned Long

    HasOverlay As _Byte

    HasDlgVideoSource As _Byte

    HasDlgVideoFormat As _Byte

    HasDlgVideoDisplay As _Byte

    CaptureInitialized As _Byte

    DriverSuppliesPalettes As _Byte

    hVideoIn As Long

    hVideoOut As Long

    hVideoExtIn As Long

    hVideoExtOut As Long

End Type



Type POINTAPI

    x As Long

    y As Long

End Type



Type CapStatus

    ImageWidth As _Unsigned Long

    ImageHeight As _Unsigned Long

    LiveWindow As _Byte

    OverlayWindow As _Byte

    Scale As _Byte

    Scroll As POINTAPI

    UsingDefaultPalette As _Byte

    AudioHardware As _Byte

    CapFileExists As _Byte

    CurrentVideoFrame As Long

    CurrentVideoFramesDropped As Long

    CurrentWaveSamples As Long

    CurrentTimeElapsedMS As Long

    PalCurrent As Long

    CapturingNow As _Byte

    RETURN As Long

    NumVideoAllocated As _Unsigned Long

    NumAudioAllocated As _Unsigned Long

End Type



Type WAVEFORMATEX

    FormatTag As Integer

    Channels As Integer

    SamplesPerSec As Long

    AvgBytesPerSec As Long

    BlockAlign As Integer

    BitsPerSample As Integer

    cbSize As Integer

End Type





Declare Dynamic Library "Avicap32"

    Function CreateCaptureWindow& Alias capCreateCaptureWindowA (lpszWindowName As String, Byval dwStyle As _Offset, Byval x As Integer, Byval y As Integer, Byval nWidth As Integer, Byval nHeight As Integer, Byval hwndParent As _Integer64, Byval nId As Integer)

    Function GetDriverDescription%% Alias capGetDriverDescriptionA (ByVal wDriverIndex As _Unsigned Long, Byval lpszName As _Offset, Byval cbName As Integer, Byval lpszVer As _Offset, Byval cbVer As Integer)

End Declare



Declare Dynamic Library "User32"

    Function SendMessage& Alias SendMessageA (ByVal hWnd As Long, Byval Msg As _Unsigned Integer, Byval wParam As Long, Byval lParam As _Offset)

    Function SetWindowPos%% (ByVal hWnd As Long, Byval hWndInsertAfter, Byval X As Integer, Byval Y As Integer, Byval cx As Integer, Byval cy As Integer, Byval uFlags As _Unsigned Long)

    Function DestroyWindow%% (ByVal hWnd As Long)

End Declare



Declare Dynamic Library "WINMM"

    Function mciSendString% Alias mciSendStringA (lpstrCommand As String, lpstrReturnString As String, Byval uReturnLength As _Unsigned Long, Byval hwndCallback As Long)

    Function mciGetErrorString% Alias mciGetErrorStringA (ByVal dwError As Long, lpstrBuffer As String, Byval uLength As _Unsigned Long)

End Declare



Screen _NewImage(720, 480, 32)



Dim childWin As _Integer64

Dim a As Long



Dim captureWinText As String

captureWinText = "Webcam API Test" + Chr$(0)

Dim childID As _Integer64

childWin = CreateCaptureWindow(captureWinText, WS_CHILD Or WS_VISIBLE, 0, 0, 720, 480, _WindowHandle, childID)

_Title "Webcam API Test"

Print childWin



a = SendMessage(childWin, WM_CAP_DRIVER_CONNECT, 0, 0)

Dim DeviceName As String * 80

Dim DeviceVersion As String * 80

Dim wIndex As _Unsigned Integer



'FOR wIndex = 0 TO 10

'DeviceName = SPACE$(80)

'DeviceVersion = SPACE$(80)

a = GetDriverDescription(wIndex, _Offset(DeviceName), Len(DeviceName), _Offset(DeviceVersion), Len(DeviceVersion))

'PRINT DeviceName, DeviceVersion

'NEXT



Dim driverCaps As CapDriverCaps

driverCaps.DeviceIndex = 0



a = SendMessage(childWin, WM_CAP_DRIVER_GET_CAPS, Len(driverCaps), _Offset(driverCaps))



Dim capstatus As CapStatus



Dim filename As String

filename = "Video.avi" + Chr$(0)

If _FileExists(filename) Then

    Kill filename

End If

Dim wave As WAVEFORMATEX

wave.FormatTag = WAVE_FORMAT_PCM

wave.Channels = 2

wave.SamplesPerSec = 48000

wave.AvgBytesPerSec = 192000

wave.BlockAlign = 4

wave.BitsPerSample = 16

wave.cbSize = 0

a = SendMessage(childWin, WM_CAP_SET_SCALE, -1, 0)

a = SendMessage(childWin, WM_CAP_SET_PREVIEWRATE, 16.7, 0)

a = SendMessage(childWin, WM_CAP_SET_PREVIEW, -1, 0)

a = SendMessage(childWin, WM_CAP_DLG_VIDEOFORMAT, 0, 0)

a = SendMessage(childWin, WM_CAP_DLG_VIDEOSOURCE, 0, 0)

'a = SendMessage(childWin, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0)

a = SendMessage(childWin, WM_CAP_FILE_SET_CAPTURE_FILE, 0, _Offset(filename))

a = SendMessage(childWin, WM_CAP_SET_AUDIOFORMAT, Len(wave), _Offset(wave))

a = SendMessage(childWin, WM_CAP_SEQUENCE, 0, 0)

a = SendMessage(childWin, WM_CAP_GET_STATUS, Len(capstatus), _Offset(capstatus))

'a = SetWindowPos(childWin, 0, 0, 0, capstatus.ImageWidth, capstatus.ImageHeight, SWP_NOZORDER OR SWP_NOMOVE)

Do

    If Not SendMessage(childWin, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0) Then Exit Do 'Press escape or make the window lose focus to stop recording

    'IF _WINDOWHASFOCUS = 0 THEN EXIT DO

    _Limit 60

Loop Until InKey$ <> ""

Print "Disconnecting Driver:", SendMessage(childWin, WM_CAP_DRIVER_DISCONNECT, 0, 0)

a = DestroyWindow(childWin)

Print "Destroyed"

I was wondering what are different ways to get audio line/mic input in a QB64PE program.  I know there is Windoes API.  Is there a way in Linux?

- Dav

Here is a pong clone that Bplus helped me with on the deflection a few years ago, etc. 
You use the mouse and go against the computer. Tonight I added a random number so the computer doesn't always win. lol

'Pong Clone by SierraKen - May 25, 2022.

'Thank you to B+ for the deflection math code, etc.!

'Thanks also to Coolman for sounds recommendation.

'Random computer paddle speed added on October 24, 2024.



_Title "Pong Clone - by SierraKen"

Screen _NewImage(800, 600, 32)

begin:

Cls

Locate 4, 35: Print "P  O  N  G    C  L  O  N  E"

Locate 7, 44: Print "By SierraKen"

Locate 10, 44: Print "With help by B+"

Locate 15, 25: Print "Use your mouse to control the round paddle on the right side."

Locate 16, 25: Print "First one to reach 10 points wins."

Locate 20, 37: Print "Press Mouse Button To Begin."

Do

    While _MouseInput: Wend

    If _MouseButton(1) = -1 Then GoTo begin2:

Loop



begin2:

Randomize Timer



' these remain constant

px = 350: py = 250: pr = 8: pc = _RGB32(0, 255, 0) ' <<<< lets label everything of puck with p

speed = 7 ' really keeping puck at constant speed



cx = 100: cy = 300: cr = 25: cc = _RGB32(255, 0, 0) 'Computer Racket

mx = 700: mr = 25: mc = _RGB32(255, 0, 0) ' <<<< evrything mouse starts with m , use different radius for mouse - Your Racket

score = 0

cscore = 0

freq = 600

timing = .5



_Delay 1

start:

px = 400: py = 300

Cls

angle:

pa = _Pi(2) * Rnd ' pa = puck angle this is rnd times all directions 0 to 360 in degrees 0 to 2*pi in radians

ang = _R2D(pa)



If ang > 80 And ang < 100 Then GoTo angle:

If ang > 260 And ang < 280 Then GoTo angle:



Do



    Cls ' Clear our work and recalulate and redraw everything

    Line (25, 25)-(775, 25), _RGB32(255, 255, 255)

    Line (25, 575)-(775, 575), _RGB32(255, 255, 255)

    For nety = 25 To 575 Step 20

        Line (400, nety)-(400, nety + 10), _RGB32(255, 255, 255)

    Next nety





    Locate 1, 10: Print " Computer: "; cscore

    Locate 1, 78: Print " You: "; score

    If cscore = 10 Then

        _AutoDisplay

        Cls

        Locate 5, 40

        Print "You Lose!"

        Locate 10, 40

        Print "Again (Y/N)?";

        again:

        ag$ = InKey$

        If ag$ = "y" Or ag$ = "Y" Then GoTo begin:

        If ag$ = "n" Or ag$ = "N" Or ag$ = Chr$(27) Then End

        GoTo again

    End If

    If score = 10 Then

        _AutoDisplay

        Cls

        Locate 5, 20

        Print "You Win!"

        Locate 10, 20

        Print "Again (Y/N)?";

        again2:

        ag2$ = InKey$

        If ag2$ = "y" Or ag2$ = "Y" Then GoTo begin:

        If ag2$ = "n" Or ag2$ = "N" Or ag2$ = Chr$(27) Then End

        GoTo again2

    End If



    a$ = InKey$

    If a$ = " " Then GoTo start:

    If a$ = Chr$(27) Then End



    While _MouseInput: Wend ' better way to poll mouse and label mouse x, y as mx, my like everyone else

    my = _MouseY

    fillCircle mx, my, mr, mc ' draw mouse paddle



    ' check for collision

    ' first part measure distance between mouse center and puck center, is it less than radius of mouse + puck?

    If Sqr((mx - px) ^ 2 + (my - py) ^ 2) < (pr + mr) Then ' (pr + pr2) to (r + rr)  collision!

        pa = _Atan2(py - my, px - mx) ' get the angle of the puck to the mouse



        px = px + speed * Cos(pa) ' move the puck out of the mouse paddle

        py = py + speed * Sin(pa) '

        sounds freq, timing

        r = Int(Rnd * 6) - 3

        _Display

    End If



    If py > cy Then

        cdist = py - cy

        cy = cy + cdist / 6

        cy = cy + r

    End If

    If py < cy Then

        cdist = cy - py

        cy = cy - cdist / 6

        cy = cy - r

    End If

    fillCircle cx, cy, cr, cc

    If Sqr((cx - px) ^ 2 + (cy - py) ^ 2) < (pr + cr) Then ' (pr + pr2) to (r + rr)  collision!

        pa = _Atan2(py - cy, px - cx) ' get the angle of the puck to the mouse

        px = px + speed * Cos(pa) ' move the puck out of the mouse paddle

        py = py + speed * Sin(pa) '

        sounds freq, timing

        _Display

    End If





    'keep puck out of wall = wall boundary +- radius of puck

    If px > 775 Then cscore = cscore + 1: gong: GoTo start:

    If px < 25 Then score = score + 1: gong2: GoTo start:

    If py > 575 - pr Then sounds freq, timing: pa = -pa: py = 575 - pr ' move puck out of wall !!!

    If py < 25 + pr Then sounds freq, timing: pa = -pa: py = 25 + pr ' move puck out of wall !!!



    ' nove the puck along and draw it

    px = px + speed * Cos(pa) ' now move the puck along  it's new direction pa = puck angle

    py = py + speed * Sin(pa) '

    fillCircle px, py, pr, pc ' draw puck



    _Display

    _Limit 60 ' hold screen for moment



Loop



Sub sounds (freq, timing)

    Sound freq, timing

End Sub



'from Steve Gold standard

Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    Wend

End Sub



Sub gong

    For snd = 200 To 100 Step -5

        Sound snd, .5

    Next snd

End Sub

Sub gong2

    For snd = 100 To 200 Step 5

        Sound snd, .5

    Next snd

End Sub