XProfan

' 4k-competition @Volkmar 2013
Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, VZ, TI
Window Title "Ping Pong 5"
Window Style 24
Window 600, 400
CLS 0
Randomize
FL = 4 : FO = 4
FW = Width(%HWnd, 0) - 2 * FL
FH = Height(%HWnd, 0) - 2 * FO
SW = 2
SL = 30
SX = 4 : CX = FW - (4 + SW)
SY = FO
CY = FO
BX = FW \ 2
BY = 6 + Rnd(FH - 12)
BRH = 1
VZ = 10
MCLS FW, FH, 0
User Messages 16

While %UMessage <> 16

    TI = &gettickcount

    If (SP + CP) < 7

        Painting

    Else

        Result

    EndIf

    If (CY + 9) > BY

        If BRH

            If BX > ((FW \ 3) * 2)

                Dec CY, 2

            EndIf

        EndIf

    ElseIf CY < (FH - SL)

        If BRH

            If BX > ((FW \ 3) * 2)

                Inc CY, 2

            EndIf

        EndIf

    EndIf

    If IsKey(38)

        If SY > FO

            Dec SY, 2

        EndIf

    ElseIf IsKey(40)

        If SY < (FH - SL)

            Inc SY, 2

        EndIf

    ElseIf IsKey(93) Or IsKey(2)

        Menu

    EndIf

    While 1

        Case &gettickcount-TI > VZ : BREAK
        Sleep 1

    EndWhile

EndWhile

Proc Menu

    CreateMenu
    AppendMenu 1, "&Langsam"
    AppendMenu 2, "&Mittel"
    AppendMenu 3, "&Schnell"

    If SL > 28

        AppendMenu 8, "Schläger &Klein"

    Else

        AppendMenu 9, "Schläger &groß"

    EndIf

    TrackMenu 0, 0

    If MenuItem(1)

        VZ = 22

    ElseIf MenuItem(2)

        VZ = 16

    ElseIf MenuItem(3)

        VZ = 10

    ElseIf MenuItem(8)

        SL = 20

    ElseIf MenuItem(9)

        SL = 30

    EndIf

ENDPROC

Proc BallCalc

    If BRH

        If (BX > (FW - 13)) And (BY > CY) And (BY < (CY + SL))

            BRH = 0
            Sound 300, 20

        ElseIf BX > FW - 8

            BRH = 0
            Sound 1400, 28
            Inc SP

        Else

            Inc BX, 2

        EndIf

    Else

        If (BX < 11) And (BY > SY) And (BY < (SY + SL))

            BRH = 1
            Sound 300, 20

        ElseIf BX < 6

            BRH = 1
            Sound 1400, 28
            Inc CP

        Else

            Dec BX, 2

        EndIf

    EndIf

    If BRV

        If BY > FH - 8

            BRV = 0
            Sound 1200, 16

        Else

            Inc BY, 2

        EndIf

    Else

        If BY < 7

            BRV = 1
            Sound 1200, 16

        Else

            Dec BY, 2

        EndIf

    EndIf

ENDPROC

Proc spots

    UseFont "COURIER NEW", 24, 0, 1, 0, 0
    Text Color RGB(200, 220, 32), -1
    DrawText (FW \ 2) - 22, 10, (FW \ 2) - 4, 30, Str $(CP), 1
    DrawText (FW \ 2) + 4, 10, (FW \ 2) + 22, 30, Str $(SP), 1

ENDPROC

Proc Result

    StartPaint -1
    UseBrush 1, 0
    USEP 0, 1, RGB(240, 64, 64)
    Rectangle 0, 0 - FW, FH
    Line FW \ 2 , 2 - FW \ 2 , FH - 4
    spots
    UseFont "ARIAL", 24, 0, 0, 0, 0

    If SP > CP

        Text Color RGB(0, 255, 48), -1
        DrawText 22, 96, "Du have gewonnen"

    Else

        Text Color RGB(255, 96, 0), -1
        DrawText 22, 96, "Du have verloren"

    EndIf

    EndPaint
    MCopyBMP 0, 0 - FW, FH > FL, FO; 0

ENDPROC

Proc Painting

    BallCalc
    StartPaint -1
    UseBrush 1, 0
    USEP 0, 1, RGB(240, 64, 64)
    Rectangle 0, 0 - FW, FH
    Line FW \ 2 , 2 - FW \ 2 , FH - 2
    USEP 0, 1, RGB(240, 240, 64)
    Rectangle SX, SY - SW + SX, SY + SL - 2
    USEP 0, 1, RGB(64, 240, 240)
    Rectangle CX, CY - CX + SW, CY + SL - 2
    USEP 0, 1, RGB (240, 64, 64)
    UseBrush 1, RGB(240, 64, 64)
    ellipsis BX - 3, (BY - 3) - BX + 8, BY + 8
    spots
    EndPaint
    MCopyBMP 0, 0 - FW, FH > FL, FO; 0

ENDPROC