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

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.