Browse Source

feat: snake demo port with keyboard event decoding

- src/SDLKey: keycode constants plus empty impl (linker needs it)
- src/SDLEvents: SDL_PushEvent binding
- lib/SDLUtils: PollM2Event decoded poller (type off 0, sym off 20),
  DrainEvents reimplemented on top
- tests/test_key: synthetic key/quit injection, decoder verified
- showcases/showcase_snake: full port of SDL-main demo/01-snake
  (packed 3-bit board, food, wrap, restart, 125 ms steps)
Eric Streit 2 weeks ago
parent
commit
95d7773c1c
11 changed files with 433 additions and 22 deletions
  1. 6 3
      Makefile
  2. 3 2
      README.md
  3. 19 6
      lib/SDLUtils.def
  4. 38 8
      lib/SDLUtils.mod
  5. 2 0
      showcases/README.md
  6. 254 0
      showcases/showcase_snake.mod
  7. 5 1
      src/SDLEvents.def
  8. 28 0
      src/SDLKey.def
  9. 5 0
      src/SDLKey.mod
  10. 4 2
      tests/run_tests.sh
  11. 69 0
      tests/test_key.mod

+ 6 - 3
Makefile

@@ -8,13 +8,13 @@ SRC_DIR := src
 LIB_DIR := lib
 BLD     := build
 OBJDIR  := $(BLD)/objs
-OBJS    := $(OBJDIR)/SDLRect.o $(OBJDIR)/SDLUtils.o
+OBJS    := $(OBJDIR)/SDLRect.o $(OBJDIR)/SDLUtils.o $(OBJDIR)/SDLKey.o
 
 INCLUDES := -I$(SRC_DIR) -I$(LIB_DIR)
 
-TESTS    := test_init test_version test_rect test_window
+TESTS    := test_init test_version test_rect test_window test_key
 EXAMPLES := hello_window version event_loop
-SHOWCASES := showcase_clear showcase_rectangles showcase_primitives
+SHOWCASES := showcase_clear showcase_rectangles showcase_primitives showcase_snake
 
 .PHONY: all tests examples showcases clean check
 
@@ -35,6 +35,9 @@ $(OBJDIR)/SDLRect.o: $(SRC_DIR)/SDLRect.mod $(SRC_DIR)/SDLRect.def | $(OBJDIR)
 $(OBJDIR)/SDLUtils.o: $(LIB_DIR)/SDLUtils.mod $(LIB_DIR)/SDLUtils.def | $(OBJDIR)
 	$(GM2) $(INCLUDES) $(GM2FLAGS) -c $< -o $@
 
+$(OBJDIR)/SDLKey.o: $(SRC_DIR)/SDLKey.mod $(SRC_DIR)/SDLKey.def | $(OBJDIR)
+	$(GM2) $(INCLUDES) $(GM2FLAGS) -c $< -o $@
+
 tests: $(BLD)/tests $(OBJS) $(addprefix $(BLD)/tests/,$(TESTS))
 
 $(BLD)/tests/%: tests/%.mod $(OBJS) | $(BLD)/tests

+ 3 - 2
README.md

@@ -13,10 +13,11 @@ Starter set, verified with gm2 + SDL 2.32.4 on Linux:
 | `SDL2` | `<SDL.h>`, `<SDL_error.h>`, `<SDL_timer.h>` | init/quit, `GetError`, `Delay`, ticks, performance counter |
 | `SDLVersion` | `<SDL_version.h>` | `SDLVersion` record, `GetVersion`, `GetRevision` |
 | `SDLVideo` | `<SDL_video.h>` | window create/destroy, title, size, show/hide |
-| `SDLEvents` | `<SDL_events.h>` | `PumpEvents`, `PollEvent`, `WaitEvent`, quit/key/mouse type ids (opaque buffer for now) |
+| `SDLEvents` | `<SDL_events.h>` | `PumpEvents`, `PollEvent`, `WaitEvent`, `PushEvent`, quit/key/mouse type ids (opaque buffer for now) |
 | `SDLRect` | `<SDL_rect.h>` | pure-M2 `SDLPoint`/`SDLRect` + helpers |
 | `SDLRender` | `<SDL_render.h>` | window+renderer creation, draw color, clear/present, points/lines/rects |
-| `SDLUtils` (`lib/`) | — | `CStrToM2()` + `GetErrorString()` helpers, `DrainEvents()` quit pump |
+| `SDLKey` | `<SDL_keycode.h>` | pure-M2 keycode constants (arrows, Q/R, Escape...) |
+| `SDLUtils` (`lib/`) | — | `CStrToM2()` + `GetErrorString()` helpers, `DrainEvents()` quit pump, `PollM2Event()` decoded poll |
 
 Full `SDL_Event` union mapping, renderer, audio and gamepad come next.
 

