XProfan

' 4k-Wettbewerb @Volkmar 2013
Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, VZ, TI
WindowTitle "Ping Pong 5"
WindowStyle 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
UserMessages 16

While %UMessage <> 16

    TI = &gettickcount

    If (SP + CP) < 7

        Malen

    Else

        Ergebnis

    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 Punkte

    UseFont "COURIER NEW", 24, 0, 1, 0, 0
    TextColor 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 Ergebnis

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

    If SP > CP

        TextColor RGB(0, 255, 48), -1
        DrawText 22, 96, "Du hast gewonnen"

    Else

        TextColor RGB(255, 96, 0), -1
        DrawText 22, 96, "Du hast verloren"

    EndIf

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

EndProc

Proc Malen

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

EndProc