SDL3-m2/showcases/showcase_snake.mod

MODULE showcase_snake ;

(*
   m2SDL3 demo, ported from SDL upstream examples/demo/01-snake
   (public domain): the classic Snake game on a 24x18 board.

   Arrows steer, R restarts, Q or Escape quits. The board packs
   each cell into 3 bits (7 = 162 bytes); collisions restart.

   SDL3 native notes
   - SDL_FRect (SHORTREAL) rects via MakeFRect; Uint64 ms ticks
     come from SDL_GetTicks (64 bit in SDL3).
   - Keyboard arrives decoded via SDL3Utils.PollM2Event (type at
     offset 0, keycode at offset 28); keycodes in SDL3Key.
   - Window close buttons decode as evQuit too.
   - Callback structure flattened into a main loop with a 30 s cap
     so the demo also terminates unattended.
*)

FROM SYSTEM IMPORT CARDINAL8;
FROM SDL3 IMPORT SDL_Init, SDL_Quit, SDL_Delay,
   SDL_GetTicks, SDLInitVideo, SDLInitEvents;
FROM SDL3Video IMPORT WindowHandle, SDL_DestroyWindow, WindowResizable;
FROM SDL3Render IMPORT RendererHandle,
   SDL_CreateWindowAndRenderer, SDL_DestroyRenderer,
   SDL_SetRenderDrawColor, SDL_RenderClear, SDL_RenderPresent,
   SDL_SetRenderLogicalPresentation, LogicalLetterbox,
   SDL_RenderFillRect;
FROM SDL3Rect IMPORT SDLFRect, MakeFRect;
FROM SDL3Utils IMPORT PollM2Event, M2Event, evQuit, evKey;
FROM SDL3Key IMPORT KeyEscape, KeyQ, KeyR,
   KeyRight, KeyLeft, KeyDown, KeyUp;
FROM libc IMPORT printf, rand, srand;

CONST StepMs = 125; BlockPx = 24; GW = 24; GH = 18; MaxMs = 30000;
CONST WinW = GW * BlockPx; WinH = GH * BlockPx;
CONST CellNothing = 0; CellRight = 1; CellUp = 2;
CONST CellLeft = 3; CellDown = 4; CellFood = 5;
CONST DirRight = 0; DirUp = 1; DirLeft = 2; DirDown = 3;

VAR
   cells: ARRAY [0..161] OF CARDINAL8;
   pow2: ARRAY [0..7] OF CARDINAL;
   headX, headY, tailX, tailY, nextDir, inhibit: INTEGER;
   occupied: CARDINAL;
   win: WindowHandle;
   ren: RendererHandle;

PROCEDURE CellAt (x, y: INTEGER) : CARDINAL;
VAR shift, byte, adj, range: CARDINAL;
BEGIN
   shift := VAL(CARDINAL, x + y * GW) * 3;
   byte := shift DIV 8;
   adj := shift MOD 8;
   range := VAL(CARDINAL, cells[byte])
          + VAL(CARDINAL, cells[byte+1]) * 256;
   RETURN range DIV pow2[adj] MOD 8
END CellAt;

PROCEDURE PutCell (x, y: INTEGER; ct: CARDINAL);
VAR shift, byte, adj, range, p: CARDINAL;
BEGIN
   shift := VAL(CARDINAL, x + y * GW) * 3;
   byte := shift DIV 8;
   adj := shift MOD 8;
   range := VAL(CARDINAL, cells[byte])
          + VAL(CARDINAL, cells[byte+1]) * 256;
   p := pow2[adj];
   range := range DIV (p * 8) * (p * 8) + range MOD p + ct * p;
   cells[byte] := VAL(CARDINAL8, range MOD 256);
   cells[byte+1] := VAL(CARDINAL8, range DIV 256)
END PutCell;

PROCEDURE NewFood;
VAR x, y: INTEGER;
BEGIN
   LOOP
      x := rand() MOD GW;
      y := rand() MOD GH;
      IF CellAt(x, y) = CellNothing THEN
         PutCell(x, y, CellFood);
         EXIT
      END
   END
END NewFood;

PROCEDURE SnakeInit;
VAR i: INTEGER;
BEGIN
   FOR i := 0 TO 161 DO cells[i] := VAL(CARDINAL8, 0) END;
   headX := GW DIV 2; tailX := headX;
   headY := GH DIV 2; tailY := headY;
   nextDir := DirRight;
   inhibit := 4;
   occupied := 4; DEC(occupied);
   PutCell(tailX, tailY, CellRight);
   FOR i := 0 TO 3 DO NewFood; INC(occupied) END
END SnakeInit;

