Просмотр исходного кода

Add a Snake game example (no assets)

Eric Streit 3 недель назад
Родитель
Сommit
7d6a9b4670
3 измененных файлов с 318 добавлено и 1 удалено
  1. 11 1
      modula2/ANALYSIS.md
  2. BIN
      modula2/examples/snake/snake
  3. 307 0
      modula2/examples/snake/snake.mod

+ 11 - 1
modula2/ANALYSIS.md

@@ -28,7 +28,9 @@ Verified by building and running on this machine (X11 session):
   the built-in font: two-frame invader animation, accelerating movement,
   aimed multiple bombs, bullet-vs-bomb scoring and autofire. Verified in
   live captures: bombs (orange `#FFA028`) raining on every shot and sprite
-  frames toggling between frames. `essai4.mod` is
+  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
   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.
@@ -184,6 +186,13 @@ exist. All four were ported and verified:
   + `tigrSetPostFX`/`tigrTime` loop ("Shady" window). Needs
   `size := HIGH(fxShader)` (gm2 computes the literal's length - there is no
   `LENGTH`/`strlen` for `ARRAY OF CHAR` in ISO M2).
+- `snake/snake.mod` (new, no assets) - classic Snake on an 8px grid in the
+  320x240 window. Fixed-size body arrays (whole board = win condition),
+  per-tick pending turn stored as `INTEGER` deltas (no 180 degree reversal),
+  deterministic LCG food placement, `tigrTime`-deltas to pace movement,
+  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.
 
 GM2 gotchas encountered:
 
@@ -195,6 +204,7 @@ GM2 gotchas encountered:
   generates the plain C names and links straight against `-lGL`.
 - ISO Modula-2 has no `CARDINAL`/`INTEGER` bitwise `AND`/`OR`/`SHIFT`; use
   `CAST(BITSET, n) * ...` (intersection) / `+` (union).
+- There is no `DOWNTO` in ISO: write `FOR k := n - 1 TO 1 BY -1 DO`.
 - Adjacent string literals are **not** concatenated under ISO - keep strings
   on one line (done for the `fxShader`).
 - `SHORTREAL` literals (`1.0`) pass straight into C `float` parameters.

BIN
modula2/examples/snake/snake


+ 307 - 0
modula2/examples/snake/snake.mod

