Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
421 lines (394 sloc) 9.5 KB
{$M 32000,0,655360}
USES CRT,DOS,JOGOS;
CONST
J1='JOGADOR 1 (X)';
J2='JOGADOR 2 (O)';
X1=15-LENGTH (J1) DIV 2;
X2=65-LENGTH (J2) DIV 2;
TYPE
TIMP= (INV,NOR,LIG);
QUAD= (XX,OO,NADA,MARCA);
OPERACAO= (MOSTRAR,CHECAR);
T1D= ARRAY [1..4] OF QUAD;
T2D= ARRAY [1..4] OF T1D;
T3D= ARRAY [1..4] OF T2D;
T4D= ARRAY [1..4] OF T3D;
VAR
TAB: T4D;
SX,SY,SZ,ST,LRX,LRY,PRX,PRY,PX,PY,PZ,PT: BYTE;
VEZ: QUAD;
SI: POINTER;
AJX,AJO,GAMEOVER: BOOLEAN;
PROCEDURE INITQUADRO;
VAR
X,Y,Z,T: BYTE;
BEGIN
FOR X:=1 TO 4 DO
FOR Y:=1 TO 4 DO
FOR Z:=1 TO 4 DO
FOR T:=1 TO 4 DO
TAB[X,Y,Z,T]:=NADA;
END;
PROCEDURE SETCOLOR (B: TIMP);
BEGIN
CASE B OF
INV: INVERSE (ON);
NOR: INVERSE (OFF);
LIG: LIGHT (ON);
END;
END;
PROCEDURE IMPUM (X,Y,Z,T: BYTE; B: TIMP);
VAR
S: BYTE;
BEGIN
S:=TEXTATTR;
SETCOLOR (B);
GOTOXY (25+X+Z*5,Y+T*5-2);
CASE TAB[X,Y,Z,T] OF
XX: REALWRITE ('X');
OO: REALWRITE ('O');
NADA: REALWRITE (#250);
MARCA: REALWRITE (#7);
END;
TEXTATTR:=S;
END;
PROCEDURE IMPTUDO;
VAR
X,Y,Z,T: BYTE;
BEGIN
FOR X:=1 TO 4 DO
FOR Y:=1 TO 4 DO
FOR Z:=1 TO 4 DO
FOR T:=1 TO 4 DO
IMPUM (X,Y,Z,T,NOR);
END;
PROCEDURE JOGADOR (N: BYTE; B: BOOLEAN);
BEGIN
LIGHT (B);
IF N=1 THEN BEGIN
GOTOXY (X1,3);
WRITE (J1);
END ELSE BEGIN
GOTOXY (X2,3);
WRITE (J2);
END;
END;
PROCEDURE IMPAJUDA (N: BYTE);
VAR
AJ: STRING;
B: BOOLEAN;
X: BYTE;
BEGIN
LIGHT (OFF);
AJ:='AJUDA: ';
IF N=1 THEN B:=AJX ELSE B:=AJO;
IF B THEN AJ:=AJ+'SIM' ELSE AJ:=AJ+'NAO';
IF N=1 THEN X:=15 ELSE X:=65;
GOTOXY (X-LENGTH (AJ) DIV 2,22);
WRITE (AJ);
END;
PROCEDURE INITVIDEO;
VAR
S1,S2,S3: STRING;
N: BYTE;
PROCEDURE LINHA (Y: BYTE);
VAR
N: BYTE;
BEGIN
FOR N:=Y TO Y+3 DO BEGIN
GOTOXY (30,N);
WRITE (S2);
END;
END;
BEGIN
INVERSE (OFF);
CLRSCR;
CURSOR (OFF);
IMPSTATUS ('JOGO DA VELHA 4D - BY RICARDO BITTENCOURT',1);
S1:=SEQ (ESP,4);
S2:=SEQ (#179+S1,4)+#179;
S3:=SEQ (#196,4);
GOTOXY (30,3);
WRITE (#218,SEQ (S3+#194,3),S3,#191);
FOR N:=1 TO 3 DO BEGIN
LINHA (N*5-1);
GOTOXY (30,N*5+3);
WRITE (#195,SEQ (S3+#197,3),S3,#180);
END;
LINHA (19);
GOTOXY (30,23);
WRITE (#192,SEQ (S3+#193,3),S3,#217);
IMPTUDO;
FOR N:=1 TO 2 DO BEGIN
JOGADOR (N,OFF);
IMPAJUDA (N);
END;
END;
PROCEDURE INITVARS;
BEGIN
PX:=1;
PY:=1;
PZ:=1;
PT:=1;
PRX:=0;
PRY:=0;
LRX:=255;
LRY:=255;
SX:=255;
SY:=255;
SZ:=255;
ST:=255;
VEZ:=XX;
GAMEOVER:=FALSE;
END;
FUNCTION AJUDA (V: QUAD; OP: OPERACAO): QUAD;
VAR
X,Y,Z,T: BYTE;
PROCEDURE MOSTRA (X1,Y1,Z1,T1,X2,Y2,Z2,T2,X3,Y3,Z3,T3,X4,Y4,Z4,T4: BYTE);
BEGIN
IF (TAB[X1,Y1,Z1,T1] IN [XX,OO]) AND
(TAB[X1,Y1,Z1,T1]=TAB[X2,Y2,Z2,T2]) AND
(TAB[X2,Y2,Z2,T2]=TAB[X3,Y3,Z3,T3]) AND
(TAB[X3,Y3,Z3,T3]=TAB[X4,Y4,Z4,T4])
THEN BEGIN
IMPUM (PX,PY,PZ,PT,NOR);
IMPUM (X1,Y1,Z1,T1,LIG);
IMPUM (X2,Y2,Z2,T2,LIG);
IMPUM (X3,Y3,Z3,T3,LIG);
IMPUM (X4,Y4,Z4,T4,LIG);
GAMEOVER:=TRUE;
AJUDA:=TAB[X1,Y1,Z1,T1];
END;
END;
PROCEDURE CHECA (X1,Y1,Z1,T1,X2,Y2,Z2,T2,X3,Y3,Z3,T3,X4,Y4,Z4,T4: BYTE);
VAR
E,S: BYTE;
B: BOOLEAN;
Q: QUAD;
BEGIN
S:=0;
E:=0;
IF TAB[X1,Y1,Z1,T1]=V THEN INC (S);
IF TAB[X2,Y2,Z2,T2]=V THEN INC (S,2);
IF TAB[X3,Y3,Z3,T3]=V THEN INC (S,4);
IF TAB[X4,Y4,Z4,T4]=V THEN INC (S,8);
IF TAB[X1,Y1,Z1,T1] IN [NADA,MARCA] THEN INC (E);
IF TAB[X2,Y2,Z2,T2] IN [NADA,MARCA] THEN INC (E,2);
IF TAB[X3,Y3,Z3,T3] IN [NADA,MARCA] THEN INC (E,4);
IF TAB[X4,Y4,Z4,T4] IN [NADA,MARCA] THEN INC (E,8);
IF V=XX THEN B:=AJX ELSE B:=AJO;
IF B THEN Q:=MARCA ELSE Q:=NADA;
IF (S+E<>15) OR (E=15) THEN EXIT;
IF NOT (E IN [1,2,4,8]) THEN EXIT;
IMPUM (PX,PY,PZ,PT,NOR);
CASE E OF
1: TAB[X1,Y1,Z1,T1]:=Q;
2: TAB[X2,Y2,Z2,T2]:=Q;
4: TAB[X3,Y3,Z3,T3]:=Q;
8: TAB[X4,Y4,Z4,T4]:=Q;
END;
IMPUM (X1,Y1,Z1,T1,NOR);
IMPUM (X2,Y2,Z2,T2,NOR);
IMPUM (X3,Y3,Z3,T3,NOR);
IMPUM (X4,Y4,Z4,T4,NOR);
END;
PROCEDURE VERIFICA (X1,Y1,Z1,T1,X2,Y2,Z2,T2,X3,Y3,Z3,T3,X4,Y4,Z4,T4: BYTE);
BEGIN
CASE OP OF
MOSTRAR: MOSTRA (X1,Y1,Z1,T1,X2,Y2,Z2,T2,X3,Y3,Z3,T3,X4,Y4,Z4,T4);
CHECAR: CHECA (X1,Y1,Z1,T1,X2,Y2,Z2,T2,X3,Y3,Z3,T3,X4,Y4,Z4,T4);
END;
END;
BEGIN
AJUDA:=NADA;
FOR T:=1 TO 4 DO
FOR Z:=1 TO 4 DO
FOR X:=1 TO 4 DO
VERIFICA (X,1,Z,T,X,2,Z,T,X,3,Z,T,X,4,Z,T);
FOR T:=1 TO 4 DO
FOR Z:=1 TO 4 DO
FOR Y:=1 TO 4 DO
VERIFICA (1,Y,Z,T,2,Y,Z,T,3,Y,Z,T,4,Y,Z,T);
FOR X:=1 TO 4 DO
FOR Z:=1 TO 4 DO
FOR Y:=1 TO 4 DO
VERIFICA (X,Y,Z,1,X,Y,Z,2,X,Y,Z,3,X,Y,Z,4);
FOR T:=1 TO 4 DO
FOR X:=1 TO 4 DO
FOR Y:=1 TO 4 DO
VERIFICA (X,Y,1,T,X,Y,2,T,X,Y,3,T,X,Y,4,T);
FOR T:=1 TO 4 DO
FOR Z:=1 TO 4 DO BEGIN
VERIFICA (1,1,Z,T,2,2,Z,T,3,3,Z,T,4,4,Z,T);
VERIFICA (4,1,Z,T,3,2,Z,T,2,3,Z,T,1,4,Z,T);
END;
FOR T:=1 TO 4 DO
FOR Y:=1 TO 4 DO BEGIN
VERIFICA (1,Y,1,T,2,Y,2,T,3,Y,3,T,4,Y,4,T);
VERIFICA (4,Y,1,T,3,Y,2,T,2,Y,3,T,1,Y,4,T);
END;
FOR X:=1 TO 4 DO
FOR Z:=1 TO 4 DO BEGIN
VERIFICA (X,1,Z,1,X,2,Z,2,X,3,Z,3,X,4,Z,4);
VERIFICA (X,4,Z,1,X,3,Z,2,X,2,Z,3,X,1,Z,4);
END;
FOR Z:=1 TO 4 DO
FOR Y:=1 TO 4 DO BEGIN
VERIFICA (1,Y,Z,1,2,Y,Z,2,3,Y,Z,3,4,Y,Z,4);
VERIFICA (1,Y,Z,4,2,Y,Z,3,3,Y,Z,2,4,Y,Z,1);
END;
FOR X:=1 TO 4 DO
FOR Y:=1 TO 4 DO BEGIN
VERIFICA (X,Y,1,1,X,Y,2,2,X,Y,3,3,X,Y,4,4);
VERIFICA (X,Y,1,4,X,Y,2,3,X,Y,3,2,X,Y,4,1);
END;
FOR X:=1 TO 4 DO
FOR T:=1 TO 4 DO BEGIN
VERIFICA (X,1,1,T,X,2,2,T,X,3,3,T,X,4,4,T);
VERIFICA (X,4,1,T,X,3,2,T,X,2,3,T,X,1,4,T);
END;
FOR X:=1 TO 4 DO BEGIN
VERIFICA (X,1,1,1,X,2,2,2,X,3,3,3,X,4,4,4);
VERIFICA (X,4,1,4,X,3,2,3,X,2,3,2,X,1,4,1);
VERIFICA (X,1,1,4,X,2,2,3,X,3,3,2,X,4,4,1);
VERIFICA (X,4,1,1,X,3,2,2,X,2,3,3,X,1,4,4);
END;
FOR Y:=1 TO 4 DO BEGIN
VERIFICA (1,Y,1,1,2,Y,2,2,3,Y,3,3,4,Y,4,4);
VERIFICA (4,Y,4,1,3,Y,3,2,2,Y,2,3,1,Y,1,4);
VERIFICA (4,Y,1,1,3,Y,2,2,2,Y,3,3,1,Y,4,4);
VERIFICA (1,Y,4,1,2,Y,3,2,3,Y,2,3,4,Y,1,4);
END;
FOR Z:=1 TO 4 DO BEGIN
VERIFICA (1,1,Z,1,2,2,Z,2,3,3,Z,3,4,4,Z,4);
VERIFICA (1,4,Z,4,2,3,Z,3,3,2,Z,2,4,1,Z,1);
VERIFICA (1,4,Z,1,2,3,Z,2,3,2,Z,3,4,1,Z,4);
VERIFICA (1,1,Z,4,2,2,Z,3,3,3,Z,2,4,4,Z,1);
END;
FOR T:=1 TO 4 DO BEGIN
VERIFICA (1,1,1,T,2,2,2,T,3,3,3,T,4,4,4,T);
VERIFICA (1,4,1,T,2,3,2,T,3,2,3,T,4,1,4,T);
VERIFICA (4,4,1,T,3,3,2,T,2,2,3,T,1,1,4,T);
VERIFICA (4,1,1,T,3,2,2,T,2,3,3,T,1,4,4,T);
END;
VERIFICA (1,4,1,4,2,3,2,3,3,2,3,2,4,1,4,1);
VERIFICA (1,4,4,1,2,3,3,2,3,2,2,3,4,1,1,4);
VERIFICA (1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4);
VERIFICA (4,4,1,1,3,3,2,2,2,2,3,3,1,1,4,4);
VERIFICA (1,1,1,4,2,2,2,3,3,3,3,2,4,4,4,1);
VERIFICA (4,4,1,4,3,3,2,3,2,2,3,2,1,1,4,1);
VERIFICA (4,1,1,1,3,2,2,2,2,3,3,3,1,4,4,4);
VERIFICA (1,4,1,1,2,3,2,2,3,2,3,3,4,1,4,4);
END;
PROCEDURE GANHOU;
CONST
V='VENCEDOR';
X1=15-LENGTH (V) DIV 2;
X2=65-LENGTH (V) DIV 2;
BEGIN
IF VEZ=XX THEN GOTOXY (X2,8) ELSE GOTOXY (X1,8);
PISCA (ON);
WRITE (V);
END;
PROCEDURE LASTKEY;
VAR
X,Y,Z,T: BYTE;
BEGIN
IF SX=255 THEN EXIT;
IMPUM (SX,SY,SZ,ST,LIG);
WAITFORKEY;
IMPUM (SX,SY,SZ,ST,NOR);
END;
PROCEDURE DESISTIU;
CONST
DES='DESISTIU';
VAR
X: BYTE;
BEGIN
IF VEZ=XX THEN X:=15 ELSE X:=65;
LIGHT (OFF);
PISCA (ON);
GOTOXY (X-LENGTH (DES) DIV 2,8);
WRITE (DES);
END;
PROCEDURE JOGA;
VAR
T: CHAR;
Q: QUAD;
BEGIN
REPEAT
IF VEZ=XX THEN JOGADOR (1,ON) ELSE JOGADOR (2,ON);
IMPUM (PX,PY,PZ,PT,INV);
T:=READKEY;
IF T=#0 THEN CASE READKEY OF
UP: DEC (PRY);
DOWN: INC (PRY);
LEFT: DEC (PRX);
RIGHT: INC (PRX);
F1: LASTKEY;
F2: BEGIN
IF AJX THEN AJX:=FALSE ELSE AJX:=TRUE;
IMPAJUDA (1);
Q:=AJUDA (XX,CHECAR);
END;
F3: BEGIN
IF AJO THEN AJO:=FALSE ELSE AJO:=TRUE;
IMPAJUDA (2);
Q:=AJUDA (OO,CHECAR);
END;
END;
IF (LRY<>PRY) OR (LRX<>PRX) THEN BEGIN
IF PRY=255 THEN PRY:=15;
IF PRY=16 THEN PRY:=0;
IF PRX=255 THEN PRX:=15;
IF PRX=16 THEN PRX:=0;
IMPUM (PX,PY,PZ,PT,NOR);
PX:=PRX MOD 4+1;
PZ:=PRX DIV 4+1;
PY:=PRY MOD 4+1;
PT:=PRY DIV 4+1;
END;
IF (T IN [CR,ESP]) AND (TAB [PX,PY,PZ,PT] IN [NADA,MARCA]) THEN BEGIN
TAB [PX,PY,PZ,PT]:=VEZ;
SX:=PX;
SY:=PY;
SZ:=PZ;
ST:=PT;
IF AJX THEN Q:=AJUDA (XX,CHECAR);
IF AJO THEN Q:=AJUDA (OO,CHECAR);
IF VEZ=XX THEN BEGIN
VEZ:=OO;
JOGADOR (1,OFF);
END ELSE BEGIN
VEZ:=XX;
JOGADOR (2,OFF);
END;
IF AJUDA (NADA,MOSTRAR)<>NADA THEN GANHOU;
END;
LRX:=PRX;
LRY:=PRY;
UNTIL (T=ESC) OR GAMEOVER;
IF T=ESC THEN DESISTIU;
END;
PROCEDURE FINAL;
BEGIN
INVERSE (OFF);
CURSOR (ON);
CLRSCR;
END;
PROCEDURE REALINIT;
BEGIN
AJX:=OFF;
AJO:=OFF;
END;
BEGIN
REALINIT;
REPEAT
INITQUADRO;
INITVARS;
INITVIDEO;
JOGA;
IMPSTATUS ('[RETURN] NOVAMENTE / [ESC] SAI',24);
UNTIL READKEY=ESC;
FINAL;
END.