PROCEDURE SnakeRedir (dir: INTEGER);
VAR ct: CARDINAL;
BEGIN
   ct := CellAt(headX, headY);
   IF ((dir = DirRight) AND (ct # CellLeft))
      OR ((dir = DirUp) AND (ct # CellDown))
      OR ((dir = DirLeft) AND (ct # CellRight))
      OR ((dir = DirDown) AND (ct # CellUp)) THEN
      nextDir := dir
   END
END SnakeRedir;

PROCEDURE Wrap (VAR v: INTEGER; max: INTEGER);
BEGIN
   IF v < 0 THEN v := max - 1
   ELSIF v > max - 1 THEN v := 0 END
END Wrap;

PROCEDURE SnakeStep;
VAR dirCell, ct: CARDINAL; px, py: INTEGER;
BEGIN
   dirCell := VAL(CARDINAL, nextDir + 1);
   DEC(inhibit);
   IF inhibit = 0 THEN
      INC(inhibit);
      ct := CellAt(tailX, tailY);
      PutCell(tailX, tailY, CellNothing);
      IF ct = CellRight THEN INC(tailX)
      ELSIF ct = CellUp THEN DEC(tailY)
      ELSIF ct = CellLeft THEN DEC(tailX)
      ELSIF ct = CellDown THEN INC(tailY) END;
      Wrap(tailX, GW);
      Wrap(tailY, GH)
   END;
   px := headX; py := headY;
   IF nextDir = DirRight THEN INC(headX)
   ELSIF nextDir = DirUp THEN DEC(headY)
   ELSIF nextDir = DirLeft THEN DEC(headX)
   ELSIF nextDir = DirDown THEN INC(headY) END;
   Wrap(headX, GW);
   Wrap(headY, GH);
   ct := CellAt(headX, headY);
   IF (ct # CellNothing) AND (ct # CellFood) THEN
      SnakeInit;
      RETURN
   END;
   PutCell(px, py, dirCell);
   PutCell(headX, headY, dirCell);
   IF ct = CellFood THEN
      IF occupied = VAL(CARDINAL, GW * GH) THEN
         SnakeInit;
         RETURN
      END;
      NewFood;
      INC(inhibit);
      INC(occupied)
   END
END SnakeStep;

PROCEDURE HandleSym (sym: INTEGER; VAR quit: BOOLEAN);
BEGIN
   IF sym = KeyEscape THEN quit := TRUE
   ELSIF sym = KeyQ THEN quit := TRUE
   ELSIF sym = KeyR THEN SnakeInit
   ELSIF sym = KeyRight THEN SnakeRedir(DirRight)
   ELSIF sym = KeyUp THEN SnakeRedir(DirUp)
   ELSIF sym = KeyLeft THEN SnakeRedir(DirLeft)
   ELSIF sym = KeyDown THEN SnakeRedir(DirDown) END
END HandleSym;

PROCEDURE DrawBoard;
VAR gx, gy: INTEGER; ct: CARDINAL; r: SDLFRect;
BEGIN
   SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 0), VAL(CARDINAL8, 0),
                          VAL(CARDINAL8, 0), VAL(CARDINAL8, 255));
   SDL_RenderClear(ren);
   FOR gy := 0 TO GH - 1 DO
      FOR gx := 0 TO GW - 1 DO
         ct := CellAt(gx, gy);
         IF ct # CellNothing THEN
            r := MakeFRect(VAL(SHORTREAL, VAL(REAL, gx * BlockPx)),
                           VAL(SHORTREAL, VAL(REAL, gy * BlockPx)),
                           VAL(SHORTREAL, VAL(REAL, BlockPx)),
                           VAL(SHORTREAL, VAL(REAL, BlockPx)));
            IF ct = CellFood THEN
               SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 80),
                                      VAL(CARDINAL8, 80),
                                      VAL(CARDINAL8, 255),
                                      VAL(CARDINAL8, 255))
            ELSE
               SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 0),
                                      VAL(CARDINAL8, 128),
                                      VAL(CARDINAL8, 0),
                                      VAL(CARDINAL8, 255))
            END;
            SDL_RenderFillRect(ren, r)
         END
      END
   END;
   r := MakeFRect(VAL(SHORTREAL, VAL(REAL, headX * BlockPx)),
                  VAL(SHORTREAL, VAL(REAL, headY * BlockPx)),
                  VAL(SHORTREAL, VAL(REAL, BlockPx)),
                  VAL(SHORTREAL, VAL(REAL, BlockPx)));
   SDL_SetRenderDrawColor(ren, VAL(CARDINAL8, 255), VAL(CARDINAL8, 255),
                          VAL(CARDINAL8, 0), VAL(CARDINAL8, 255));
   SDL_RenderFillRect(ren, r);
   SDL_RenderPresent(ren)
END DrawBoard;

VAR
   ev: M2Event;
   quit: BOOLEAN;
   start, now, lastStep: LONGCARD;
   i: INTEGER;

BEGIN
   FOR i := 0 TO 7 DO
      IF i = 0 THEN pow2[0] := 1 ELSE pow2[i] := pow2[i-1] * 2 END
   END;
   srand(VAL(INTEGER, SDL_GetTicks()));
   IF NOT SDL_Init(SDLInitVideo + SDLInitEvents) THEN
      printf("showcase_snake: SDL_Init failed\n");
      HALT(1)
   END;
   IF NOT SDL_CreateWindowAndRenderer("m2SDL3 snake",
                                      WinW, WinH,
                                      VAL(LONGCARD, WindowResizable),
                                      win, ren) THEN
      printf("showcase_snake: CreateWindowAndRenderer failed\n");
      SDL_Quit;
      HALT(1)
   END;
   SDL_SetRenderLogicalPresentation(ren, WinW, WinH, LogicalLetterbox);

   SnakeInit;
   printf("showcase_snake: arrows steer, R restarts, Q quits\n");
   quit := FALSE;
   start := SDL_GetTicks();
   lastStep := start;
   WHILE NOT quit DO
      WHILE PollM2Event(ev) DO
         IF ev.kind = evQuit THEN quit := TRUE
         ELSIF (ev.kind = evKey) AND ev.pressed THEN
            HandleSym(ev.sym, quit)
         END
      END;
      now := SDL_GetTicks();
      WHILE now - lastStep >= VAL(LONGCARD, StepMs) DO
         SnakeStep;
         lastStep := lastStep + VAL(LONGCARD, StepMs)
      END;
      DrawBoard;
      IF now - start > VAL(LONGCARD, MaxMs) THEN quit := TRUE END;
      SDL_Delay(16)
   END;

   SDL_DestroyRenderer(ren);
   SDL_DestroyWindow(win);
   SDL_Quit;
   printf("showcase_snake: bye\n")
END showcase_snake.