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

MODULE invaders;

(* Simple "Space Invaders" using the tigr Modula-2 binding.
   No assets: everything is drawn with tigrFillRect. Built-in font.
   Controls: LEFT/RIGHT move, SPACE hold to autofire, R restart
   (after game over), ESC quit.

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

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

CONST
    winW = 320;
    winH = 240;
    invRows   = 4;
    invCols   = 8;
    cell      = 16;          (* invader sprite box *)
    maxBombs  = 5;
    playerW   = 24;
    playerH   = 6;
    bulletW   = 3;
    bulletH   = 9;
    bombW     = 3;
    bombH     = 8;
    bulletSpeed = 6;
    bombSpeed   = 4;
    moveStep    = 4;
    dropStep    = 12;
    border      = 4;
    autofire    = 0.3;

TYPE
    State = (s_play, s_win, s_lose);

VAR
    win             : TigrPtr;
    alive           : ARRAY [0..invRows - 1] OF ARRAY [0..invCols - 1] OF BOOLEAN;
    gx, gy          : CARDINAL;          (* invader grid origin *)
    dir             : INTEGER;           (* -1 left, +1 right *)
    frame           : CARDINAL;          (* 0/1 invader sprite frame *)
    moveAcc, moveInt : SHORTREAL;
    fireAcc         : SHORTREAL;
    playerX, playerY : CARDINAL;
    bulletActive    : BOOLEAN;
    bulletX, bulletY : CARDINAL;
    bombFlags       : ARRAY [0..maxBombs - 1] OF BOOLEAN;
    bombX, bombY    : ARRAY [0..maxBombs - 1] OF CARDINAL;
    score, lives    : CARDINAL;
    seed            : CARDINAL;          (* tiny LCG *)
    state           : State;
    dt              : SHORTREAL;         (* tigrTime: delta since last call *)
    black, white, red, green, yellow, bombColor : TPixelType;
    palette         : ARRAY [0..invRows - 1] OF TPixelType;
    row, col, n, slot : CARDINAL;
    scoreText       : ARRAY [0..20] OF CHAR;
    msgbuf          : ARRAY [0..60] OF CHAR;

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

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

        VAR
            k    : CARDINAL;
            tmp  : ARRAY [0..10] OF CHAR;
            j    : CARDINAL;

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

    PROCEDURE StartGame;

        VAR
            r, c : CARDINAL;

    BEGIN
        gx := 32;
        gy := 20;
        dir := 1;
        frame := 0;
        moveAcc := 0.0;
        moveInt := 0.5;
        fireAcc := 0.0;
        score := 0;
        lives := 3;
        playerX := (winW - playerW) / 2;
        bulletActive := FALSE;
        FOR slot := 0 TO maxBombs - 1 DO
            bombFlags[slot] := FALSE
        END;
        seed := 1;
        state := s_play;
        FOR r := 0 TO invRows - 1 DO
            FOR c := 0 TO invCols - 1 DO
                alive[r][c] := TRUE
            END
        END
    END StartGame;

    PROCEDURE CountAlive() : CARDINAL;

        VAR
            r, c, cnt : CARDINAL;

    BEGIN
        cnt := 0;
        FOR r := 0 TO invRows - 1 DO
            FOR c := 0 TO invCols - 1 DO
                IF alive[r][c] THEN
                    cnt := cnt + 1
                END
            END
        END;
        RETURN cnt
    END CountAlive;

    PROCEDURE MoveInvaders;

        VAR
            hitBound : BOOLEAN;
            cnt      : CARDINAL;

    BEGIN
        IF dir < 0 THEN
            hitBound := gx < (border + moveStep)
        ELSE
            hitBound := gx + moveStep + invCols * cell > winW - border
        END;
        IF hitBound THEN
            gy := gy + dropStep;
            dir := -dir;
            IF gy + invRows * cell + 8 >= winH THEN
                state := s_lose
            END
        ELSE
            IF dir < 0 THEN
                gx := gx - moveStep
            ELSE
                gx := gx + moveStep
            END
        END;
        frame := 1 - frame;

        (* Speeds up as invaders are destroyed. *)
        cnt := CountAlive();
        IF cnt > 0 THEN
            moveInt := 0.5 - (SHORTREAL(cnt - 1)
                     * 0.38) / SHORTREAL(invRows * invCols - 1)
        END
    END MoveInvaders;

    PROCEDURE TrySpawnBomb;

    (* Drops a bomb from a surviving invader, some aimed at the player. *)

        VAR
            tgtCol, r2 : CARDINAL;
            tgt        : INTEGER;
            aim        : BOOLEAN;

    BEGIN
        slot := 0;
        WHILE (slot < maxBombs) AND bombFlags[slot] DO
            slot := slot + 1
        END;
        IF slot = maxBombs THEN
            RETURN
        END;
        seed := (seed * 1103515245 + 12345) MOD 2147483648;
        aim := seed MOD 4 = 0;
        IF aim THEN
            tgt := INTEGER(playerX + playerW / 2) - INTEGER(gx);
            IF tgt < 0 THEN
                tgtCol := 0
            ELSIF tgt >= INTEGER(invCols * cell) THEN
                tgtCol := invCols - 1
            ELSE
                tgtCol := tgt / cell
            END
        ELSE
            tgtCol := seed MOD invCols
        END;
        r2 := 0;
        WHILE (r2 < invRows) AND (NOT alive[r2][tgtCol]) DO
            r2 := r2 + 1
        END;
        IF r2 < invRows THEN
            bombFlags[slot] := TRUE;
            bombX[slot] := gx + tgtCol * cell + (cell - bombW) / 2;
            bombY[slot] := gy + r2 * cell + cell
        END
    END TrySpawnBomb;

    PROCEDURE Shoot;

    BEGIN
        IF NOT bulletActive THEN
            bulletActive := TRUE;
            bulletX := playerX + playerW / 2 - bulletW / 2;
            bulletY := playerY - bulletH
        END
    END Shoot;

    PROCEDURE MoveBullet;

        VAR
            r, c, ix, iy : CARDINAL;
            overlaps     : BOOLEAN;
            slot2        : CARDINAL;

    BEGIN
        IF bulletActive THEN
            IF bulletY > border THEN
                bulletY := bulletY - bulletSpeed
            ELSE
                bulletActive := FALSE
            END;

            (* Versus invaders. *)
            overlaps := FALSE;
            r := 0;
            WHILE (r < invRows) AND (NOT overlaps) DO
                c := 0;
                WHILE (c < invCols) AND (NOT overlaps) DO
                    IF alive[r][c] THEN
                        ix := gx + c * cell;
                        iy := gy + r * cell;
                        IF (bulletX + bulletW > ix) AND (bulletX < ix + cell)
                           AND (bulletY < iy + cell) AND (bulletY + bulletH > iy) THEN
                            alive[r][c] := FALSE;
                            score := score + 10;
                            overlaps := TRUE
                        END
                    END;
                    c := c + 1
                END;
                r := r + 1
            END;
            IF overlaps THEN
                bulletActive := FALSE
            END;

            (* Versus bombs (shoot them down for +5). *)
            IF bulletActive THEN
                slot2 := 0;
                WHILE slot2 < maxBombs DO
                    IF bombFlags[slot2]
                       AND (bulletX + bulletW > bombX[slot2])
                       AND (bulletX < bombX[slot2] + bombW)
                       AND (bulletY + bulletH > bombY[slot2])
                       AND (bulletY < bombY[slot2] + bombH) THEN
                        bombFlags[slot2] := FALSE;
                        score := score + 5;
                        bulletActive := FALSE;
                        slot2 := maxBombs
                    ELSE
                        slot2 := slot2 + 1
                    END
                END
            END;

            IF CountAlive() = 0 THEN
                state := s_win
            END
        END
    END MoveBullet;

    PROCEDURE MoveBombs;

    BEGIN
        FOR slot := 0 TO maxBombs - 1 DO
            IF bombFlags[slot] THEN
                bombY[slot] := bombY[slot] + bombSpeed;
                IF bombY[slot] >= winH THEN
                    bombFlags[slot] := FALSE
                ELSIF (bombX[slot] + bombW > playerX)
                      AND (bombX[slot] < playerX + playerW)
                      AND (bombY[slot] + bombH > playerY)
                      AND (bombY[slot] < playerY + playerH) THEN
                    bombFlags[slot] := FALSE;
                    IF lives > 1 THEN
                        lives := lives - 1;
                        playerX := (winW - playerW) / 2
                    ELSE
                        lives := 0;
                        state := s_lose
                    END
                END
            END
        END
    END MoveBombs;

    PROCEDURE DrawInvader(x, y : CARDINAL; color : TPixelType);

    (* Two classic invader frames, toggled on every move step. *)

    BEGIN
        IF frame = 0 THEN
            tigrFillRect(win, x + 3, y, 2, 3, color);       (* antenna up *)
            tigrFillRect(win, x + 11, y, 2, 3, color);
            tigrFillRect(win, x + 1, y + 3, cell - 2, 8, color); (* body *)
            tigrFillRect(win, x + 4, y + 5, 2, 3, black);   (* eyes *)
            tigrFillRect(win, x + 10, y + 5, 2, 3, black);
            tigrFillRect(win, x, y + 11, 4, 3, color);      (* feet out *)
            tigrFillRect(win, x + 12, y + 11, 4, 3, color)
        ELSE
            tigrFillRect(win, x + 3, y + 1, 2, 2, color);   (* antenna down *)
            tigrFillRect(win, x + 11, y + 1, 2, 2, color);
            tigrFillRect(win, x + 1, y + 3, cell - 2, 8, color);
            tigrFillRect(win, x + 4, y + 5, 2, 3, black);
            tigrFillRect(win, x + 10, y + 5, 2, 3, black);
            tigrFillRect(win, x + 2, y + 11, 3, 3, color);  (* feet tucked *)
            tigrFillRect(win, x + 11, y + 11, 3, 3, color)
        END
    END DrawInvader;

    PROCEDURE Draw;

        VAR
            r, c, ix, iy : CARDINAL;
            tw           : INTEGER;
            msgX         : CARDINAL;

    BEGIN
        tigrClear(win, black);
        FOR r := 0 TO invRows - 1 DO
            FOR c := 0 TO invCols - 1 DO
                IF alive[r][c] THEN
                    ix := gx + c * cell;
                    iy := gy + r * cell;
                    DrawInvader(ix, iy, palette[r])
                END
            END
        END;
        tigrFillRect(win, playerX, playerY, playerW, playerH, green);
        tigrFillRect(win, playerX + (playerW - 4) / 2, playerY - 5, 4, 5, green);
        IF bulletActive THEN
            tigrFillRect(win, bulletX, bulletY, bulletW, bulletH, white)
        END;
        FOR slot := 0 TO maxBombs - 1 DO
            IF bombFlags[slot] THEN
                tigrFillRect(win, bombX[slot], bombY[slot], bombW, bombH,
                             bombColor)
            END
        END;

        scoreText := "SCORE ";
        CardToText(score * 10, 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,
                  "L/R move SPACE fire 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");
            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")
        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, "Space Invaders", 0);
    black      := tigrRGB(0, 0, 0);
    white      := tigrRGB(255, 255, 255);
    red        := tigrRGB(255, 60, 60);
    green      := tigrRGB(60, 230, 60);
    yellow     := tigrRGB(255, 220, 60);
    bombColor  := tigrRGB(255, 160, 40);
    palette[0] := yellow;
    palette[1] := green;
    palette[2] := red;
    palette[3] := white;
    playerY := winH - playerH - 4;

    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
            (* Player movement *)
            IF (tigrKeyHeld(win, TK_LEFT) > 0) AND (playerX > border) THEN
                playerX := playerX - 3
            END;
            IF (tigrKeyHeld(win, TK_RIGHT) > 0) AND
               (playerX + playerW < winW - border) THEN
                playerX := playerX + 3
            END;
            fireAcc := fireAcc + dt;
            IF (tigrKeyDown(win, TK_SPACE) > 0)
               OR ((tigrKeyHeld(win, TK_SPACE) > 0) AND (fireAcc >= autofire)) THEN
                Shoot;
                fireAcc := 0.0
            END;

            (* Invader ticks: move, then rain up to two bombs. *)
            moveAcc := moveAcc + dt;
            WHILE moveAcc >= moveInt DO
                moveAcc := moveAcc - moveInt;
                MoveInvaders;
                TrySpawnBomb;
                TrySpawnBomb
            END;

            MoveBullet;
            MoveBombs
        ELSIF tigrKeyDown(win, TK_SPACE) > 0 THEN
            StartGame
        END;

        Draw;
        tigrUpdate(win)
    END;
    tigrFree(win)
END invaders.