+ 19 - 6
lib/SDLUtils.def

@@ -2,19 +2,32 @@ DEFINITION MODULE SDLUtils ;
 
 (*
    m2SDL - small pure-Modula-2 helpers over the FOR "C" bindings.
-   Copies NUL-terminated C strings (ADDRESS) into Modula-2 CHAR
-   arrays (NUL-terminated, truncated to the destination length).
-   DrainEvents pumps the queue and reports whether a quit event
-   was seen; event type is the leading Uint32 of SDL_Event, read
-   little-endian (matches x86/x86-64/ARM hosts).
+   CStrToM2 copies NUL-terminated C strings (ADDRESS) into
+   Modula-2 CHAR arrays (NUL-terminated, truncated to fit).
+   PollM2Event decodes one queued SDL_Event into a small record:
+   SDL2 puts the Uint32 type at offset 0 of every event, and for
+   key events the Sint32 keysym.sym at offset 20 (see <SDL_events.h>
+   and <SDL_keyboard.h>). DrainEvents pumps the queue and reports
+   whether a quit event was seen.
 *)
 
 FROM SYSTEM IMPORT ADDRESS;
 
-EXPORT UNQUALIFIED CStrToM2, GetErrorString, DrainEvents;
+EXPORT UNQUALIFIED
+   EventKind, M2Event,
+   CStrToM2, GetErrorString, PollM2Event, DrainEvents;
+
+TYPE
+   EventKind = (evQuit, evKey, evOther);
+   M2Event = RECORD
+      kind: EventKind;
+      sym: INTEGER;      (* valid when kind = evKey *)
+      pressed: BOOLEAN;  (* valid when kind = evKey *)
+   END;
 
 PROCEDURE CStrToM2 (src: ADDRESS; VAR dst: ARRAY OF CHAR);
 PROCEDURE GetErrorString (VAR buf: ARRAY OF CHAR);
+PROCEDURE PollM2Event (VAR ev: M2Event) : BOOLEAN;
 PROCEDURE DrainEvents (VAR quit: BOOLEAN);
 
 END SDLUtils.

+ 38 - 8
lib/SDLUtils.mod

@@ -2,7 +2,8 @@ IMPLEMENTATION MODULE SDLUtils ;
 
 FROM SYSTEM IMPORT ADDRESS, ADR;
 FROM SDL2 IMPORT SDL_GetError;
-FROM SDLEvents IMPORT SDL_PollEvent, EventQuit, EventBufferBytes;
+FROM SDLEvents IMPORT SDL_PollEvent,
+   EventQuit, EventKeyDown, EventKeyUp, EventBufferBytes;
 FROM libc IMPORT strlen, strncpy;
 
 PROCEDURE CStrToM2 (src: ADDRESS; VAR dst: ARRAY OF CHAR);
@@ -22,17 +23,46 @@ BEGIN
    CStrToM2(SDL_GetError(), buf)
 END GetErrorString;
 
-PROCEDURE DrainEvents (VAR quit: BOOLEAN);
+(* Little-endian 32-bit word at byte offset off. Hosts only. *)
+PROCEDURE LE32 (VAR buf: ARRAY OF CHAR; off: CARDINAL) : CARDINAL;
+BEGIN
+   RETURN VAL(CARDINAL, ORD(buf[off]))
+        + VAL(CARDINAL, ORD(buf[off+1])) * 256
+        + VAL(CARDINAL, ORD(buf[off+2])) * 65536
+        + VAL(CARDINAL, ORD(buf[off+3])) * 16777216
+END LE32;
+
+PROCEDURE PollM2Event (VAR ev: M2Event) : BOOLEAN;
 VAR
    buf: ARRAY [0..EventBufferBytes-1] OF CHAR;
    t: CARDINAL;
 BEGIN
