Pascal/Turbo Pascal - programa buttonmania

 
Vista:

programa buttonmania

Publicado por anonimo (1 intervención) el 11/01/2011 11:13:43
Necesito que alguien me ayuda a realizar el programa buttonmania en pascal!!!!!

http://www.c-point.com/JavaScript/ButtonMania.htm

Una explicacion rapida; es Se juega en un tablero cuadrado de 36 casillas, en cada una de las cuales aparece inicialmente un número del 0 al 3. Si se selecciona una casilla y se “golpea” en ella, el número de esa casilla y de
sus vecinas (arriba, abajo y a ambos lados) se decrementará en una unidad, pero de forma que al
decrementar un 0 se obtendrá un 3. (Las 16 celdas centrales tienen 4 vecinas, mientras que las de
los bordes tienen 3 ó 2). El objetivo del juego es dejar todo el tablero con ceros.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

programa buttonmania

Publicado por ramon (2158 intervenciones) el 24/07/2011 18:57:50
{Espero te siga interesando }

program buttoman;
uses
crt, dos;
type
casillas = array[1..6,1..6] of integer;

var
matrant, matric : casillas;
canx, cany, cu, x, y, i, k : integer;
texto : byte;
regs : registers;
modi, sal, raton : boolean;
tec : char;
rax, ray : word;



function raton_pres : boolean;
begin
regs.ah := $00;
regs.al := $00;
intr($33,regs);
if regs.ax <> 0 then
raton_pres := true
else
raton_pres := false;
end;

procedure muestra_r;
begin
raton := false;
if raton_pres then
begin
regs.ah := $00;
regs.al := $01;
intr($33,regs);
raton := true;
end;
end;

procedure oculta_r;
begin
if raton = true then
begin
regs.ah := $00;
regs.al := $02;
intr($33,regs);
raton := false;
end;
end;

function posx_r : word;
begin
posx_r := 0;
regs.ah := $00;
regs.al := $03;
intr($33,regs);
posx_r := regs.cx div 8 + 1;
end;

function posy_r : word;
begin
posy_r := 0;
regs.ah := $00;
regs.al := $03;
intr($33,regs);
posy_r := regs.dx div 8 + 1;
end;

function boton_r : word;
begin
boton_r := 0;
regs.ah := $00;
regs.al := $03;
intr($33,regs);
boton_r := regs.bx
end;

procedure posicion_raton(xt, yt : word);
begin
regs.ax := $04;
regs.cx := (xt - 1) * 8;
regs.dx := (yt - 1) * 8;
intr($33,regs);
end;

procedure tablero;
begin
gotoxy(8,2);write('*** BUTTONMANIA ***');
gotoxy(6,4);write('[Nuevo] [Restaurar] ');
gotoxy(6,6);write(' ------------------------');
gotoxy(6,7);write('| | | | | | |');
gotoxy(6,8);write(' -----------------------');
gotoxy(6,9);write('| | | | | | |');
gotoxy(6,10);write(' -----------------------');
gotoxy(6,11);write('| | | | | | |');
gotoxy(6,12);write(' -----------------------');
gotoxy(6,13);write('| | | | | | |');
gotoxy(6,14);write(' -----------------------');
gotoxy(6,15);write('| | | | | | |');
gotoxy(6,16);write(' -----------------------');
gotoxy(6,17);write('| | | | | | |');
gotoxy(6,18);write(' -----------------------');
gotoxy(13,20);write('[Terminar]');
gotoxy(3,22);write('**** Use el Mouse O [ESC] Salida Rapida ****');
gotoxy(1,1);write(' ');
end;

procedure presenta_valor;
var
xb, yb : integer;
begin
for yb := 1 to 6 do
for xb := 1 to 6 do
begin
gotoxy(4 + (xb * 4),5 + (yb * 2));write(matric[xb,yb]);
end;
end;

procedure inicia_valores;
var
xb, yb : integer;
valor : integer;
begin
tablero;
fillchar(matric,sizeof(casillas),0);
Randomize;
yb := 1;
xb := 1;
repeat
for xb := 1 to 6 do
begin
valor := random(4);
matric[xb,yb] := valor;
end;
yb := yb + 1;
until yb > 6;
move(matric,matrant,sizeof(matric));
for yb := 1 to 6 do
for xb := 1 to 6 do
begin
gotoxy(4 + (xb * 4),5 + (yb * 2));write(matric[xb,yb]);
end;
end;

