Data commit

Task/2048/ALGOL-68/2048.alg

@@ -0,0 +1,142 @@
+main:(
+INT side = 4;
+INT right = 1, up = 2, left = 3, down = 4;
+[]CHAR direction letters = "ruld";
+[]STRING direction descriptions = ("right", "up", "left", "down");
+
+MODE BOARD = REF[,]INT;
+MODE CELL = REF INT;
+
+OP = = (BOARD a, BOARD b) BOOL:
+  (FOR i TO side DO FOR j TO side DO IF a[i,j] /= b[i,j] THEN mismatch FI OD OD;
+  TRUE EXIT
+  mismatch: FALSE);
+
+PROC traverse board = (BOARD board, PROC(CELL)VOID callback) VOID:
+  FOR i FROM 1 LWB board TO 1 UPB board DO
+    FOR j FROM 2 LWB board TO 2 UPB board DO
+      callback(board[i,j])
+  OD OD;
+
+PROC count blanks = (BOARD board) INT:
+  (INT count := 0;
+   traverse board(board, (CELL c)VOID: IF c = 0 THEN count +:= 1 FI);
+   count);
+
+PROC nth blank = (BOARD board, INT nth) CELL:
+  (CELL result;
+   INT count := 0;
+   traverse board(board, (CELL c)VOID:
+                           (IF c = 0 THEN count +:= 1 FI;
+                            IF count = nth THEN
+                              result := c; return
+                            FI));
+   return: result);
+
+PROC add new number = (BOARD board) VOID:
+  (INT nblanks = count blanks(board);
+   INT number   := (random >= .9 | 4 | 2);
+   INT position := ENTIER (random * nblanks) + 1;
+
+   nth blank(board, position) := number);
+
+PROC shift = (REF[]INT row, BOOL to the end) VOID:
+  (INT from = (to the end | UPB row | LWB row),
+       to   = (to the end | LWB row | UPB row),
+       dir  = (to the end | -1 | 1);
+   FOR i FROM from + dir BY dir TO to  DO
+     IF row[i] /= 0 THEN
+       INT blank := 0;
+       FOR j FROM i - dir BY -dir TO from WHILE row[j] = 0 DO
+         blank := j
+       OD;
+       IF blank /= 0 THEN
+         row[blank] := row[i];
+         row[i] := 0
+       FI
+     FI
+   OD);
+
+PROC combine = (REF[]INT row, BOOL to the end) VOID:
+  (INT from = (to the end | UPB row | LWB row),
+       to   = (to the end | LWB row | UPB row),
+       dir  = (to the end | -1 | 1);
+   FOR i FROM from BY dir TO to - dir DO
+     IF row[i] /= 0 AND row[i] = row[i+dir] THEN
+       row[i] *:= 2;
+       row[i+dir] := 0
+     FI
+   OD);
+
+PROC move = (BOARD board, INT direction) VOID:
+  FOR i TO side DO
+    CASE direction IN
+      # right # (shift(board[i,], TRUE);  combine(board[i,], TRUE);  shift(board[i,], TRUE)),
+      # up    # (shift(board[,i], FALSE); combine(board[,i], FALSE); shift(board[,i], FALSE)),
+      # left  # (shift(board[i,], FALSE); combine(board[i,], FALSE); shift(board[i,], FALSE)),
+      # down  # (shift(board[,i], TRUE);  combine(board[,i], TRUE);  shift(board[,i], TRUE))
+    ESAC
+  OD;
+
+PROC print board = (BOARD board)VOID:
+  (FOR i FROM 1 LWB board TO 1 UPB board DO
+     print("+");
+     FOR j FROM 2 LWB board TO 2 UPB board DO print("------+") OD;
+     print((new line, "|"));
+     FOR j FROM 2 LWB board TO 2 UPB board DO
+       print(((board[i,j] = 0 | "     " | whole(board[i,j],-5)), " |"))
+     OD;
+     print(new line)
+   OD;
+   print("+"); FOR j FROM 2 LWB board TO 2 UPB board DO print("------+") OD;
+   print(new line)
+  );
+
+PROC score = (BOARD board) INT:
+  (INT result := 0;
+   traverse board(board, (CELL c)VOID: result +:= c);
+   result);
+
+PROC join = ([]STRING strings, STRING joiner) STRING:
+  IF UPB strings > 0 THEN
+    STRING result := strings[1];
+    FOR i FROM 2 TO UPB strings DO result +:= joiner +:= strings[i] OD;
+    result
+  ELSE
+    ""
+  FI;
+
+BOARD board = LOC [side,side]INT;
+BOARD previous = LOC [side,side]INT;
+
+traverse board(board, (CELL c)VOID: c := 0);
+
+# start with two numbers #
+TO 2 DO add new number(board) OD;
+
+# play! #
+STRING prompt := "enter one of [" + direction letters + "] (for " + join(direction descriptions, "/") + "): ";
+DO
+  CHAR key;
+  INT dir;
+  print board(board);
+  print(("score: ", whole(score(board),0), new line));
+  WHILE
+    print(prompt);
+    read((key, new line));
+    NOT char in string(key, dir, direction letters)
+  DO SKIP OD;
+  previous := board;
+  move(board, dir);
+  IF count blanks(board) = 0 THEN lose FI;
+  traverse board(board, (CELL c)VOID: IF c = 2048 THEN win FI);
+  IF previous = board THEN
+    print(("try again!", new line))
+  ELSE
+    add new number(board)
+  FI
+OD;
+
+win: print board(board); print(("you win!", new line)) EXIT
+lose: print(("you lose!", new line))
+)