ping-pong 4th VARIABLE LEFT-BASE-POS VARIABLE RIGHT-BASE-POS VARIABLE

\ ping-pong.4th

VARIABLE LEFT-BASE-POS
VARIABLE RIGHT-BASE-POS
VARIABLE BAll-X
VARIABLE BALL-Y
VARIABLE BALL-DIRECTION ( 0 -- LT, 1 -- RT, 3 -- RB, 2 -- LB )
VARIABLE FIRST-PLAYER-SCORE
VARIABLE SECOND-PLAYER-SCORE

: DEFAULT-VARIABLES
    9 LEFT-BASE-POS !
    9 RIGHT-BASE-POS !
    40 BAll-X !
    12 BALL-Y !
    0  BALL-DIRECTION !
    0 FIRST-PLAYER-SCORE !
    0 SECOND-PLAYER-SCORE !
;

: DRAW-BORDERS
    80 0 DO I  0 AT-XY ." *" LOOP \ top horisontal
    80 0 DO I 25 AT-XY ." *" LOOP \ bottom horisontal
    25 1 DO 0  I AT-XY ." *" LOOP \ left vertical
    25 1 DO 79 I AT-XY ." *" LOOP \ right vertical
    4 25 AT-XY ." [ 0 ]"
    70 25 AT-XY ." [ 0 ]"
;

: DRAW-LEFT-BASE
    2 LEFT-BASE-POS @ 5 0 DO 2DUP I + AT-XY ." |" LOOP 2DROP
;

: DRAW-RIGHT-BASE
    77 RIGHT-BASE-POS @ 5 0 DO 2DUP I + AT-XY ." |" LOOP 2DROP
;

: REDRAW-BASE ( x y delta -- )
    1 = IF
        2DUP
        AT-XY SPACE
        5 + AT-XY ." |"
    ELSE
        2DUP
        1 - AT-XY ." |"
        4 + AT-XY SPACE
    THEN
    
    0 0 AT-XY
;

: REDRAW-LEFT-BASE
    DUP
    2 LEFT-BASE-POS @ ROT REDRAW-BASE
    LEFT-BASE-POS @ + LEFT-BASE-POS !
;

: REDRAW-RIGHT-BASE
    DUP
    77 RIGHT-BASE-POS @ ROT REDRAW-BASE
    RIGHT-BASE-POS @ + RIGHT-BASE-POS !
;

: LEFT-BASE-DOWN
    LEFT-BASE-POS @ 18 <> IF 1 REDRAW-LEFT-BASE THEN
;

: LEFT-BASE-UP
    LEFT-BASE-POS @ 1 <> IF -1 REDRAW-LEFT-BASE THEN
;

: RIGHT-BASE-DOWN
    RIGHT-BASE-POS @ 18 <> IF 1 REDRAW-RIGHT-BASE THEN
;

: RIGHT-BASE-UP
    RIGHT-BASE-POS @ 1 <> IF -1 REDRAW-RIGHT-BASE THEN
;

: FLIP-HORISONTAL ( dir -- dir )
    BALL-DIRECTION @
    DUP 0 = IF
        2
    ELSE
        DUP 1 = IF
            3
        ELSE
            DUP 3 = IF
                1
            ELSE
                0
            THEN
        THEN
    THEN
    BALL-DIRECTION !
    DROP
;

: FLIP-VERTICAL ( dir -- dir)
    BALL-DIRECTION @
    DUP 0 = IF
        1
    ELSE
        DUP 1 = IF
            0
        ELSE
            DUP 2 = IF
                3
            ELSE
                2
            THEN
        THEN
    THEN
    BALL-DIRECTION !
    DROP
;

: REDRAW-BALL
    DUP
    BALL-X @ BALL-Y @ AT-XY SPACE
    BALL-X @ 1 ROT 1 AND IF + ELSE - THEN BALL-X !
    BALL-Y @ 1 ROT 2 AND IF + ELSE - THEN BALL-Y !
    BALL-X @ BALL-Y @ AT-XY ." O"
;

: LEFT-BASE-CATCH?
    BALL-Y @ LEFT-BASE-POS @ >=
    BALL-Y @ LEFT-BASE-POS @ 5 + <=
    AND
;

: RIGHT-BASE-CATCH?
    BALL-Y @ RIGHT-BASE-POS @ >=
    BALL-Y @ RIGHT-BASE-POS @ 5 + <=
    AND
;

: FIRST-PLAYER-FAIL
    FIRST-PLAYER-SCORE @ DUP
    1 + FIRST-PLAYER-SCORE !
    6 25 AT-XY .
;

: SECOND-PLAYER-FAIL
    SECOND-PLAYER-SCORE @ DUP
    1 + SECOND-PLAYER-SCORE !
    72 25 AT-XY .
;

: MOVE-BALL
    BALL-X @ 3 = IF
        LEFT-BASE-CATCH? IF
            FLIP-VERTICAL
        THEN
    THEN
    
    BALL-X @ 76 = IF
        RIGHT-BASE-CATCH? IF
            FLIP-VERTICAL
        THEN
    THEN

    BALL-X @ 1 = IF
        FIRST-PLAYER-FAIL
        FLIP-VERTICAL
    THEN
        
    BALL-X @ 78 = IF
        SECOND-PLAYER-FAIL
        FLIP-VERTICAL
    THEN
    
    BALL-Y @ DUP
    1 = SWAP 22 = OR IF
        FLIP-HORISONTAL
    THEN
    
    BALL-DIRECTION @ REDRAW-BALL
    
    0 0 AT-XY
;

: PROCESS-KEY
    DUP 113 ( Q ) = IF PAGE QUIT THEN
    DUP 119 ( W ) = IF LEFT-BASE-UP    THEN
    DUP 115 ( S ) = IF LEFT-BASE-DOWN  THEN
    DUP 111 ( O ) = IF RIGHT-BASE-UP   THEN
    DUP 108 ( L ) = IF RIGHT-BASE-DOWN THEN
;

: INIT-DRAW
    PAGE
    DRAW-BORDERS
    DRAW-LEFT-BASE
    DRAW-RIGHT-BASE
;

: START
    DEFAULT-VARIABLES
    INIT-DRAW
    BEGIN
        MOVE-BALL
        KEY? IF
            KEY PROCESS-KEY
        THEN
        KEY? IF
            KEY PROCESS-KEY
        THEN
        50 MS
    AGAIN
;

START