-   WHILE SDL_PollEvent(ADR(buf)) # 0 DO
-      t := VAL(CARDINAL, ORD(buf[0]))
-         + VAL(CARDINAL, ORD(buf[1])) * 256
-         + VAL(CARDINAL, ORD(buf[2])) * 65536
-         + VAL(CARDINAL, ORD(buf[3])) * 16777216;
-      IF t = EventQuit THEN quit := TRUE END
+   IF SDL_PollEvent(ADR(buf)) = 0 THEN RETURN FALSE END;
+   t := LE32(buf, 0);
+   ev.sym := 0;
+   ev.pressed := FALSE;
+   IF t = EventKeyDown THEN
+      ev.kind := evKey;
+      ev.pressed := TRUE;
+      (* Sint32 keysym.sym; game keycodes are all positive. *)
+      ev.sym := VAL(INTEGER, LE32(buf, 20))
+   ELSIF t = EventKeyUp THEN
+      ev.kind := evKey;
+      ev.pressed := FALSE;
+      ev.sym := VAL(INTEGER, LE32(buf, 20))
+   ELSIF t = EventQuit THEN
+      ev.kind := evQuit
+   ELSE
+      ev.kind := evOther
+   END;
+   RETURN TRUE
+END PollM2Event;
+
+PROCEDURE DrainEvents (VAR quit: BOOLEAN);
+VAR ev: M2Event;
+BEGIN
+   WHILE PollM2Event(ev) DO
+      IF ev.kind = evQuit THEN quit := TRUE END
    END
 END DrainEvents;
 

+ 2 - 0
showcases/README.md

@@ -8,6 +8,7 @@ ignored by git) to GNU Modula-2, running against SDL2.
 | `showcase_clear` | `examples/renderer/01-clear/clear.c` | renderer, per-frame clear color, `MathLib0.sin` fade |
 | `showcase_rectangles` | `examples/renderer/05-rectangles/rectangles.c` | draw/fill rects, rect arrays via `ADR`, integer scale math |
 | `showcase_primitives` | `examples/renderer/02-primitives/primitives.c` | fill rect, point cloud (`libc rand`), outline, X lines |
+| `showcase_snake` | `examples/demo/01-snake/snake.c` | full game: packed board, food, keyboard (`SDLKey`, `PollM2Event`) |
 
 All three are public-domain originals; adaptation notes (SDL3 to SDL2
 API renames, float to integer rects, callback to main-loop shape) live
@@ -20,5 +21,6 @@ make showcases
 ./build/showcases/showcase_clear       # close window, or waits 8 s
 ./build/showcases/showcase_rectangles
 ./build/showcases/showcase_primitives
