QB64 Phoenix Edition
Volleyball - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: Petr (https://qb64phoenix.com/forum/forumdisplay.php?fid=52)
+---- Thread: Volleyball (/showthread.php?tid=1522)

Volleyball - Petr - 03-04-2023

On purpose. Who remembers my first program, back on the old
[Image: voll.png]

Galleon forum?

Hey guys, don't expect any physics! This was written purely for the show, for the joy of writing! Forget about any calculations! This is just total crap I love! PBF file is need!

Code: (Select All)
'programmed Petr Preclik. Contains none graphics orgy.
'DATE: 04/2018



Screen 13
_FullScreen
_MouseHide
ReDim Shared sn(0) As String
Dim Shared bigs As Integer, VidL, VidP, LevyX, LevyY, levysmer, PravyX, PravyY, pravysmer, start, BalonX, BalonY, left, right, SmerX, SmerY, rest, Balon, BalonTime, Vyskok, LeftPlayer, RightPlayer, I$, autostarted, ODPOCET, oldleft, oldright, vs, snd
bigs = reader("voll.pbf")
Balon = 5
PravyX = 150: PravyY = 101: VidP = 10
LevyX = 40: LevyY = 102: VidL = 1
pravysmer = 0
snd = 1




start:
SmerY = 1
start = 0
BalonX = 125: BalonY = 10
If left = 0 And right = 0 And autostarted = 0 Then menu



Cls: _AutoDisplay
If _FileExists("voll.pbf") Then
    Do While I$ <> Chr$(27)
        _PrintMode _KeepBackground
        '        COLOR 0, 2
        If oldleft <> left Then oldleft = left: score$ = Str$(left) + "-" + Str$(right): Locate 23, (80 - Len(score$)) / 2: Print score$
        If oldright <> right Then oldright = right: Locate 23, 17: Print left; " - "; right
        If autostarted = 0 Then I$ = InKey$
        Color 15, 0
        '============================================
        If vs And autostarted Then
            l = l + 1
            Select Case l
                Case 1
                    j$ = InKey$
                    If j$ = Chr$(27) Then
                        autostarted = 0: vs = 0: ODPOCET = Timer: j$ = "": GoTo start
                    Else I$ = j$
                    End If
                Case 2
                    AUTOSTART 1: l = 0
            End Select
        End If
        '=============================================
        If Timer > ODPOCET And vs = 0 Then AUTOSTART 0
        TestSmeru

        If rest Then rest = 0: GoTo start
        Select Case I$
            Case "S", "s": start = 1: ODPOCET = 99999: pisk
            Case Chr$(0) + Chr$(77)
                pravysmer = 1
                VidP = VidP + 1: If VidP > 13 Then VidP = 10
                PravyX = PravyX + 1
                If PravyX > 270 Then
                    PravyX = 270
                    doraz
                End If
            Case "D", "d"
                levysmer = 1
                VidL = VidL + 1: If VidL > 4 Then VidL = 1
                LevyX = LevyX + 1
                If LevyX > 100 Then
                    LevyX = 100
                    doraz
                End If
            Case Chr$(0) + Chr$(75)
                pravysmer = 2
                VidP = VidP - 1: If VidP < 10 Then VidP = 13
                PravyX = PravyX - 1
                If PravyX < 150 Then
                    PravyX = 150
                    doraz
                End If
            Case "A", "a"
                levysmer = 2
                VidL = VidL - 1: If VidL < 1 Then VidL = 4
                LevyX = LevyX - 1
                If LevyX < 10 Then
                    LevyX = 10
                    doraz
                End If
            Case Chr$(13)
                If delkaskoku = 0 Then delkaskoku = Timer + .50
                While delkaskoku > 0
                    Vyskok = 1
                    TestBalonu
                    TestSmeru
                    Select Case delkaskoku - Timer
                        Case Is > .25: PravyY = PravyY - 2
                            '    TestBalonu
                            If PravyY < 20 Then PravyY = 20
                            If pravysmer = 1 Then
                                VidP = VidP + 1: If VidP > 13 Then VidP = 10
                                PravyX = PravyX + 1
                                If PravyX > 270 Then
                                    PravyX = 270
                                    doraz
                                End If
                            End If
                            If pravysmer = 2 Then
                                VidP = VidP - 1: If VidP < 10 Then VidP = 13
                                PravyX = PravyX - 1
                                If PravyX < 150 Then
                                    PravyX = 150
                                    doraz
                                End If
                            End If
                        Case Is < .25
                            ' TestBalonu
                            PravyY = PravyY + 2
                            If PravyY >= 101 Then
                                PravyY = 101
                                delkaskoku = 0
                                I$ = ""
                            End If
                    End Select
                    okoli
                    rozpis VidP, PravyX, PravyY
                    rozpis Balon, BalonX, BalonY
                    rozpis VidL, LevyX, LevyY
                    rozpis 9, 130, 100
                    Line (0, 163)-(320, 163)
                    _Display
                    _Limit 30
                    Cls
                Wend

            Case Chr$(32)
                If delkaskokuL = 0 Then delkaskokuL = Timer + .50
                While delkaskokuL > 0
                    Vyskok = 1
                    TestBalonu
                    TestSmeru
                    Select Case delkaskokuL - Timer
                        Case Is > .25
                            ' TestBalonu
                            LevyY = LevyY - 2
                            If LevyY < 20 Then levy = 20
                            If levysmer = 1 Then
                                VidL = VidL + 1: If VidL > 4 Then VidL = 1
                                LevyX = LevyX + 1
                                If LevyX > 100 Then
                                    LevyX = 100
                                    doraz
                                End If
                            End If
                            If levysmer = 2 Then
                                VidL = VidL - 1: If VidL < 1 Then VidL = 4
                                LevyX = LevyX - 1
                                If LevyX < 10 Then
                                    LevyX = 10
                                    doraz
                                End If
                            End If
                        Case Is < .25
                            'TestBalonu
                            LevyY = LevyY + 2
                            If LevyY >= 102 Then
                                LevyY = 102
                                delkaskokuL = 0
                                I$ = ""
                            End If
                    End Select
                    okoli
                    rozpis VidP, PravyX, PravyY
                    rozpis Balon, BalonX, BalonY
                    rozpis VidL, LevyX, LevyY
                    rozpis 9, 130, 100
                    Line (0, 163)-(320, 163)
                    _Display
                    _Limit 30
                    Cls
                Wend
        End Select

        TestBalonu
        If Timer > BalonTime Then BalonTime = Timer + .5: Balon = Balon + 1: If Balon > 8 Then Balon = 5
        okoli
        rozpis VidP, PravyX, PravyY '                          right player frame, coordinate X, coordinate Y
        rozpis Balon, BalonX, BalonY '                                 ball frame, coordinate X, coordinate Y
        rozpis VidL, LevyX, LevyY '                             left player frame, coordinate X, coordinate Y
        rozpis 9, 130, 100
        Line (0, 163)-(320, 163)
        _Display
        _Limit 30
        Cls


    Loop

    left = 0: right = 0: autostarted = 0: vs = 0
    GoTo start
Else
    Print "voll.pbf not found!": Sleep 2: System
End If







Sub menu
    Shared netiskni
    netiskni = 0
    _AutoDisplay: _KeyClear
    I$ = ""
    If Not vs Then ODPOCET = Timer + 30
    SmerY = 1
    start = 0
    BalonX = 125: BalonY = 10
    fto& = _NewImage(60, 60, 256)
    _Dest fto&
    rozpis 7, 0, 0
    _Dest 0
    netiskni = 1
    po = 50





    Do While I$ <> Chr$(27)
        Cls
        uhel = uhel + 3: If uhel > 360 Then uhel = 1

        rotation fto&, 80, po, uhel, 1.5

        I$ = InKey$
        If Timer > ODPOCET And vs = 0 Then I$ = "3"
        center 10, "Volleyball - B/W"
        center 25, "Press keys 1 - 6 or arrows and enter"
        _PrintString (100, 50), "1: 1 player and computer"
        _PrintString (100, 70), "2: 2 players"
        _PrintString (100, 90), "3: demo"
        _PrintString (100, 110), "4: About"
        _PrintString (100, 130), "5: Sound setup"
        _PrintString (100, 150), "6: End"
        Select Case I$
            Case Chr$(0) + Chr$(80): po = po + 20
            Case Chr$(0) + Chr$(72): po = po - 20
            Case Chr$(13): I$ = Str$(((po + 10) / 20) - 2)
        End Select

        Select Case Val(I$)
            Case 3: ODPOCET = Timer: Exit Sub '                                                                          AUTOSTART 2 PLRS
            Case 2: autostarted = 0: Exit Sub '                                                                          PLAY GAME 2 PLRS
            Case 4: about: menu '                                                                                        ABOUT
            Case 5: If snd = 0 Then snd = 1: _PrintString (100, 180), "Sound ON": _Display: Sleep 2 Else snd = 0: _PrintString (100, 180), "Sound OFF": _Display: Sleep 2 '   SOUND
            Case 6: _FreeImage fto&: _MouseShow: System '                                                                            QUIT
            Case 1: AUTOSTART 1: ODPOCET = Timer: Exit Sub ' CLS: menu '                                                 PLAY GAME 1 PLR VS PC
        End Select
        If po > 150 Then po = 150
        If po < 50 Then po = 50
        If Len(I$) And I$ <> "3" Then ODPOCET = Timer + 30 'NYNI
        _Display
        _Limit 20
        I$ = ""
    Loop
End Sub


Sub about
    Cls
    Locate 2
    Print "About:"
    Locate 5
    Print "This is game for 0 or 1 or 2 players. "
    Print "Its shared so as it is, without hiscore."
    Print "Contains automatic demo start after 30  sec."
    Print
    Locate 12
    Print "Use A, D for move left player, S for "
    Print "Ball, space for jump left."
    Print "Use arrows left and right for move right"
    Print "player, enter for jump right."
    Print
    Locate 20
    Print "Writed Petr P."
    Print
    Print "Press key...."
    _Display
    Sleep
End Sub










Sub center (lin As Integer, text As String)
    centr = (_Width / 2 - _PrintWidth(text) / 2)
    _PrintString (centr, lin), text$
End Sub


Sub AUTOSTART (mode)
    Shared tah
    Select Case mode
        Case 0 '                                                                           this is call if plays PC vs PC
            autostarted = 1
            If start = 0 Then start = 1
            tah = tah + 1
            Select Case tah
                Case 1: If BalonX - 30 > LevyX Then I$ = "d" '                             on coordinates based computer "intelligence"
                Case 2: If BalonX - 30 < LevyX Then I$ = "a"
                Case 3: If BalonX + 60 > PravyX Then I$ = Chr$(0) + LTrim$(Chr$(77))
                Case 4: If BalonX + 30 < PravyX Then I$ = Chr$(0) + LTrim$(Chr$(75))
                Case 5: If BalonX + 60 > 220 Then I$ = Chr$(13)
                Case 6: If BalonX - 30 < 40 Then I$ = " "
                    tah = 0
            End Select
            If InKey$ <> "" Then autostarted = 0: ODPOCET = Timer + 20: left = 0: right = 0: restart 3
        Case 1 '                                                                           this run, if plays human vs computer.
            vs = 1
            autostarted = 1
            If start = 0 Then start = 1
            tah = tah + 1
            ODPOCET = Timer
            '            SHARED j$
            Select Case tah
                Case 5: If BalonX - 30 > LevyX Then I$ = "d" '                             computer drive one player.
                Case 6: If BalonX - 30 < LevyX Then I$ = "a"
                Case 7: If BalonX - 30 < 90 Then I$ = Chr$(32)
            End Select
            If tah > 9 Then tah = 0
    End Select
End Sub







Sub TestSmeru '                                                                           sub for testing how player go. If to right or to left.
    Select Case pravysmer
        Case 1
            VidP = VidP + 1: If VidP > 13 Then VidP = 10
            PravyX = PravyX + 1
            If PravyX > 270 Then
                PravyX = 270: pravysmer = 0
                doraz
            End If
        Case 2
            VidP = VidP - 1: If VidP < 10 Then VidP = 13
            PravyX = PravyX - 1
            If PravyX < 150 Then
                doraz
                PravyX = 150: pravysmer = 0
            End If
    End Select

    Select Case levysmer
        Case 1
            VidL = VidL + 1: If VidL > 4 Then VidL = 1
            LevyX = LevyX + 1
            If LevyX > 100 Then
                LevyX = 100: levysmer = 0
                doraz
            End If
        Case 2
            VidL = VidL - 1: If VidL < 1 Then VidL = 4
            LevyX = LevyX - 1
            If LevyX < 10 Then
                LevyX = 10: levysmer = 0
                doraz
            End If
    End Select
End Sub

Sub TestBalonu '                                                                          sub for testing ball fly
    If start = 1 Then
        If Timer Mod 5 = 0 And Sgn(SmerY) = 1 Then SmerY = SmerY + .0981
        If Timer Mod 5 = 0 And Sgn(SmerY) = -1 Then SmerY = SmerY + -0.0981
        If Abs(SmerY) > 3 Then SmerY = 3 * Sgn(SmerY)
        If Abs(SmerX) > 3 Then SmerX = 3 * Sgn(SmerX)

        If Vyskok And inCircle(BalonX + 33, BalonY + 37, 20, LevyX + 20, LevyY + 20, 23) Or skok And inCircle(BalonX + 33, BalonY + 37, 20, PravyX + 35, PravyY + 22, 20) Then
            klep
            Vyskok = 0 'resi kolizi ve vyskoku                                           ball collision on the fly if player skip
            SmerX = Rnd + SmerX * -1: SmerY = Rnd + SmerY * -1
            While inCircle(BalonX + 33, BalonY + 37, 20, LevyX + 20, LevyY + 20, 23) Or inCircle(BalonX + 33, BalonY + 37, 20, PravyX + 35, PravyY + 22, 20)
                BalonX = BalonX + SmerX
                BalonY = BalonY - (1 + Rnd * 10)
                SmerY = SmerY - .0990
                BalonX = BalonX + SmerX
                If BalonY < 10 Then SmerY = SmerY * -1: Do While BalonY < 30: BalonY = BalonY + SmerY: Loop
            Wend
            'EXIT SUB
            GoTo sut
        End If
        '                                                                                  ball collision if player go
        If inCircle(BalonX + 33, BalonY + 37, 20, LevyX + 20, LevyY + 20, 23) Then SmerX = Rnd / 2 + SmerX * -1: SmerY = SmerY * -1: BalonX = BalonX + 10 * SmerX: BalonY = BalonY + 10 * SmerY: klep
        If inCircle(BalonX + 33, BalonY + 37, 20, PravyX + 35, PravyY + 22, 20) Then SmerX = Rnd / 2 + SmerX * -1: SmerY = SmerY * -1: BalonX = BalonX + 10 * SmerX: BalonY = BalonY + 10 * SmerY: klep


        sut:
        If SmerX = 0 Then sm = Rnd * 10: If sm <= 5 Then SmerX = 1 Else SmerX = -1
        If SmerY = 0 Then sm = Rnd * 10: If sm <= 5 Then SmerY = 1 Else SmerY = -1
        If BalonY < 10 Then SmerY = SmerY * -1: BalonY = 10
        If BalonY > 80 And BalonX < 160 Then right = right + 1: start = 0: pad: restart 1 '   left player fail
        If BalonY > 80 And BalonX > 160 Then left = left + 1: start = 0: pad: restart 2 ' right player fail
        BalonX = BalonX + SmerX: BalonY = BalonY + SmerY
    End If
End Sub


Sub klep
    If snd Then Sound 550, .2
End Sub


Sub restart (who As _Unsigned _Byte)
    Select Case who
        Case 1: LeftPlayer = LeftPlayer - 1
        Case 2: RightPlayer = RightPlayer - 1
    End Select
    BalonX = 125: BalonY = 10
    rest = 1
End Sub

Function reader (file As String) '                                                      Read PBF file. This is my own new format contains graphics or characters. Its based on the BIT image representing.
    Shared frames
    kx = 0: ky = 1
    If _FileExists(file$) Then Open file$ For Binary As #1 Else Beep: Print "Error opening file "; file$: _Display: Sleep 3: System
    ident$ = Space$(4)
    ReDim big As Integer
    Get #1, , ident$
    If ident$ <> "Petr" Then Print "This is not my file format": Sleep 2: Exit Function
    Get #1, , big
    frames = (LOF(1) - 6) / (big ^ 2 / 8)
    ReDim udaj As _Unsigned _Byte
    ReDim sn(frames) As String

    While Not EOF(1)
        Get #1, , udaj
        binar$ = DECtoBIN$(udaj)
        sn(snindex) = sn(snindex) + binar$
        For rozklad = 1 To Len(binar$)
            inSeek = inSeek + 1 'vnitrni pocitadlo pozice
            povel = Val(Mid$(binar$, rozklad, 1))
            kx = kx + 1: If kx > big Then kx = 1: ky = ky + 1
        Next rozklad
        If inSeek Mod (big ^ 2) = 0 Then ky = ky + 10: snindex = snindex + 1
        If _Height - ky < big Then ky = 1: posun = posun + 60
    Wend
    Cls
    reader = big
End Function

Sub rozpis (snimek As Integer, posX As Integer, posY As Integer) '                                      Draw frames from PBF read by function READER
    Shared netiskni
    If autostarted And Not vs Then Color 2: Locate 23, 1: Print "Demo": Color 15
    If autostarted And vs Then Color 2: Locate 23, 1: Print "PC vs Human": Color 15
    If netiskni Then Locate 23, 17: Print left; " - "; right



    big = bigs ' je typu shared, udava delku strany
    binar$ = sn(snimek)
    For rozklad = 1 To Len(binar$)
        povel = Val(Mid$(binar$, rozklad, 1))
        kx = kx + 1: If kx > big Then kx = 1: ky = ky + 1
        If povel = 1 Then PSet (posX + kx, posY + ky) 'ELSE PRESET (posX + kx, posY + ky)
    Next rozklad
End Sub


' modifiation original code from CIRCLE help.
Function inCircle (cx As Integer, cy As Integer, cr As Integer, x As Integer, y As Integer, r As Integer) 'detect circle to circle contact. Return 1 if is contact, else return 0
    r = r + 1
    For Crc = 0 To 1.6 * _Pi Step .1
        pseudocircleX = (Sin(Crc) * r) + x
        pseudocircleY = (Cos(Crc) * r) + y
        xy& = ((pseudocircleX - cx) ^ 2) + ((pseudocircleY - cy) ^ 2) '                                 Pythagorean theorem
        If cr ^ 2 >= xy& Then inCircle = 1: Ic = 1 Else inCircle = 0
        If Ic = 1 Then Exit For
    Next
End Function


Function DECtoBIN$ (vstup) '                                                                            decimal to binary number convertor
    For rj = 7 To 0 Step -1
        If vstup And 2 ^ rj Then BINtoDE$ = BINtoDE$ + "1" Else BINtoDE$ = BINtoDE$ + "0"
    Next rj
    DECtoBIN$ = BINtoDE$
End Function

Sub doraz
    If snd And Not autostarted Then
        For e = .1 To .15 Step .01
            Sound e * 500, e
            Sound (500 * .6) - e, e
            Sound e * 10000, e / 2
        Next
        For e = .15 To .1 Step -.01
            Sound e * 500, e
            Sound (500 * .6) - e, e
            Sound e * 10000, e / 2
        Next
    End If
End Sub

Sub pisk
    If snd Then
        For e = .1 To .5 Step .1
            Sound Sqr(e * 100 ^ 2 * 5000), e * 3
        Next
    End If
End Sub

Sub pad
    If snd Then
        For e = 2 To .1 Step -.1
            Sound e * 200, .5
        Next
    End If
End Sub

Sub rotation (image As Long, x As Integer, y As Integer, angle As Integer, zoom As Integer) '            inspired by demo from somewhere in the forum, rotate image in menu.
    _Source image&
    _Dest 0
    wide% = _Width(image&): deep% = _Height(image&)
    TLC$ = "BL" + Str$(wide% / 2) + "BU" + Str$(deep% / 2)
    RET$ = "BD BL" + Str$(wide%)
    Draw "BM" + Str$(x) + ", " + Str$(y) + "TA=" + VarPtr$(angle%) + "S" + Str$(zoom) + TLC$

    For y = 0 To deep% - 1
        For x = 0 To wide% - 1
            Draw "C" + Str$(Point(x, y)) + "R1"
        Next x
        Draw RET$
    Next y
End Sub


Sub okoli
    Line (0, 164)-(319, 200), 2, BF 'travnik pozadi
End Sub

After downloading file voll.zip do not try extract it, just rename it as voll.pbf, forum allow not add this file directly, then copy it to the same folder with source code.

RE: Volleyball - bplus - 03-05-2023

Hi Petr, 

I remember that! Smile

RE: Volleyball - Petr - 03-05-2023

Hi @BPlus, I'm very, very happy. Now (on the fifth attempt!) I ran another program under Phoenix that use the old way of writing functions, but it almost drove me crazy. I'll post it too after a rest, it's that program for ICO and ANI files, it uses, you could say, something like an array within an array. Its just double array - link from one to the second...