@@ -0,0 +1,307 @@
+MODULE snake;
+
+(* Classic Snake using the tigr Modula-2 binding. No assets: everything
+   is drawn with tigrFillRect, built-in font. Fixed grid of 8px cells
+   over a 320x240 window (40 x 30 cells).
+
+   Controls: ARROWS steer (no 180 degree reversal), SPACE restarts
+   after game over, ESC quits. Speed increases with score.
+
+   Compilation (from modula2/):
+       gcc -c tigr.c
+       gm2 -fiso -c helper.mod
+       gm2 -fiso -I. tigr.o helper.o examples/snake/snake.mod \
+           -o examples/snake/snake -lGL -lX11
+*)
+
+FROM tigr IMPORT TigrPtr, tigrWindow, tigrFree, tigrClosed, tigrClear,
+                tigrUpdate, TPixelType, tigrFillRect, tigrPrint, tfont,
+                tigrKeyDown, tigrTime, tigrTextWidth,
+                TK_ESCAPE, TK_SPACE, TK_LEFT, TK_RIGHT, TK_UP, TK_DOWN;
+FROM helper IMPORT tigrRGB;
+
+CONST
+    winW    = 320;
+    winH    = 240;
+    cell    = 8;               (* grid cell in pixels *)
+    cols    = winW / cell;     (* 40 *)
+    rows    = winH / cell;     (* 30 *)
+    maxLen  = cols * rows;     (* whole board = win condition *)
+    startLen = 3;
+
+TYPE
+    State = (s_play, s_win, s_lose);
+
+VAR
+    win             : TigrPtr;
+    segX, segY      : ARRAY [0..maxLen - 1] OF CARDINAL;
+    length          : CARDINAL;
+    dirX, dirY      : INTEGER;      (* -1/0/1 current direction *)
+    nextDX, nextDY  : INTEGER;      (* pending turn, consumed per tick *)
+    foodX, foodY    : CARDINAL;
+    score           : CARDINAL;
+    growing         : BOOLEAN;
+    seed            : CARDINAL;     (* tiny LCG *)
+    state           : State;
+    moveAcc, moveInt : SHORTREAL;
+    dt              : SHORTREAL;    (* tigrTime: delta since last call *)
+    black, white, red, green, head, yellow : TPixelType;
+    i, k, n         : CARDINAL;
+    nx, ny          : INTEGER;
+    scoreText       : ARRAY [0..20] OF CHAR;
+    msgbuf          : ARRAY [0..60] 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;
+            tmp  : ARRAY [0..10] OF CHAR;
+
+    BEGIN
+        IF v = 0 THEN
+            s[0] := '0';
+            s[1] := 0C;
+            RETURN
+        END;
+        m := 0;
+        WHILE v > 0 DO
+            tmp[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] := tmp[m];
+            j := j + 1
+        END;
+        s[j] := 0C
+    END CardToText;
+
+    PROCEDURE StartGame;
+
+        VAR
+            c : CARDINAL;
+
+    BEGIN
+        length := startLen;
+        FOR c := 0 TO startLen - 1 DO
+            segX[c] := 10 - c;
+            segY[c] := rows / 2
+        END;
+        dirX := 1;
+        dirY := 0;
+        nextDX := 0;
+        nextDY := 0;
+        growing := FALSE;
+        score := 0;
+        moveAcc := 0.0;
+        moveInt := 0.25;
+        seed := 7;
+        state := s_play;
+        PlaceFood
+    END StartGame;
+
+    PROCEDURE PlaceFood;
+
+    (* Random free cell for the food. *)
+
+        VAR
+            tries : CARDINAL;
+            occ   : BOOLEAN;
+
+    BEGIN
+        tries := 0;
+        occ := TRUE;
+        WHILE occ AND (tries < maxLen) DO
+            seed := (seed * 1103515245 + 12345) MOD 2147483648;
+            foodX := seed MOD cols;
+            foodY := (seed DIV 7) MOD rows;
+            occ := FALSE;
+            i := 0;
+            WHILE (i < length) AND (NOT occ) DO
+                IF (segX[i] = foodX) AND (segY[i] = foodY) THEN
+                    occ := TRUE
+                END;
+                i := i + 1
+            END;
+            tries := tries + 1
+        END
+    END PlaceFood;
+
+    PROCEDURE StepSnake;
+
+    (* One cell of movement: apply pending turn, check wall/self
+       collision, move the head and shift the body. *)
+
+        VAR
+            hitSelf  : BOOLEAN;
+            limit, j : CARDINAL;
+
+    BEGIN
+        IF (nextDX # 0) OR (nextDY # 0) THEN
+            IF NOT ((nextDX = -dirX) AND (nextDY = -dirY)) THEN
+                dirX := nextDX;
+                dirY := nextDY
+            END;
+            nextDX := 0;
+            nextDY := 0
+        END;
+
+        nx := INTEGER(segX[0]) + dirX;
+        ny := INTEGER(segY[0]) + dirY;
+        IF (nx < 0) OR (nx >= INTEGER(cols))
+           OR (ny < 0) OR (ny >= INTEGER(rows)) THEN
+            state := s_lose;
+            RETURN
+        END;
+
+        (* A tail cell vacates this tick unless we grow. *)
+        hitSelf := FALSE;
+        IF growing THEN
+            limit := length
+        ELSE
+            limit := length - 1
+        END;
+        i := 0;
+        WHILE (i < limit) AND (NOT hitSelf) DO
+            IF (segX[i] = CARDINAL(nx)) AND (segY[i] = CARDINAL(ny)) THEN
+                hitSelf := TRUE
+            END;
+            i := i + 1
+        END;
+        IF hitSelf THEN
+            state := s_lose;
+            RETURN
+        END;
+
+        IF growing THEN
+            growing := FALSE;
+            length := length + 1;
+            IF length = maxLen THEN
+                state := s_win
+            END
+        END;
+        FOR k := length - 1 TO 1 BY -1 DO
+            segX[k] := segX[k - 1];
+            segY[k] := segY[k - 1]
+        END;
+        segX[0] := CARDINAL(nx);
+        segY[0] := CARDINAL(ny);
+
+        IF (segX[0] = foodX) AND (segY[0] = foodY) THEN
+            growing := TRUE;
+            score := score + 1;
+            PlaceFood;
+            moveInt := 0.25 - SHORTREAL(score) * 0.005;
+            IF moveInt < 0.06 THEN
+                moveInt := 0.06
+            END
+        END
+    END StepSnake;
+
+    PROCEDURE Draw;
+
+        VAR
+            tw   : INTEGER;
+            msgX : CARDINAL;
+
+    BEGIN
+        tigrClear(win, black);
+        FOR i := 0 TO length - 1 DO
+            IF i = 0 THEN
+                tigrFillRect(win, segX[0] * cell, segY[0] * cell,
+                             cell, cell, head)
+            ELSE
+                tigrFillRect(win, segX[i] * cell, segY[i] * cell,
+                             cell, cell, green)
+            END
+        END;
+        tigrFillRect(win, foodX * cell, foodY * cell, cell, cell, red);
+
+        scoreText := "SCORE ";
+        CardToText(score, msgbuf);
+        n := 6;
+        WHILE msgbuf[n - 6] # 0C DO
+            scoreText[n] := msgbuf[n - 6];
+            n := n + 1
+        END;
+        scoreText[n] := 0C;
+        tigrPrint(win, tfont, 6, 4, white, scoreText);
+        tigrPrint(win, tfont, 6, 14, yellow,
+                  "ARROWS steer SPACE restart ESC quit");
+
+        IF state = s_win THEN
+            tw := tigrTextWidth(tfont, "YOU WIN");
+            IF tw < INTEGER(winW) THEN
+                msgX := (winW - CARDINAL(tw)) / 2
+            ELSE
+                msgX := 0
+            END;
+            tigrPrint(win, tfont, msgX, 110, green, "YOU WIN")
+        ELSIF state = s_lose THEN
+            tw := tigrTextWidth(tfont, "GAME OVER");
+            IF tw < INTEGER(winW) THEN
+                msgX := (winW - CARDINAL(tw)) / 2
+            ELSE
+                msgX := 0
+            END;
+            tigrPrint(win, tfont, msgX, 110, red, "GAME OVER");
+            tw := tigrTextWidth(tfont, "SPACE to restart");
+            IF tw < INTEGER(winW) THEN
+                msgX := (winW - CARDINAL(tw)) / 2
+            ELSE
+                msgX := 0
+            END;
+            tigrPrint(win, tfont, msgX, 130, white, "SPACE to restart")
+        END
+    END Draw;
+
+BEGIN
+    win := tigrWindow(winW, winH, "Snake", 0);
+    black := tigrRGB(0, 0, 0);
+    white := tigrRGB(255, 255, 255);
+    red   := tigrRGB(255, 60, 60);
+    green := tigrRGB(60, 230, 60);
+    head  := tigrRGB(160, 255, 160);
+    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_play THEN
+            IF tigrKeyDown(win, TK_LEFT) > 0 THEN
+                nextDX := -1;
+                nextDY := 0
+            ELSIF tigrKeyDown(win, TK_RIGHT) > 0 THEN
+                nextDX := 1;
+                nextDY := 0
+            ELSIF tigrKeyDown(win, TK_UP) > 0 THEN
+                nextDX := 0;
+                nextDY := -1
+            ELSIF tigrKeyDown(win, TK_DOWN) > 0 THEN
+                nextDX := 0;
+                nextDY := 1
+            END;
+
+            moveAcc := moveAcc + dt;
+            WHILE moveAcc >= moveInt DO
+                moveAcc := moveAcc - moveInt;
+                StepSnake;
+                IF state # s_play THEN
+                    moveAcc := 0.0
+                END
+            END
+        ELSIF tigrKeyDown(win, TK_SPACE) > 0 THEN
+            StartGame
+        END;
+
+        Draw;
+        tigrUpdate(win)
+    END;
+    tigrFree(win)
+END snake.