Tigr-m2/modula2/examples/pong/pong.mod

MODULE pong;

(* Classic Pong using the tigr Modula-2 binding. No assets: everything
   is drawn with tigrFillRect and the built-in font.

   Controls (two-player capable):
       W / S        move the left paddle
       UP / DOWN    move the right paddle (arrow keys take over from
                    the computer opponent)
       SPACE        serve / restart after a point or game over
       ESC          quit

   First to 5 points wins the match. The ball speeds up with every
   paddle hit; angle bounces off the paddle depending on where it hits.

   Compilation (from modula2/):
       gcc -c ../tigr-master/tigr.c -o tigr.o
       gm2 -fiso -c helper.mod
       gm2 -fiso -I. tigr.o helper.o examples/pong/pong.mod \
           -o examples/pong/pong -lGL -lX11
*)

FROM tigr IMPORT TigrPtr, tigrWindow, tigrFree, tigrClosed, tigrClear,
                tigrUpdate, TPixelType, tigrFillRect, tigrPrint, tfont,
                tigrKeyDown, tigrKeyHeld, tigrTime, tigrTextWidth,
                TK_ESCAPE, TK_SPACE, TK_UP, TK_DOWN;
FROM helper IMPORT tigrRGB;

CONST
    winW         = 640;
    winH         = 400;
    paddleW      = 8;
    paddleH      = 60;
    paddleMargin = 12;          (* gap between wall and paddle *)
    ballS        = 8;
    centerX      = 320;
    winScore     = 5;
    ballSpeed0   = 220.0;       (* px/s to begin each rally *)
    ballSpeedMax = 520.0;
    speedIncr    = 1.08;        (* multiplier per paddle hit *)
    paddleSpeedV = 380.0;       (* player paddle speed, px/s *)
    cpuSpeedV    = 330.0;       (* computer paddle speed, px/s *)
    playerStartX = 12;
    cpuStartX    = 620;

TYPE
    State = (s_serve, s_play, s_over);