procedure ponvalores(posx, posy, n : integer);
var
valo : integer;
begin
if modi = true then
begin
move(matric,matrant,sizeof(matric));
if n <> 0 then
matric[posx,posy] := matric[posx,posy] - 1
else
matric[posx,posy] := 3;
canx := posx;
cany := posy;
case posy of
1 : begin
case posx of
1 : begin
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
end;
2,3,4,5 : begin
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
end;
6 : begin
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
end;
end;
end;
2,3,4,5 : begin
case posx of
1 : begin
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
end;
2, 3, 4, 5 : begin
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
end;
6 : begin
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
matric[posx,posy + 1] := matric[posx,posy + 1] - 1;
if matric[posx,posy + 1] < 0 then
matric[posx,posy + 1] := 3;
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
end;
end;
end;
6 : begin
case posx of
1 : begin
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
end;
2,3,4,5 : begin
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
matric[posx + 1,posy] := matric[posx + 1,posy] - 1;
if matric[posx + 1,posy] < 0 then
matric[posx + 1,posy] := 3;
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
end;
6 : begin
matric[posx,posy - 1] := matric[posx,posy - 1] - 1;
if matric[posx,posy - 1] < 0 then
matric[posx,posy - 1] := 3;
matric[posx - 1,posy] := matric[posx - 1,posy] - 1;
if matric[posx - 1,posy] < 0 then
matric[posx - 1,posy] := 3;
end;
end;
end;
end;
end
else
modi := true;
end;

procedure asignabalorxy(rx, ry : word);
begin
case ry of
7 : begin
case rx of
8 : begin x := 1; y := 1; end;
12 : begin x := 2; y := 1; end;
16 : begin x := 3; y := 1; end;
20 : begin x := 4; y := 1; end;
24 : begin x := 5; y := 1; end;
28 : begin x := 6; y := 1; end;
end;
end;
9 : begin
case rx of
8 : begin x := 1; y := 2; end;
12 : begin x := 2; y := 2; end;
16 : begin x := 3; y := 2; end;
20 : begin x := 4; y := 2; end;
24 : begin x := 5; y := 2; end;
28 : begin x := 6; y := 2; end;
end;
end;
11 : begin
case rx of
8 : begin x := 1; y := 3; end;
12 : begin x := 2; y := 3; end;
16 : begin x := 3; y := 3; end;
20 : begin x := 4; y := 3; end;
24 : begin x := 5; y := 3; end;
28 : begin x := 6; y := 3; end;
end;
end;
13 : begin
case rx of
8 : begin x := 1; y := 4; end;
12 : begin x := 2; y := 4; end;
16 : begin x := 3; y := 4; end;
20 : begin x := 4; y := 4; end;
24 : begin x := 5; y := 4; end;
28 : begin x := 6; y := 4; end;
end;
end;
15 : begin
case rx of
8 : begin x := 1; y := 5; end;
12 : begin x := 2; y := 5; end;
16 : begin x := 3; y := 5; end;
20 : begin x := 4; y := 5; end;
24 : begin x := 5; y := 5; end;
28 : begin x := 6; y := 5; end;
end;
end;
17 : begin
case rx of
8 : begin x := 1; y := 6; end;
12 : begin x := 2; y := 6; end;
16 : begin x := 3; y := 6; end;
20 : begin x := 4; y := 6; end;
24 : begin x := 5; y := 6; end;
28 : begin x := 6; y := 6; end;
end;
end;
end;
end;

begin
clrscr;
textcolor(15);
if raton_pres = true then
begin
muestra_r;
inicia_valores;
modi := true;
move(matric,matrant,sizeof(matric));
sal := false;
gotoxy(1,1);write('');
rax := posx_r;
ray := posy_r;
repeat
if (rax <> posx_r) or (ray <> posy_r) then
begin
rax := posx_r;
ray := posy_r;
end;
if boton_r = 1 then
begin
oculta_r;
if ray = 4 then
begin
case rax of
7..11 : inicia_valores;
17..25 : begin
move(matrant,matric,sizeof(matric));
presenta_valor;
modi := false;
gotoxy(1,1);write('');
end;
end;
end;
if ray = 20 then
begin
case rax of
14..21 : sal := true;
end;
end
else
begin
if (ray in[7,9,11,13,15,17]) and (rax in[8,12,16,20,24,28]) then
begin
asignabalorxy(rax, ray);
cu := matric[x,y];
ponvalores(x,y,cu);
presenta_valor;
end;
end;
muestra_r;
posicion_raton(rax,ray);
delay(100);
gotoxy(1,1);write('');
end;
if keypressed then
tec := readkey;
until (tec = #27) or (sal = true);
oculta_r;
end;
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar