├── 2048.png ├── LOGO.INC ├── MAIN.ANS ├── .gitattributes ├── GLOBALS.INC ├── WHATSNEW.TXT ├── MAKEFILE ├── README.MD ├── LICENSE ├── 2048.PAS ├── GAME.INC ├── HELPERS.INC └── ENGINE.INC /2048.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dzutrinh/2048/HEAD/2048.png -------------------------------------------------------------------------------- /LOGO.INC: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dzutrinh/2048/HEAD/LOGO.INC -------------------------------------------------------------------------------- /MAIN.ANS: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dzutrinh/2048/HEAD/MAIN.ANS -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /GLOBALS.INC: -------------------------------------------------------------------------------- 1 | {$ifndef __GLOBALS_2048__} 2 | {$define __GLOBALS_2048__} 3 | 4 | const 5 | { Full version format : hi(VERSION).lo(VERSION).BUILD } 6 | GAME_VERSION : word = $0000; { Game version number } 7 | GAME_BUILD : string[4] = ''; { Build string } 8 | 9 | COPYRIGHTS : string = #13#10+ 10 | '2048 (c) 2019 by Infinity Group'#13#10+ 11 | 'Coded by Trinh D.D. Nguyen'; 12 | 13 | {$ifdef __TMT__} 14 | COMPILER : string = 'TMT'; 15 | {$else} 16 | {$ifdef FPC} 17 | COMPILER : string = 'FPC'; 18 | {$else} 19 | COMPILER : string = 'BPC'; 20 | {$endif} 21 | {$endif} 22 | 23 | {$endif} -------------------------------------------------------------------------------- /WHATSNEW.TXT: -------------------------------------------------------------------------------- 1 | ______ ______ _____ ______ 2 | |__ | | | || __ | 3 | | __| -- |__ | __ | 4 | |______|______| |__||______| 5 | 6 | The game 2048 7 | Code by Trinh D.D. Nguyen 8 | (c) 2019 by Inifinity Group 9 | THIS GAME IS A FREEWARE 10 | 11 | # What's new: 12 | =========== 13 | 14 | ## v1.2: 15 | - Win condition added. 16 | 17 | ## v1.1: 18 | - ANSI-Art background added. 19 | - UI added. 20 | - Hi-score counter added. 21 | - Move counter added. 22 | - Game will auto-save when quit. 23 | - User can now restart the game. 24 | 25 | ## v1.0: 26 | - Initial development. 27 | 28 | -------------------------------------------------------------------------------- /MAKEFILE: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile for '2048' game 3 | # 4 | 5 | PROJECT=2048 6 | SOURCE=$(PROJECT).pas 7 | BINARY=$(PROJECT).exe 8 | INCLUDE=game.inc \ 9 | globals.inc \ 10 | engine.inc \ 11 | helpers.inc \ 12 | logo.inc 13 | RM=erase 14 | 15 | # Compiler: Turbo Pascal=TPC; Free Pascal=FPC; TMT Pascal=TMTPC 16 | PC=tpc 17 | 18 | all: $(BINARY) 19 | 20 | $(BINARY): $(SOURCE) $(INCLUDE) 21 | @$(PC) $(SOURCE) 22 | @if exist $(PROJECT).o $(RM) $(PROJECT).o 23 | @if exist $(PROJECT).fpd $(RM) $(PROJECT).fpd 24 | @if exist $(PROJECT).sym $(RM) $(PROJECT).sym 25 | 26 | clean: 27 | @if exist $(PROJECT).exe $(RM) $(PROJECT).exe 28 | @if exist $(PROJECT).fpd $(RM) $(PROJECT).fpd 29 | @if exist $(PROJECT).sym $(RM) $(PROJECT).sym 30 | @if exist $(PROJECT).o $(RM) $(PROJECT).o 31 | -------------------------------------------------------------------------------- /README.MD: -------------------------------------------------------------------------------- 1 | # Another clone of the 2048 game 2 | 3 | IMPORTANT: Updated version of this game is now available at: https://github.com/dzutrinh/TMGDL, Free Pascal support is removed and I have no plan to put it back. This repo will no longer receive any further update. 4 | 5 | ## What's new: 6 | v1.1: 7 | * ANSI-Art background added. 8 | * UI added. 9 | * Hi-score counter added. 10 | * Move counter added. 11 | * Game will auto-save when quit. 12 | * User can now restart the game. 13 | 14 | v1.0: 15 | * Initial development. 16 | 17 | ## Compiler 18 | * Turbo/Borland Pascal (no CRT needed) 19 | * TMT Pascal 20 | * Free Pascal 21 | 22 | ## Build: 23 | make -fmakefile 24 | 25 | ## Binaries: 26 | Latest binaries pre-compiled using Turbo Pascal, TMT Pascal and Free Pascal can be downloaded [here](https://github.com/dzutrinh/2048/releases/latest). 27 | MS-DOS or DOSBox is required to run. 28 | 29 | ## Screenshot: 30 | ![Screenshot](https://github.com/dzutrinh/2048/blob/master/2048.png) 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Trinh Nguyen 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /2048.PAS: -------------------------------------------------------------------------------- 1 | { ////////////////////////////////////////////////////////////////////////// } 2 | { } 3 | { 2048.PAS } 4 | { -------- } 5 | { 2048 Game for DOS } 6 | { Version 1.2 } 7 | { Coded by Trinh D.D. Nguyen } 8 | { Copyrights (c) 2019 by Infinity Group } 9 | { } 10 | { Compilers } 11 | { --------- } 12 | { . Turbo/Borland Pascal 6.0+ } 13 | { . TMT Pascal 3.5+ } 14 | { . Free Pascal 1.0.1+ } 15 | { } 16 | { Tools used } 17 | { ---------- } 18 | { . TheDraw } 19 | { } 20 | { DDK16 | DDK32 } 21 | { } 22 | { ////////////////////////////////////////////////////////////////////////// } 23 | 24 | {$i logo.inc} { main screen data } 25 | {$i globals.inc} { global constants, variables } 26 | {$i helpers.inc} { utility routines } 27 | {$i engine.inc} { game engine } 28 | {$i game.inc} { game handlers } 29 | 30 | begin 31 | gameInit(1, 2, '0628'); { init game } 32 | if gameDemo then { playing a so-called demo } 33 | gamePlay; { game loop } 34 | gameDone; { shutdown game } 35 | end. 36 | -------------------------------------------------------------------------------- /GAME.INC: -------------------------------------------------------------------------------- 1 | {$ifndef __GAME_2048__} 2 | {$define __GAME_2048__} 3 | 4 | { ////////////////////////////////////////////////////////////////////////// } 5 | 6 | { exposed API } 7 | procedure gameInit(major, minor: longint; build: string); forward; 8 | procedure gameDone; forward; 9 | function gameDemo: boolean; forward; 10 | procedure gamePlay; forward; 11 | 12 | { private API } 13 | procedure gameLogo; forward; 14 | procedure gameUpdate; forward; 15 | 16 | { ////////////////////////////////////////////////////////////////////////// } 17 | 18 | const 19 | INFO_X = 63; 20 | INFO_SCORE = 14; 21 | INFO_HISCORE = 17; 22 | INFO_MOVES = 20; 23 | 24 | var 25 | board : BOARD_TYPE; 26 | 27 | procedure gameInit(major, minor: longint; build: string); 28 | begin 29 | GAME_VERSION := major shl 8 + minor; 30 | GAME_BUILD := build; 31 | 32 | textmode(CO80); 33 | randomize; 34 | 35 | cursor(CURSOR_OFF); 36 | blinkoff; 37 | 38 | scoreLoad; 39 | stateInit(board); 40 | end; 41 | 42 | procedure gameDone; 43 | begin 44 | textmode(CO80); 45 | writeln(' ______ ______ _____ ______ '); 46 | writeln('|__ | | | || __ |'); 47 | writeln('| __| -- |__ | __ |'); 48 | writeln('|______|______| |__||______|'); 49 | write (' v'); 50 | write (hi(GAME_VERSION),'.',lo(GAME_VERSION),'.',GAME_BUILD); 51 | writeln(' [', COMPILER, ']'); 52 | writeln(' Thanks for playing!'); 53 | writeln; 54 | end; 55 | 56 | procedure gameLogo; 57 | var x : longint; 58 | begin 59 | for x := 0 to 3999 do MEM[VIDEO_SEG:x] := ord(IMAGEDATA[x+1]); 60 | prints(71, 25, $01, 'v' + ltoa(hi(GAME_VERSION)) + '.' + 61 | ltoa(lo(GAME_VERSION)) + '.' + 62 | GAME_BUILD); 63 | end; 64 | 65 | procedure gameUpdate; 66 | begin 67 | prints(INFO_X, INFO_SCORE, $07, lpad(ltoa(GAME_SCORE), 12)); 68 | prints(INFO_X, INFO_HISCORE, $07, lpad(ltoa(GAME_HISCORE), 12)); 69 | prints(INFO_X, INFO_MOVES, $07, lpad(ltoa(GAME_MOVES), 12)); 70 | boardShow(board); 71 | end; 72 | 73 | function gameDemo: boolean; 74 | var x, y, c : longint; 75 | tmp : BOARD_TYPE; 76 | stop : boolean; 77 | ch : char; 78 | begin 79 | gameLogo; 80 | gameUpdate; 81 | fillchar(tmp, sizeof(BOARD_TYPE), 0); 82 | c := 0; 83 | stop := FALSE; 84 | center(24, '~09ENTER~01:START ~08- ~09ESC~01:QUIT'); 85 | repeat 86 | x := c mod BOARD_DIM; y := c div BOARD_DIM; 87 | tmp[x, y] := (c mod 11)+1; 88 | boardShow(tmp); 89 | sleep(3); 90 | tmp[x, y] := 0; 91 | c := (c + 1) mod BOARD_SIZE; 92 | if keypressed then 93 | begin 94 | ch := readkey; 95 | if ch in [#13, #27, #32] then stop := TRUE; 96 | end; 97 | until stop; 98 | gameDemo := ch in [#13, #32]; 99 | end; 100 | 101 | procedure gamePlay; 102 | var c : char; 103 | quit, 104 | next : boolean; 105 | begin 106 | quit := FALSE; next := FALSE; 107 | gameLogo; 108 | if stateLoad(board) then 109 | begin 110 | gameUpdate; 111 | end 112 | else stateRestart(board); 113 | repeat 114 | gameUpdate; 115 | c := wait(['W','A','S','D','R',#27]); 116 | gameUpdate; 117 | case c of 118 | #27: begin 119 | if query('~0CQUIT AND SAVE GAME (~0FY~0C/~0FN~0C) ?') then 120 | quit := TRUE; 121 | next := FALSE; 122 | end; 123 | 'R': if query('~03START A NEW GAME (~0FY~03/~0FN~03) ?') then 124 | begin 125 | stateRestart(board); 126 | scoreSave; 127 | next := FALSE; 128 | end; 129 | 'A': next := boardSlideLeft (board); 130 | 'D': next := boardSlideRight(board); 131 | 'W': next := boardSlideUp (board); 132 | 'S': next := boardSlideDown (board); 133 | end; 134 | if next then 135 | begin 136 | inc(GAME_MOVES); 137 | boardPlace(board); 138 | boardShow(board); 139 | if stateCheckWin(board) then 140 | begin 141 | info('~02!! ~0AYOU WIN ~02!!'); 142 | stateRestart(board); 143 | next := FALSE; 144 | end 145 | else 146 | if stateCheckOver(board) then 147 | begin 148 | info('~06!! ~0EGAME OVER~06 !!'); 149 | stateRestart(board); 150 | next := FALSE; 151 | end; 152 | end; 153 | until quit; 154 | scoreSave; 155 | stateSave(board); 156 | end; 157 | 158 | {$endif} 159 | -------------------------------------------------------------------------------- /HELPERS.INC: -------------------------------------------------------------------------------- 1 | {$ifndef __HELPERS_2048__} 2 | {$define __HELPERS_2048__} 3 | 4 | { ////////////////////////////////////////////////////////////////////////// } 5 | 6 | const 7 | SCR_WIDTH = 80; 8 | SCR_HEIGHT = 25; 9 | CO80 = 3; 10 | 11 | CURSOR_OFF = $2000; 12 | CURSOR_ON = $0607; 13 | 14 | VIDEO_SEG = $B800; { VGA text mode VRAM segment } 15 | 16 | type 17 | KEYS = set of char; 18 | 19 | var 20 | ticks : longint absolute $0040:$006C; 21 | 22 | { exposed APIs } 23 | procedure textmode(mode: byte); forward; 24 | procedure sleep(duration: longint); forward; 25 | function readkey: char; forward; 26 | function keypressed: boolean; forward; 27 | 28 | procedure blinkoff; forward; 29 | procedure blinkon; forward; 30 | procedure cursor(size: word); forward; 31 | procedure printc(x, y, attr: longint; c: char); forward; 32 | procedure prints(x, y, attr: longint; text: string); forward; 33 | 34 | procedure print(x, y: longint; st: string); forward; 35 | procedure center(y: longint; text: string); forward; 36 | 37 | function wait(k: KEYS): char; forward; 38 | function query(mesg: string): boolean; forward; 39 | procedure info(mesg: string); forward; 40 | 41 | function lpad(text: string; width: longint): string; forward; 42 | function ltoa(v: longint): string; forward; 43 | function make_center(text: string; width: longint): string; forward; 44 | 45 | { ////////////////////////////////////////////////////////////////////////// } 46 | 47 | procedure textmode(mode: byte); assembler; 48 | asm 49 | mov ah, 00 50 | mov al, mode 51 | int $10 52 | end; 53 | 54 | procedure sleep(duration: longint); 55 | var timer : longint; 56 | begin 57 | timer := ticks; 58 | repeat until abs(ticks-timer)=duration; 59 | end; 60 | 61 | function readkey: char; assembler; 62 | asm 63 | mov ah, $07 64 | int $21 65 | end; 66 | 67 | function keypressed: boolean; assembler; 68 | asm 69 | mov ah, $0B 70 | int $21 71 | end; 72 | 73 | procedure blinkoff; assembler; 74 | asm 75 | mov ax, $1003 76 | mov bl, 0 77 | int $10 78 | end; 79 | 80 | procedure blinkon; assembler; 81 | asm 82 | mov ax, $1003 83 | mov bl, 1 84 | int $10 85 | end; 86 | 87 | procedure cursor(size: word); assembler; 88 | asm 89 | mov ah, $01 90 | mov bh, 0 91 | mov cx, size 92 | int $10 93 | end; 94 | 95 | procedure printc(x, y, attr: longint; c: char); 96 | begin 97 | MEMW[VIDEO_SEG:((y-1)*SCR_WIDTH+(x-1)) shl 1] := attr shl 8 + ord(c); 98 | end; 99 | 100 | procedure prints(x, y, attr: longint; text: string); 101 | var i : longint; 102 | begin 103 | for i := 1 to length(text) do 104 | MEMW[VIDEO_SEG:((y-1)*SCR_WIDTH+(x+i-1)) shl 1] := attr shl 8 + ord(text[i]); 105 | end; 106 | 107 | procedure print(x, y: longint; st: string); 108 | var i, attr, 109 | fg, bk : longint; 110 | v : char; 111 | begin 112 | attr := $07; i := 1; 113 | i := 1; 114 | while i <= length(st) do 115 | begin 116 | v := st[i]; 117 | if v = '~' then 118 | begin 119 | inc(i); v := upcase(st[i]); 120 | case v of 121 | '0'..'9': bk := ord(v)-48; 122 | 'A'..'F': bk := ord(v)-55; 123 | end; 124 | inc(i); v := upcase(st[i]); 125 | case v of 126 | '0'..'9': fg := ord(v)-48; 127 | 'A'..'F': fg := ord(v)-55; 128 | end; 129 | attr := bk shl 8 + fg; 130 | end 131 | else 132 | begin 133 | printc(x, y, attr, v); 134 | inc(x); 135 | end; 136 | inc(i); 137 | end; 138 | end; 139 | 140 | procedure center(y: longint; text: string); 141 | var i, x, c : longint; 142 | begin 143 | c := 0; 144 | for i := 1 to length(text) do 145 | if text[i] = '~' then inc(c, 3); 146 | x := ((SCR_WIDTH-(length(text)-c)) shr 1)+1; 147 | print(x, y, text); 148 | end; 149 | 150 | function lpad(text: string; width: longint): string; 151 | begin 152 | while length(text) < width do text := ' '+text; 153 | lpad := text; 154 | end; 155 | 156 | function ltoa(v: longint): string; 157 | var text : string; 158 | begin 159 | if v = 0 then text := '-' else str(v, text); 160 | ltoa := text; 161 | end; 162 | 163 | function make_center(text: string; width: longint): string; 164 | var bound, 165 | len, i : longint; 166 | pad : string; 167 | begin 168 | len := length(text); 169 | if width < len then width := len; 170 | bound := (width-len) shr 1; 171 | pad := ''; 172 | for i := 1 to bound do pad := pad+' '; 173 | text := pad+text+pad; 174 | while length(text) < width do text := ' '+text; 175 | make_center := text; 176 | end; 177 | 178 | function wait(k: KEYS): char; 179 | var ch : char; 180 | begin 181 | repeat 182 | ch := upcase(readkey); 183 | until ch in k; 184 | wait := ch; 185 | end; 186 | 187 | function query(mesg: string): boolean; 188 | var value : boolean; 189 | begin 190 | center(24, mesg); 191 | value := wait(['Y','N',#13,#27]) in ['Y',#13]; 192 | center(24, lpad('',length(mesg))); 193 | query := value; 194 | end; 195 | 196 | procedure info(mesg: string); 197 | begin 198 | center(24, mesg); 199 | wait([#13,#27]); 200 | center(24, lpad('',length(mesg))); 201 | end; 202 | 203 | {$endif} 204 | -------------------------------------------------------------------------------- /ENGINE.INC: -------------------------------------------------------------------------------- 1 | {$ifndef __ENGINE_2048__} 2 | {$define __ENGINE_2048__} 3 | 4 | { ////////////////////////////////////////////////////////////////////////// } 5 | 6 | { Board constants } 7 | const BOARD_DIM = 4; 8 | BOARD_SIZE = BOARD_DIM*BOARD_DIM; 9 | BOARD_W = 6; 10 | BOARD_H = BOARD_W shr 1; 11 | BOARD_X = (SCR_WIDTH-BOARD_DIM * BOARD_W) shr 1; 12 | BOARD_Y = 11; 13 | BOARD_FILLER = #177#177#177#177#177#177; 14 | 15 | type TILE_TYPE = longint; 16 | VEC4_TYPE = array[0..BOARD_DIM-1] of TILE_TYPE; 17 | BOARD_TYPE = array[0..BOARD_DIM-1] of VEC4_TYPE; 18 | 19 | const GAME_WINCOND : longint = 11; 20 | GAME_SCORE : longint = 0; 21 | GAME_HISCORE : longint = 500; 22 | GAME_MOVES : longint = 0; 23 | FILE_SCORE : string[13] = 'HISCORE.DAT'; 24 | FILE_SAVE : string[13] = 'SAVEGAME.DAT'; 25 | CELL_COLORS : array[0..16] of byte = 26 | ($80, $70, 27 | $10, $20, $30, $40, $50, $90, $A0, 28 | $B0, $C0, $D0, $E0, $F0, $F0, $F0, $F0); 29 | 30 | { ////////////////////////////////////////////////////////////////////////// } 31 | 32 | { exposed game engine API } 33 | procedure boardShow(const board: BOARD_TYPE); forward; 34 | function boardFind(const v: VEC4_TYPE; x, stop: longint): longint; forward; 35 | function boardSlide(var v: VEC4_TYPE): boolean; forward; 36 | procedure boardRotate(var board: BOARD_TYPE); forward; 37 | function boardSlideUp(var board: BOARD_TYPE): boolean; forward; 38 | function boardSlideLeft(var board: BOARD_TYPE): boolean; forward; 39 | function boardSlideRight(var board: BOARD_TYPE): boolean; forward; 40 | function boardSlideDown(var board: BOARD_TYPE): boolean; forward; 41 | function boardCheckPair(board: BOARD_TYPE): boolean; forward; 42 | function boardCountBlank(board: BOARD_TYPE): longint; forward; 43 | function boardPlace(var board: BOARD_TYPE): boolean; forward; 44 | 45 | procedure stateInit(var board: BOARD_TYPE); forward; 46 | procedure stateRestart(var board: BOARD_TYPE); forward; 47 | function stateSave(var board: BOARD_TYPE): boolean; forward; 48 | function stateLoad(var board: BOARD_TYPE): boolean; forward; 49 | function stateCheckOver(board: BOARD_TYPE): boolean; forward; 50 | function stateCheckWin(board: BOARD_TYPE): boolean; forward; 51 | 52 | function scoreLoad: boolean; forward; 53 | function scoreSave: boolean; forward; 54 | 55 | { ////////////////////////////////////////////////////////////////////////// } 56 | 57 | { Displays the game board } 58 | procedure boardShow(const board: BOARD_TYPE); 59 | var 60 | x, y, v, 61 | i, j, c : longint; 62 | begin 63 | for y := 0 to BOARD_DIM-1 do 64 | for x := 0 to BOARD_DIM-1 do 65 | begin 66 | i := BOARD_X+x*BOARD_W; j := BOARD_Y+y*BOARD_H; 67 | v := board[x, y]; 68 | if v <> 0 then 69 | begin 70 | c := CELL_COLORS[v+1]; 71 | prints(i, j , c, BOARD_FILLER); 72 | prints(i, j+1, c, make_center(ltoa(1 shl longint(v)), BOARD_W)); 73 | prints(i, j+2, c, BOARD_FILLER); 74 | end 75 | else 76 | begin 77 | c := CELL_COLORS[(x+y) and 1]; 78 | prints(i, j , c, BOARD_FILLER); 79 | prints(i, j+1, c, BOARD_FILLER); 80 | prints(i, j+2, c, BOARD_FILLER); 81 | end; 82 | end; 83 | end; 84 | 85 | { Finds the proper cell to slide to } 86 | function boardFind(const v: VEC4_TYPE; x, stop: longint): longint; 87 | var t: longint; 88 | begin 89 | if x = 0 then 90 | begin 91 | boardFind := x; 92 | exit; 93 | end; 94 | t := x-1; 95 | while t >= 0 do 96 | begin 97 | if v[t] <> 0 then 98 | begin 99 | if v[t] <> v[x] then 100 | begin 101 | boardFind := t+1; 102 | exit; 103 | end; 104 | boardFind := t; 105 | exit; 106 | end 107 | else 108 | if t = stop then 109 | begin 110 | boardFind := t; 111 | exit; 112 | end; 113 | dec(t); 114 | end; 115 | end; 116 | 117 | { Slides the board } 118 | function boardSlide(var v: VEC4_TYPE): boolean; 119 | var success : boolean; 120 | x, t, 121 | stop : longint; 122 | begin 123 | stop := 0; 124 | success := FALSE; 125 | for x := 0 to BOARD_DIM-1 do 126 | begin 127 | if v[x] <> 0 then 128 | begin 129 | t := boardFind(v, x, stop); 130 | if (t <> x) then 131 | begin 132 | if v[t] = 0 then 133 | v[t] := v[x] 134 | else 135 | if v[t] = v[x] then 136 | begin 137 | inc(v[t]); 138 | inc(GAME_SCORE, 1 shl v[t]); 139 | if GAME_HISCORE < GAME_SCORE then 140 | GAME_HISCORE := GAME_SCORE; 141 | stop := t+1; 142 | end; 143 | v[x] := 0; 144 | success := TRUE; 145 | end; 146 | end; 147 | end; 148 | boardSlide := success; 149 | end; 150 | 151 | { Rotates the board CW } 152 | procedure boardRotate(var board: BOARD_TYPE); 153 | var i, j, 154 | t, n : longint; 155 | begin 156 | { inspace square CW matrix rotation, from geeksforgeeks.com } 157 | n := BOARD_DIM; 158 | for i := 0 to (n shr 1)-1 do 159 | for j := i to (n-i-1)-1 do 160 | begin 161 | t := board[j , i ]; 162 | board[j , i ] := board[i , n-1-j]; 163 | board[i , n-1-j] := board[n-1-j, n-1-i]; 164 | board[n-1-j, n-1-i] := board[n-1-i, j ]; 165 | board[n-1-i, j ] := t; 166 | end; 167 | end; 168 | 169 | { Slides the board up } 170 | function boardSlideUp(var board: BOARD_TYPE): boolean; 171 | var x : longint; 172 | ok, v : boolean; 173 | begin 174 | ok := FALSE; 175 | for x := 0 to BOARD_DIM-1 do 176 | begin 177 | { in case compiler option 'Complete boolean eval' is off } 178 | v := boardSlide(board[x]); 179 | ok := ok or v; 180 | end; 181 | boardSlideUp := ok; 182 | end; 183 | 184 | { Slides the board left } 185 | function boardSlideLeft(var board: BOARD_TYPE): boolean; 186 | var ok : boolean; 187 | begin 188 | boardRotate(board); 189 | ok := boardSlideUp(board); 190 | boardRotate(board); 191 | boardRotate(board); 192 | boardRotate(board); 193 | boardSlideLeft := ok; 194 | end; 195 | 196 | { Slides the board down } 197 | function boardSlideDown(var board: BOARD_TYPE): boolean; 198 | var ok : boolean; 199 | begin 200 | boardRotate(board); 201 | boardRotate(board); 202 | ok := boardSlideUp(board); 203 | boardRotate(board); 204 | boardRotate(board); 205 | boardSlideDown := ok; 206 | end; 207 | 208 | { Slides the board right } 209 | function boardSlideRight(var board: BOARD_TYPE): boolean; 210 | var ok : boolean; 211 | begin 212 | boardRotate(board); 213 | boardRotate(board); 214 | boardRotate(board); 215 | ok := boardSlideUp(board); 216 | boardRotate(board); 217 | boardSlideRight := ok; 218 | end; 219 | 220 | { Checks for mergeable pair } 221 | function boardCheckPair(board: BOARD_TYPE): boolean; 222 | var x, y : longint; 223 | begin 224 | for x := 0 to BOARD_DIM-1 do 225 | for y := 0 to BOARD_DIM-2 do 226 | if board[x, y] = board[x, y+1] then 227 | begin 228 | boardCheckPair := TRUE; 229 | exit; 230 | end; 231 | boardCheckPair := FALSE; 232 | end; 233 | 234 | { Counts the number of empty cells } 235 | function boardCountBlank(board: BOARD_TYPE): longint; 236 | var x, y, c : longint; 237 | begin 238 | c := 0; 239 | for x := 0 to BOARD_DIM-1 do 240 | for y := 0 to BOARD_DIM-1 do 241 | if board[x, y] = 0 then inc(c); 242 | boardCountBlank := c; 243 | end; 244 | 245 | { Place a random cell into the board } 246 | function boardPlace(var board: BOARD_TYPE): boolean; 247 | var x, y, 248 | r, n, 249 | len : longint; 250 | list : array[0..BOARD_SIZE-1] of record 251 | x, y: longint; 252 | end; 253 | begin 254 | len := 0; 255 | for x := 0 to BOARD_DIM-1 do 256 | for y := 0 to BOARD_DIM-1 do 257 | if board[x, y] = 0 then 258 | begin 259 | list[len].x := x; 260 | list[len].y := y; 261 | inc(len); 262 | end; 263 | if (len > 0) then 264 | begin 265 | r := random(len); 266 | n := (random(10) div 9)+1; 267 | board[list[r].x, list[r].y] := n; 268 | boardPlace := TRUE; 269 | end 270 | else boardPlace := FALSE; 271 | end; 272 | 273 | { Check for game over state } 274 | function stateCheckOver(board: BOARD_TYPE): boolean; 275 | var ended : boolean; 276 | begin 277 | ended := TRUE; 278 | if boardCountBlank(board) > 0 then 279 | begin 280 | stateCheckOver := FALSE; 281 | exit; 282 | end; 283 | if boardCheckPair(board) then 284 | begin 285 | stateCheckOver := FALSE; 286 | exit; 287 | end; 288 | 289 | boardRotate(board); 290 | if boardCheckPair(board) then 291 | ended := FALSE; 292 | boardRotate(board); 293 | boardRotate(board); 294 | boardRotate(board); 295 | stateCheckOver := ended; 296 | end; 297 | 298 | function stateCheckWin(board: BOARD_TYPE): boolean; 299 | var x, y, c : longint; 300 | begin 301 | for x := 0 to BOARD_DIM-1 do 302 | for y := 0 to BOARD_DIM-1 do 303 | if board[x, y] = GAME_WINCOND then 304 | begin 305 | stateCheckWin := TRUE; 306 | exit; 307 | end; 308 | stateCheckWin := FALSE; 309 | end; 310 | 311 | { Puts the game into initial state } 312 | procedure stateInit(var board: BOARD_TYPE); 313 | begin 314 | fillchar(board, sizeof(BOARD_TYPE), 0); 315 | GAME_MOVES := 0; 316 | GAME_SCORE := 0; 317 | end; 318 | 319 | { Restarts the game } 320 | procedure stateRestart(var board: BOARD_TYPE); 321 | begin 322 | stateInit(board); 323 | boardPlace(board); 324 | boardPlace(board); 325 | boardShow(board); 326 | end; 327 | 328 | { Saves current game state to the save game file, returns TRUE if succeed } 329 | function stateSave(var board: BOARD_TYPE): boolean; 330 | var f : FILE; 331 | ret : boolean; 332 | begin 333 | assign(f, FILE_SAVE); 334 | {$i-} 335 | rewrite(f, 1); 336 | {$i+} 337 | if ioresult = 0 then 338 | begin 339 | blockwrite(f, GAME_SCORE, sizeof(longint)); 340 | blockwrite(f, GAME_MOVES, sizeof(longint)); 341 | blockwrite(f, board, sizeof(BOARD_TYPE)); 342 | close(f); 343 | ret := TRUE; 344 | end 345 | else ret := FALSE; 346 | stateSave := ret; 347 | end; 348 | 349 | { Loads the game state from the save game file, returns TRUE if succeed } 350 | function stateLoad(var board: BOARD_TYPE): boolean; 351 | var f : FILE; 352 | ret : boolean; 353 | begin 354 | assign(f, FILE_SAVE); 355 | {$i-} 356 | reset(f, 1); 357 | {$i+} 358 | if ioresult = 0 then 359 | begin 360 | blockread(f, GAME_SCORE, sizeof(longint)); 361 | blockread(f, GAME_MOVES, sizeof(longint)); 362 | blockread(f, board, sizeof(BOARD_TYPE)); 363 | close(f); 364 | ret := TRUE; 365 | end 366 | else ret := FALSE; 367 | stateLoad := ret; 368 | end; 369 | 370 | { Loads the hi-score value from the score file, returns TRUE if succeed } 371 | function scoreLoad: boolean; 372 | var f : FILE; 373 | ret : boolean; 374 | begin 375 | assign(f, FILE_SCORE); 376 | {$i-} 377 | reset(f, 1); 378 | {$i+} 379 | if ioresult = 0 then 380 | begin 381 | blockread(f, GAME_HISCORE, sizeof(GAME_HISCORE)); 382 | close(f); 383 | ret := TRUE; 384 | end 385 | else ret := FALSE; 386 | scoreLoad := ret; 387 | end; 388 | 389 | { Saves the hi-score value into the score file, returns TRUE if succeed } 390 | function scoreSave: boolean; 391 | var f : FILE; 392 | ret : boolean; 393 | begin 394 | assign(f, FILE_SCORE); 395 | {$i-} 396 | rewrite(f, 1); 397 | {$i+} 398 | if ioresult = 0 then 399 | begin 400 | blockwrite(f, GAME_HISCORE, sizeof(GAME_HISCORE)); 401 | close(f); 402 | ret := TRUE; 403 | end 404 | else ret := FALSE; 405 | scoreSave := ret; 406 | end; 407 | 408 | {$endif} 409 | --------------------------------------------------------------------------------