SD2-m2/showcases/showcase_snake.mod

MODULE showcase_snake ;

(*
   m2SDL demo, ported from SDL-main examples/demo/01-snake/snake.c
   (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 -> SDL2 adaptations
   - SDL_RenderFillRect becomes SDL_RenderDrawRect? No:
     SDL_RenderFillRect keeps its name in SDL2 (only the outline
     and multi rect calls gained the Draw infix).
   - Integer SDLRect instead of SDL_FRect; Uint64 ticks come from
     SDL_GetTicks64 (SDL2 GetTicks is 32 bit).
   - Keyboard arrives decoded via SDLUtils.PollM2Event (type at
     offset 0, keysym.sym at offset 20); keycodes in SDLKey.
   - Joystick support from the C version is omitted; callback
     structure flattened into a main loop with a 30 s cap so the
     demo also terminates unattended.
*)

FROM SYSTEM IMPORT CARDINAL8;
FROM SDL2 IMPORT SDL_Init, SDL_Quit, SDL_Delay,
   SDL_GetTicks64, SDLInitVideo, SDLInitEvents;
FROM SDLVideo IMPORT WindowHandle, SDL_DestroyWindow, WindowResizable;
FROM SDLRender IMPORT RendererHandle,
   SDL_CreateWindowAndRenderer, SDL_DestroyRenderer,
   SDL_SetRenderDrawColor, SDL_RenderClear, SDL_RenderPresent,
   SDL_RenderSetLogicalSize, SDL_RenderFillRect;
FROM SDLRect IMPORT SDLRect, MakeRect;
FROM SDLUtils IMPORT PollM2Event, M2Event, evQuit, evKey;
FROM SDLKey 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: SDLRect;
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 := MakeRect(gx * BlockPx, gy * BlockPx, BlockPx, 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 := MakeRect(headX * BlockPx, headY * BlockPx, BlockPx, 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_GetTicks64()));
   IF SDL_Init(SDLInitVideo + SDLInitEvents) # 0 THEN
      printf("showcase_snake: SDL_Init failed\n");
      HALT(1)
   END;
   IF SDL_CreateWindowAndRenderer(WinW, WinH, WindowResizable,
                                  win, ren) # 0 THEN
      printf("showcase_snake: CreateWindowAndRenderer failed\n");
      SDL_Quit;
      HALT(1)
   END;
   SDL_RenderSetLogicalSize(ren, WinW, WinH);

   SnakeInit;
   printf("showcase_snake: arrows steer, R restarts, Q quits\n");
   quit := FALSE;
   start := SDL_GetTicks64();
   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_GetTicks64();
      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.