Переглянути джерело

Add a Pong game example (no assets)

Eric Streit 3 тижнів тому
батько
коміт
c4fe812d4d
4 змінених файлів з 454 додано та 1 видалено
  1. 22 1
      modula2/ANALYSIS.md
  2. BIN
      modula2/examples/pong/pong
  3. 432 0
      modula2/examples/pong/pong.mod
  4. BIN
      modula2/tigr.o

+ 22 - 1
modula2/ANALYSIS.md

@@ -30,7 +30,9 @@ Verified by building and running on this machine (X11 session):
   live captures: bombs (orange `#FFA028`) raining on every shot and sprite
   frames toggling between frames. `snake` (new, no assets) is a classic
   Snake game on an 8px grid - verified moving, eating/growing and the
-  wall-collision "GAME OVER" state. `essai4.mod` is
+  wall-collision "GAME OVER" state. `pong` (new, no assets) is a classic
+  Pong game in a 640x400 window - verified serves, wall/paddle bounces,
+  scoring and the match-over restart. `essai4.mod` is
   not a tigr example: it is a standalone PIM-style bit-twiddling test
   (`SHIFT`/`AND`/`OR` on `CARDINAL`) that the ISO dialect does not accept -
   left as is.
@@ -193,6 +195,13 @@ exist. All four were ported and verified:
   speed increases with score. Verified live: head advances one cell per
   step, eating grows it by one cell (forced food in the head's line), and a
   straight run ends in "GAME OVER" with the head frozen at the wall.
+- `pong/pong.mod` (new, no assets) - classic Pong in a 640x400 window.
+  Two-player capable: W/S move the left paddle, UP/DOWN take over the
+  right paddle from the CPU opponent. Ball and paddle positions are
+  `SHORTREAL`, moved with `tigrTime` deltas; the ball speeds up (x1.08,
+  capped) on every paddle hit and bounces off the paddle surface at an
+  angle derived from the impact offset; first to 5 points wins. Verified
+  live: serving, wall/paddle bounces, scoring and match restart all work.
 
 GM2 gotchas encountered:
 
@@ -215,6 +224,18 @@ GM2 gotchas encountered:
   "now" you then difference, or timers effectively never fire (seen in the
   first `invaders` version: `dt = now - lastTime` collapsed to ~0 and bombs
   never spawned).
+- GM2 16.0.1 (experimental, 2026-03-25) internal-compiler-errors
+  (`wide_int_to_tree_1` at `tree.cc:1900`, via `fold_negate_const`) when
+  folding constant integer arithmetic: a compile-time `a - b` or a negated
+  integer literal (e.g. `Serve(-1)`, `winH - 28`, `winW / 2 - 20`) crashes
+  `cc1gm2`. Workarounds used in `pong.mod`: keep `CONST` entries as plain
+  literals, use precomputed literals at call sites
+  (`CenterPrint(372, ...)`), and pass directions as `BOOLEAN` (`TRUE` =
+  down/right, `FALSE` = up/left) instead of `-1`/`1` `INTEGER` literals.
+  Negating runtime variables (`-bvy`, `-diff`) is fine.
+- Real-typed comparisons need real literals: `bvx > 0.0`, not `bvx > 0`
+  (the latter is an ordinary ISO type error, `SHORTREAL` vs `INTEGER`,
+  not a compiler bug).
 
 ## Notes / minor oddities
 

BIN
modula2/examples/pong/pong


+ 432 - 0
modula2/examples/pong/pong.mod

@@ -0,0 +1,432 @@
+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.

BIN
modula2/tigr.o