VAR
    win            : TigrPtr;
    state          : State;
    playerY, cpuY  : SHORTREAL;     (* paddle top-left y *)
    bx, by         : SHORTREAL;     (* ball top-left *)
    bvx, bvy       : SHORTREAL;
    ballSpeed      : SHORTREAL;
    pScore, cScore : CARDINAL;
    seed           : CARDINAL;      (* tiny LCG *)
    dt             : SHORTREAL;     (* tigrTime: delta since last call *)
    black, white, green, red, cyan, yellow : TPixelType;
    i, n           : CARDINAL;
    msgbuf         : ARRAY [0..60] OF CHAR;
    tmp            : ARRAY [0..10] OF CHAR;

    PROCEDURE CardToText(v : CARDINAL; VAR s : ARRAY OF CHAR);

    (* Converts v to a NUL-terminated decimal string in s. *)

        VAR
            m, j : CARDINAL;
            t    : ARRAY [0..10] OF CHAR;

    BEGIN
        IF v = 0 THEN
            s[0] := '0';
            s[1] := 0C;
            RETURN
        END;
        m := 0;
        WHILE v > 0 DO
            t[m] := CHR(ORD('0') + (v MOD 10));
            m := m + 1;
            v := v DIV 10
        END;
        j := 0;
        WHILE m > 0 DO
            m := m - 1;
            s[j] := t[m];
            j := j + 1
        END;
        s[j] := 0C
    END CardToText;

    PROCEDURE Append(VAR dst : ARRAY OF CHAR; VAR len : CARDINAL;
                     src : ARRAY OF CHAR);

    (* Appends the NUL-terminated src to dst, tracking the length in len. *)

        VAR
            k : CARDINAL;

    BEGIN
        k := 0;
        WHILE src[k] # 0C DO
            dst[len] := src[k];
            len := len + 1;
            k := k + 1
        END
    END Append;

    PROCEDURE Serve(toward : BOOLEAN);

    (* Places the ball at the center with a randomized angle. The ball
       travels towards the right (TRUE) or the left (FALSE) at the
       current ballSpeed. *)

        VAR
            r : SHORTREAL;

    BEGIN
        seed := (seed * 1103515245 + 12345) MOD 2147483648;
        r := (SHORTREAL(seed MOD 1000) - 500.0) / 1000.0;  (* -0.5..0.5 *)
        IF r < 0.0 THEN
            IF r > -0.15 THEN
                r := -0.15
            END
        ELSIF r < 0.15 THEN
            r := 0.15
        END;
        bx := 316.0;
        by := 196.0;
        IF toward THEN
            bvx := ballSpeed * 0.62
        ELSE
            bvx := -ballSpeed * 0.62
        END;
        bvy := ballSpeed * 0.78 * r;
        state := s_serve
    END Serve;

    PROCEDURE StartGame;

    BEGIN
        seed := 12345;
        playerY := 170.0;
        cpuY := playerY;
        pScore := 0;
        cScore := 0;
        ballSpeed := ballSpeed0;
        seed := (seed * 1103515245 + 12345) MOD 2147483648;
        IF (seed MOD 2) = 0 THEN
            Serve(TRUE)
        ELSE
            Serve(FALSE)
        END
    END StartGame;

    PROCEDURE MovePaddle(VAR py : SHORTREAL; down : BOOLEAN;
                         spd : SHORTREAL);

    (* Moves a paddle by spd * dt pixels down (TRUE) or up (FALSE),
       clamped to the playfield. *)

        VAR
            next : SHORTREAL;

    BEGIN
        IF down THEN
            next := py + spd * dt
        ELSE
            next := py - spd * dt
        END;
        IF next < 0.0 THEN
            next := 0.0
        END;
        IF next > 340.0 THEN
            next := 340.0
        END;
        py := next
    END MovePaddle;

    PROCEDURE CpuMove;

    (* Simple AI: chases the ball once it moves past center and heads
       towards the computer's side. *)

        VAR
            tgt, diff, step : SHORTREAL;

    BEGIN
        IF (bvx > 0.0) AND (bx > 320.0) THEN
            tgt := by - 26.0;
            diff := tgt - cpuY;
            IF diff > 0.0 THEN
                step := cpuSpeedV * dt;
                IF diff < step THEN
                    cpuY := tgt
                ELSE
                    cpuY := cpuY + step
                END
            ELSIF diff < 0.0 THEN
                step := cpuSpeedV * dt;
                IF -diff < step THEN
                    cpuY := tgt
                ELSE
                    cpuY := cpuY - step
                END
            END;
            IF cpuY < 0.0 THEN
                cpuY := 0.0
            ELSIF cpuY > 340.0 THEN
                cpuY := 340.0
            END
        END
    END CpuMove;

    PROCEDURE BumpSpeed;

    BEGIN
        ballSpeed := ballSpeed * speedIncr;
        IF ballSpeed > ballSpeedMax THEN
            ballSpeed := ballSpeedMax
        END
    END BumpSpeed;

    PROCEDURE BallVsPad;

    (* Reflects the ball off either paddle, steering it by where it
       hits the paddle surface. *)

        VAR
            rel, half : SHORTREAL;

    BEGIN
        IF (bvx < 0.0) AND (bx <= 20.0)
           AND (bx + 8.0 >= 12.0)
           AND (by + 8.0 > playerY)
           AND (by < playerY + 60.0) THEN
            half := 30.0;
            rel := (by + 4.0 - (playerY + half)) / half;
            IF rel < -1.0 THEN
                rel := -1.0
            ELSIF rel > 1.0 THEN
                rel := 1.0
            END;
            bx := 20.0;
            bvx := ballSpeed * 0.62;
            bvy := rel * ballSpeed * 0.78;
            BumpSpeed
        ELSIF (bvx > 0.0) AND (bx + 8.0 >= 620.0)
              AND (bx <= 628.0)
              AND (by + 8.0 > cpuY)
              AND (by < cpuY + 60.0) THEN
            half := 30.0;
            rel := (by + 4.0 - (cpuY + half)) / half;
            IF rel < -1.0 THEN
                rel := -1.0
            ELSIF rel > 1.0 THEN
                rel := 1.0
            END;
            bx := 612.0;
            bvx := -ballSpeed * 0.62;
            bvy := rel * ballSpeed * 0.78;
            BumpSpeed
        END
    END BallVsPad;

    PROCEDURE Score;

    (* Awards a point when the ball leaves the playfield and serves
       towards the conceding player. *)

    BEGIN
        IF bx < -8.0 THEN
            cScore := cScore + 1;
            IF cScore >= winScore THEN
                state := s_over
            ELSE
                ballSpeed := ballSpeed0;
                Serve(FALSE)
            END
        ELSIF bx > 640.0 THEN
            pScore := pScore + 1;
            IF pScore >= winScore THEN
                state := s_over
            ELSE
                ballSpeed := ballSpeed0;
                Serve(TRUE)
            END
        END
    END Score;

    PROCEDURE MoveBall;

    BEGIN
        bx := bx + bvx * dt;
        by := by + bvy * dt;
        IF by <= 0.0 THEN
            by := 0.0;
            IF bvy < 0.0 THEN
                bvy := -bvy
            END
        ELSIF by + 8.0 >= 400.0 THEN
            by := 392.0;
            IF bvy > 0.0 THEN
                bvy := -bvy
            END
        END;
        BallVsPad;
        Score
    END MoveBall;

    PROCEDURE BuildScoreText;

    BEGIN
        n := 0;
        Append(msgbuf, n, "YOU ");
        CardToText(pScore, tmp);
        Append(msgbuf, n, tmp);
        Append(msgbuf, n, "   ");
        CardToText(cScore, tmp);
        Append(msgbuf, n, tmp);
        Append(msgbuf, n, "   CPU");
        msgbuf[n] := 0C
    END BuildScoreText;

    PROCEDURE CenterPrint(y : CARDINAL; msg : ARRAY OF CHAR;
                          col : TPixelType);

        VAR
            tw : INTEGER;
            x  : CARDINAL;

    BEGIN
        tw := tigrTextWidth(tfont, msg);
        IF tw < INTEGER(winW) THEN
            x := (winW - CARDINAL(tw)) / 2
        ELSE
            x := 0
        END;
        tigrPrint(win, tfont, x, y, col, msg)
    END CenterPrint;

    PROCEDURE Draw;

    BEGIN
        tigrClear(win, black);

        (* dashed center line *)
        i := 4;
        WHILE i < winH DO
            tigrFillRect(win, 319, i, 2, 8, white);
            i := i + 16
        END;

        tigrFillRect(win, playerStartX, TRUNC(playerY), paddleW, paddleH,
                     green);
        tigrFillRect(win, cpuStartX, TRUNC(cpuY), paddleW, paddleH, red);

        IF state # s_over THEN
            tigrFillRect(win, TRUNC(bx), TRUNC(by), ballS, ballS, white)
        END;

        tigrPrint(win, tfont, 6, 4, white, msgbuf);
        tigrPrint(win, tfont, 6, 16, yellow,
                  "W/S move UP/DOWN CPU SPACE serve ESC quit");

        IF state = s_serve THEN
            CenterPrint(372, "SPACE to serve", white)
        ELSIF state = s_over THEN
            IF pScore > cScore THEN
                CenterPrint(180, "YOU WIN!", green)
            ELSE
                CenterPrint(180, "CPU WINS", red)
            END;
            CenterPrint(204, "SPACE to restart", white)
        END
    END Draw;

BEGIN
    win := tigrWindow(winW, winH, "Pong", 0);
    black  := tigrRGB(0, 0, 0);
    white  := tigrRGB(255, 255, 255);
    green  := tigrRGB(60, 230, 60);
    red    := tigrRGB(255, 60, 60);
    cyan   := tigrRGB(60, 220, 220);
    yellow := tigrRGB(255, 220, 60);

    StartGame;

    WHILE (NOT (tigrClosed(win) > 0)) AND
          (NOT (tigrKeyDown(win, TK_ESCAPE) > 0)) DO
        dt := tigrTime();       (* seconds since the previous call *)

        IF state = s_over THEN
            IF tigrKeyDown(win, TK_SPACE) > 0 THEN
                StartGame
            END
        ELSE
            (* player & manual second paddle *)
            IF tigrKeyHeld(win, ORD('W')) > 0 THEN
                MovePaddle(playerY, FALSE, paddleSpeedV)
            END;
            IF tigrKeyHeld(win, ORD('S')) > 0 THEN
                MovePaddle(playerY, TRUE, paddleSpeedV)
            END;
            IF (tigrKeyHeld(win, TK_UP) > 0) OR
               (tigrKeyHeld(win, TK_DOWN) > 0) THEN
                IF tigrKeyHeld(win, TK_UP) > 0 THEN
                    MovePaddle(cpuY, FALSE, paddleSpeedV)
                END;
                IF tigrKeyHeld(win, TK_DOWN) > 0 THEN
                    MovePaddle(cpuY, TRUE, paddleSpeedV)
                END
            ELSE
                CpuMove
            END;

            IF state = s_serve THEN
                IF tigrKeyDown(win, TK_SPACE) > 0 THEN
                    state := s_play
                END
            ELSE
                MoveBall
            END
        END;

        BuildScoreText;
        Draw;
        tigrUpdate(win)
    END;
    tigrFree(win)
END pong.