|
|
@@ -0,0 +1,254 @@
|
|
|
+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.
|