|
|
@@ -0,0 +1,307 @@
|
|
|
+MODULE snake;
|
|
|
+
|
|
|
+(* Classic Snake using the tigr Modula-2 binding. No assets: everything
|
|
|
+ is drawn with tigrFillRect, built-in font. Fixed grid of 8px cells
|
|
|
+ over a 320x240 window (40 x 30 cells).
|
|
|
+
|
|
|
+ Controls: ARROWS steer (no 180 degree reversal), SPACE restarts
|
|
|
+ after game over, ESC quits. Speed increases with score.
|
|
|
+
|
|
|
+ Compilation (from modula2/):
|
|
|
+ gcc -c tigr.c
|
|
|
+ gm2 -fiso -c helper.mod
|
|
|
+ gm2 -fiso -I. tigr.o helper.o examples/snake/snake.mod \
|
|
|
+ -o examples/snake/snake -lGL -lX11
|
|
|
+*)
|
|
|
+
|
|
|
+FROM tigr IMPORT TigrPtr, tigrWindow, tigrFree, tigrClosed, tigrClear,
|
|
|
+ tigrUpdate, TPixelType, tigrFillRect, tigrPrint, tfont,
|
|
|
+ tigrKeyDown, tigrTime, tigrTextWidth,
|
|
|
+ TK_ESCAPE, TK_SPACE, TK_LEFT, TK_RIGHT, TK_UP, TK_DOWN;
|
|
|
+FROM helper IMPORT tigrRGB;
|
|
|
+
|
|
|
+CONST
|
|
|
+ winW = 320;
|
|
|
+ winH = 240;
|
|
|
+ cell = 8; (* grid cell in pixels *)
|
|
|
+ cols = winW / cell; (* 40 *)
|
|
|
+ rows = winH / cell; (* 30 *)
|
|
|
+ maxLen = cols * rows; (* whole board = win condition *)
|
|
|
+ startLen = 3;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ State = (s_play, s_win, s_lose);
|
|
|
+
|
|
|
+VAR
|
|
|
+ win : TigrPtr;
|
|
|
+ segX, segY : ARRAY [0..maxLen - 1] OF CARDINAL;
|
|
|
+ length : CARDINAL;
|
|
|
+ dirX, dirY : INTEGER; (* -1/0/1 current direction *)
|
|
|
+ nextDX, nextDY : INTEGER; (* pending turn, consumed per tick *)
|
|
|
+ foodX, foodY : CARDINAL;
|
|
|
+ score : CARDINAL;
|
|
|
+ growing : BOOLEAN;
|
|
|
+ seed : CARDINAL; (* tiny LCG *)
|
|
|
+ state : State;
|
|
|
+ moveAcc, moveInt : SHORTREAL;
|
|
|
+ dt : SHORTREAL; (* tigrTime: delta since last call *)
|
|
|
+ black, white, red, green, head, yellow : TPixelType;
|
|
|
+ i, k, n : CARDINAL;
|
|
|
+ nx, ny : INTEGER;
|
|
|
+ scoreText : ARRAY [0..20] OF CHAR;
|
|
|
+ msgbuf : ARRAY [0..60] OF CHAR;
|
|
|
+
|
|
|
+ PROCEDURE CardToText(v : CARDINAL; VAR s : ARRAY OF CHAR);
|
|
|
+
|
|
|
+ (* Converts v to a NUL-terminated decimal string in s. *)
|
|
|
+
|
|
|
+ VAR
|
|
|
+ m, j : CARDINAL;
|
|
|
+ tmp : ARRAY [0..10] OF CHAR;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF v = 0 THEN
|
|
|
+ s[0] := '0';
|
|
|
+ s[1] := 0C;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ m := 0;
|
|
|
+ WHILE v > 0 DO
|
|
|
+ tmp[m] := CHR(ORD('0') + (v MOD 10));
|
|
|
+ m := m + 1;
|
|
|
+ v := v DIV 10
|
|
|
+ END;
|
|
|
+ j := 0;
|
|
|
+ WHILE m > 0 DO
|
|
|
+ m := m - 1;
|
|
|
+ s[j] := tmp[m];
|
|
|
+ j := j + 1
|
|
|
+ END;
|
|
|
+ s[j] := 0C
|
|
|
+ END CardToText;
|
|
|
+
|
|
|
+ PROCEDURE StartGame;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ c : CARDINAL;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ length := startLen;
|
|
|
+ FOR c := 0 TO startLen - 1 DO
|
|
|
+ segX[c] := 10 - c;
|
|
|
+ segY[c] := rows / 2
|
|
|
+ END;
|
|
|
+ dirX := 1;
|
|
|
+ dirY := 0;
|
|
|
+ nextDX := 0;
|
|
|
+ nextDY := 0;
|
|
|
+ growing := FALSE;
|
|
|
+ score := 0;
|
|
|
+ moveAcc := 0.0;
|
|
|
+ moveInt := 0.25;
|
|
|
+ seed := 7;
|
|
|
+ state := s_play;
|
|
|
+ PlaceFood
|
|
|
+ END StartGame;
|
|
|
+
|
|
|
+ PROCEDURE PlaceFood;
|
|
|
+
|
|
|
+ (* Random free cell for the food. *)
|
|
|
+
|
|
|
+ VAR
|
|
|
+ tries : CARDINAL;
|
|
|
+ occ : BOOLEAN;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ tries := 0;
|
|
|
+ occ := TRUE;
|
|
|
+ WHILE occ AND (tries < maxLen) DO
|
|
|
+ seed := (seed * 1103515245 + 12345) MOD 2147483648;
|
|
|
+ foodX := seed MOD cols;
|
|
|
+ foodY := (seed DIV 7) MOD rows;
|
|
|
+ occ := FALSE;
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < length) AND (NOT occ) DO
|
|
|
+ IF (segX[i] = foodX) AND (segY[i] = foodY) THEN
|
|
|
+ occ := TRUE
|
|
|
+ END;
|
|
|
+ i := i + 1
|
|
|
+ END;
|
|
|
+ tries := tries + 1
|
|
|
+ END
|
|
|
+ END PlaceFood;
|
|
|
+
|
|
|
+ PROCEDURE StepSnake;
|
|
|
+
|
|
|
+ (* One cell of movement: apply pending turn, check wall/self
|
|
|
+ collision, move the head and shift the body. *)
|
|
|
+
|
|
|
+ VAR
|
|
|
+ hitSelf : BOOLEAN;
|
|
|
+ limit, j : CARDINAL;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (nextDX # 0) OR (nextDY # 0) THEN
|
|
|
+ IF NOT ((nextDX = -dirX) AND (nextDY = -dirY)) THEN
|
|
|
+ dirX := nextDX;
|
|
|
+ dirY := nextDY
|
|
|
+ END;
|
|
|
+ nextDX := 0;
|
|
|
+ nextDY := 0
|
|
|
+ END;
|
|
|
+
|
|
|
+ nx := INTEGER(segX[0]) + dirX;
|
|
|
+ ny := INTEGER(segY[0]) + dirY;
|
|
|
+ IF (nx < 0) OR (nx >= INTEGER(cols))
|
|
|
+ OR (ny < 0) OR (ny >= INTEGER(rows)) THEN
|
|
|
+ state := s_lose;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+
|
|
|
+ (* A tail cell vacates this tick unless we grow. *)
|
|
|
+ hitSelf := FALSE;
|
|
|
+ IF growing THEN
|
|
|
+ limit := length
|
|
|
+ ELSE
|
|
|
+ limit := length - 1
|
|
|
+ END;
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < limit) AND (NOT hitSelf) DO
|
|
|
+ IF (segX[i] = CARDINAL(nx)) AND (segY[i] = CARDINAL(ny)) THEN
|
|
|
+ hitSelf := TRUE
|
|
|
+ END;
|
|
|
+ i := i + 1
|
|
|
+ END;
|
|
|
+ IF hitSelf THEN
|
|
|
+ state := s_lose;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF growing THEN
|
|
|
+ growing := FALSE;
|
|
|
+ length := length + 1;
|
|
|
+ IF length = maxLen THEN
|
|
|
+ state := s_win
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ FOR k := length - 1 TO 1 BY -1 DO
|
|
|
+ segX[k] := segX[k - 1];
|
|
|
+ segY[k] := segY[k - 1]
|
|
|
+ END;
|
|
|
+ segX[0] := CARDINAL(nx);
|
|
|
+ segY[0] := CARDINAL(ny);
|
|
|
+
|
|
|
+ IF (segX[0] = foodX) AND (segY[0] = foodY) THEN
|
|
|
+ growing := TRUE;
|
|
|
+ score := score + 1;
|
|
|
+ PlaceFood;
|
|
|
+ moveInt := 0.25 - SHORTREAL(score) * 0.005;
|
|
|
+ IF moveInt < 0.06 THEN
|
|
|
+ moveInt := 0.06
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END StepSnake;
|
|
|
+
|
|
|
+ PROCEDURE Draw;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ tw : INTEGER;
|
|
|
+ msgX : CARDINAL;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ tigrClear(win, black);
|
|
|
+ FOR i := 0 TO length - 1 DO
|
|
|
+ IF i = 0 THEN
|
|
|
+ tigrFillRect(win, segX[0] * cell, segY[0] * cell,
|
|
|
+ cell, cell, head)
|
|
|
+ ELSE
|
|
|
+ tigrFillRect(win, segX[i] * cell, segY[i] * cell,
|
|
|
+ cell, cell, green)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ tigrFillRect(win, foodX * cell, foodY * cell, cell, cell, red);
|
|
|
+
|
|
|
+ scoreText := "SCORE ";
|
|
|
+ CardToText(score, 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,
|
|
|
+ "ARROWS steer SPACE restart 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")
|
|
|
+ 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, "Snake", 0);
|
|
|
+ black := tigrRGB(0, 0, 0);
|
|
|
+ white := tigrRGB(255, 255, 255);
|
|
|
+ red := tigrRGB(255, 60, 60);
|
|
|
+ green := tigrRGB(60, 230, 60);
|
|
|
+ head := tigrRGB(160, 255, 160);
|
|
|
+ yellow:= tigrRGB(255, 220, 60);
|
|
|
+
|
|
|
+ StartGame;
|
|
|
+
|
|
|
+ WHILE (NOT (tigrClosed(win) > 0)) AND (NOT (tigrKeyDown(win, TK_ESCAPE) > 0)) DO
|
|
|
+ dt := tigrTime(); (* seconds since the previous call *)
|
|
|
+
|
|
|
+ IF state = s_play THEN
|
|
|
+ IF tigrKeyDown(win, TK_LEFT) > 0 THEN
|
|
|
+ nextDX := -1;
|
|
|
+ nextDY := 0
|
|
|
+ ELSIF tigrKeyDown(win, TK_RIGHT) > 0 THEN
|
|
|
+ nextDX := 1;
|
|
|
+ nextDY := 0
|
|
|
+ ELSIF tigrKeyDown(win, TK_UP) > 0 THEN
|
|
|
+ nextDX := 0;
|
|
|
+ nextDY := -1
|
|
|
+ ELSIF tigrKeyDown(win, TK_DOWN) > 0 THEN
|
|
|
+ nextDX := 0;
|
|
|
+ nextDY := 1
|
|
|
+ END;
|
|
|
+
|
|
|
+ moveAcc := moveAcc + dt;
|
|
|
+ WHILE moveAcc >= moveInt DO
|
|
|
+ moveAcc := moveAcc - moveInt;
|
|
|
+ StepSnake;
|
|
|
+ IF state # s_play THEN
|
|
|
+ moveAcc := 0.0
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSIF tigrKeyDown(win, TK_SPACE) > 0 THEN
|
|
|
+ StartGame
|
|
|
+ END;
|
|
|
+
|
|
|
+ Draw;
|
|
|
+ tigrUpdate(win)
|
|
|
+ END;
|
|
|
+ tigrFree(win)
|
|
|
+END snake.
|