+./build/showcases/showcase_snake       # arrows steer, R restarts, Q quits
 SDL_VIDEODRIVER=dummy ./build/showcases/showcase_clear   # headless
 ```

+ 254 - 0
showcases/showcase_snake.mod

@@ -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.

+ 5 - 1
src/SDLEvents.def

@@ -19,7 +19,8 @@ EXPORT UNQUALIFIED
    EventQuit, EventKeyDown, EventKeyUp,
    EventMouseButtonDown, EventMouseButtonUp,
    EventBufferBytes,
-   SDL_PumpEvents, SDL_PollEvent, SDL_WaitEvent, SDL_HasEvents;
+   SDL_PumpEvents, SDL_PollEvent, SDL_WaitEvent, SDL_HasEvents,
+   SDL_PushEvent;
 
 
 CONST
@@ -45,4 +46,7 @@ PROCEDURE SDL_WaitEvent (ev: ADDRESS) : INTEGER;
 (* SDL_bool SDL_HasEvents(Uint32 minType, Uint32 maxType) - 0/1 as CARDINAL *)
 PROCEDURE SDL_HasEvents (minType, maxType: CARDINAL) : CARDINAL;
 
+(* int SDL_PushEvent(SDL_Event *event) - pass ADR(buf), 1 = stored *)
+PROCEDURE SDL_PushEvent (ev: ADDRESS) : INTEGER;
+
 END SDLEvents.

+ 28 - 0
src/SDLKey.def

@@ -0,0 +1,28 @@
+DEFINITION MODULE SDLKey ;
+
+(*
+   m2SDL - SDL2 keycode constants (SDL_Keycode from <SDL_keycode.h>).
+
+   Pure constants, no C functions: printable keys equal their ASCII
+   code, arrows are SCANCODE_TO_KEYCODE values (bit 30 set), e.g.
+   KeyRight = 4000004FH = 1073741903.
+*)
+
+EXPORT UNQUALIFIED
+   KeyEscape, KeyReturn, KeySpace, KeyQ, KeyR,
+   KeyRight, KeyLeft, KeyDown, KeyUp;
+
+
+CONST
+   KeyEscape = 27;
+   KeyReturn = 13;
+   KeySpace  = 32;
+   KeyQ      = 113;   (* "q" *)
+   KeyR      = 114;   (* "r" *)
+
+   KeyRight = 4000004FH;
+   KeyLeft  = 40000050H;
+   KeyDown  = 40000051H;
+   KeyUp    = 40000052H;
+
+END SDLKey.

+ 5 - 0
src/SDLKey.mod

@@ -0,0 +1,5 @@
+IMPLEMENTATION MODULE SDLKey ;
+
+(* Constants only; nothing to initialize. *)
+
+END SDLKey.

+ 4 - 2
tests/run_tests.sh

@@ -16,12 +16,14 @@ mkdir -p "$BIN" "$OBJ"
 $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS -c "$ROOT/src/SDLRect.mod" -o "$OBJ/SDLRect.o"
 # shellcheck disable=SC2086
 $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS -c "$ROOT/lib/SDLUtils.mod" -o "$OBJ/SDLUtils.o"
+# shellcheck disable=SC2086
+$GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS -c "$ROOT/src/SDLKey.mod" -o "$OBJ/SDLKey.o"
 pass=0; fail=0
-for t in test_init test_version test_rect test_window; do
+for t in test_init test_version test_rect test_window test_key; do
   echo "== $t =="
   # shellcheck disable=SC2086
   $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS "$ROOT/tests/$t.mod" \
-       "$OBJ/SDLRect.o" "$OBJ/SDLUtils.o" \
+       "$OBJ/SDLRect.o" "$OBJ/SDLUtils.o" "$OBJ/SDLKey.o" \
        -o "$BIN/$t" -lSDL2
   if [ "$t" = "test_window" ] && [ -z "$DISPLAY" ] && [ -z "$WAYLAND_DISPLAY" ]; then
     SDL_VIDEODRIVER=dummy "$BIN/$t"

+ 69 - 0
tests/test_key.mod

@@ -0,0 +1,69 @@
+MODULE test_key ;
+
+(*
+   m2SDL test: push synthetic SDL_Event buffers through
+   SDL_PushEvent and check PollM2Event decodes type 0300H
+   (key down, sym at offset 20) and 0100H (quit).
+*)
+
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM SDL2 IMPORT SDL_Init, SDL_Quit, SDLInitEvents;
+FROM SDLEvents IMPORT SDL_PushEvent, EventKeyDown, EventQuit;
+FROM SDLUtils IMPORT PollM2Event, M2Event, evKey, evQuit;
+FROM libc IMPORT printf;
+
+VAR
+   buf: ARRAY [0..55] OF CHAR;
+   ev: M2Event;
+   i: INTEGER;
+
+PROCEDURE ZeroBuf;
+VAR j: INTEGER;
+BEGIN
+   FOR j := 0 TO 55 DO buf[j] := 0C END
+END ZeroBuf;
+
+PROCEDURE Put32 (off: CARDINAL; v: CARDINAL);
+BEGIN
+   buf[off] := CHR(v MOD 256);
+   buf[off+1] := CHR(v DIV 256 MOD 256);
+   buf[off+2] := CHR(v DIV 65536 MOD 256);
+   buf[off+3] := CHR(v DIV 16777216 MOD 256)
+END Put32;
+
+PROCEDURE Fail (msg: ARRAY OF CHAR);
+BEGIN
+   printf("FAIL test_key: %s\n", msg);
+   HALT(1)
+END Fail;
+
+BEGIN
+   IF SDL_Init(SDLInitEvents) # 0 THEN
+      printf("FAIL test_key: SDL_Init events\n");
+      HALT(1)
+   END;
+
+   (* key down, sym "q" = 113. *)
+   ZeroBuf;
+   Put32(0, EventKeyDown);
+   Put32(20, 113);
+   IF SDL_PushEvent(ADR(buf)) # 1 THEN Fail("push key") END;
+
+   (* quit. *)
+   ZeroBuf;
+   Put32(0, EventQuit);
+   IF SDL_PushEvent(ADR(buf)) # 1 THEN Fail("push quit") END;
+
+   IF NOT PollM2Event(ev) THEN Fail("poll 1 empty") END;
+   IF ORD(ev.kind) # ORD(evKey) THEN Fail("ev1 not key") END;
+   IF NOT ev.pressed THEN Fail("ev1 not pressed") END;
+   IF ev.sym # 113 THEN Fail("ev1 sym") END;
+
+   IF NOT PollM2Event(ev) THEN Fail("poll 2 empty") END;
+   IF ORD(ev.kind) # ORD(evQuit) THEN Fail("ev2 not quit") END;
+
+   IF PollM2Event(ev) THEN Fail("queue not drained") END;
+
+   SDL_Quit;
+   printf("PASS test_key\n")
+END test_key.