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 fire, 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 *)
    playerW = 24;
    playerH = 6;
    bulletW = 3;
    bulletH = 9;
    bombW   = 3;
    bombH   = 8;
    bulletSpeed = 6;
    bombSpeed   = 3;
    moveStep    = 4;
    dropStep    = 10;
    border      = 4;

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 *)
    moveAcc, moveInt : SHORTREAL;
    playerX, playerY : CARDINAL;
    bulletActive    : BOOLEAN;
    bulletX, bulletY : CARDINAL;
    bombActive      : BOOLEAN;
    bombX, bombY    : CARDINAL;
    score, lives    : CARDINAL;
    seed            : CARDINAL;          (* tiny LCG *)
    state           : State;
    lastTime, now   : SHORTREAL;
    dt              : SHORTREAL;
    black, white, red, green, yellow : TPixelType;
    palette         : ARRAY [0..invRows - 1] OF TPixelType;
    row, col, n     : 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;
        moveAcc := 0.0;
        moveInt := 0.55;
        score := 0;
        lives := 3;
        playerX := (winW - playerW) / 2;
        bulletActive := FALSE;
        bombActive := FALSE;
        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;

        (* Speeds up as invaders are destroyed, and may drop a bomb. *)
        cnt := CountAlive();
        moveInt := 0.55 - (SHORTREAL(CountAlive() - 1)
                 * 0.35) / SHORTREAL(invRows * invCols - 1);
        seed := (seed * 1103515245 + 12345) MOD 2147483648;
        IF (NOT bombActive) AND (cnt > 0) AND (seed MOD 3 = 0) THEN
            col := seed MOD invCols;
            row := 0;
            WHILE (row < invRows) AND (NOT alive[row][col]) DO
                row := row + 1
            END;
            IF row < invRows THEN
                bombActive := TRUE;
                bombX := gx + col * cell + (cell - bombW) / 2;
                bombY := gy + row * cell + cell
            END
        END
    END MoveInvaders;

    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        : CARDINAL;
            ix, iy      : CARDINAL;
            overlaps    : BOOLEAN;

    BEGIN
        IF bulletActive THEN
            IF bulletY > border THEN
                bulletY := bulletY - bulletSpeed
            ELSE
                bulletActive := FALSE
            END;
            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;
            IF CountAlive() = 0 THEN
                state := s_win
            END
        END
    END MoveBullet;

    PROCEDURE MoveBomb;

    BEGIN
        IF bombActive THEN
            bombY := bombY + bombSpeed;
            IF bombY >= winH THEN
                bombActive := FALSE
            ELSIF (bombX + bombW > playerX) AND (bombX < playerX + playerW)
                  AND (bombY + bombH > playerY) AND (bombY < playerY + playerH) THEN
                bombActive := FALSE;
                IF lives > 1 THEN
                    lives := lives - 1;
                    playerX := (winW - playerW) / 2
                ELSE
                    lives := 0;
                    state := s_lose
                END
            END
        END
    END MoveBomb;

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

    BEGIN
        tigrFillRect(win, x + 3, y, cell - 6, 3, color);     (* antenna *)
        tigrFillRect(win, x + 1, y + 3, cell - 2, 8, color); (* body *)
        tigrFillRect(win, x + 4, y + 5, 2, 3, black);        (* left eye *)
        tigrFillRect(win, x + 10, y + 5, 2, 3, black);       (* right eye *)
        tigrFillRect(win, x, y + 11, 4, 3, color);           (* feet *)
        tigrFillRect(win, x + 12, y + 11, 4, 3, color)
    END DrawInvader;

    PROCEDURE Draw;

        VAR
            r, c    : CARDINAL;
            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;
        IF bombActive THEN
            tigrFillRect(win, bombX, bombY, bombW, bombH, red)
        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);
    palette[0] := yellow;
    palette[1] := green;
    palette[2] := red;
    palette[3] := white;
    playerY := winH - playerH - 4;

    StartGame;

    lastTime := tigrTime();
    WHILE (NOT (tigrClosed(win) > 0)) AND (NOT (tigrKeyDown(win, TK_ESCAPE) > 0)) DO
        now := tigrTime();
        dt := now - lastTime;
        lastTime := now;

        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;
            IF tigrKeyDown(win, TK_SPACE) > 0 THEN
                Shoot
            END;

            (* Invader ticks *)
            moveAcc := moveAcc + dt;
            WHILE moveAcc >= moveInt DO
                moveAcc := moveAcc - moveInt;
                MoveInvaders
            END;

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

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