---------------------------------------------------------------------------------------- -- Autor: Enrique Quintana Mata -- Proyecto: Buscaminas -- Fichero: Buscaminas.adb -- Fecha: 11.1.2000 -- Modificado por: Nadie -- Fecha de ultima modificación: Ninguna -- Descripción: En definitiva, se trata del conocido -- por todos, buscaminas de Windows, en el que hay que localizar una -- serie de minas distribuidas por una matriz. Por razones tecnicas se ha eliminado -- el tiempo y se ha sustituido por "intentos", puesto que el implementar un reloj a tiempo -- real ( y es que además no tengo ni repajolera idea de como se haría :) suponía complicar -- demasiado el programa. El juego se maneja de la siguiente manera: -- Inserta las cordenadas de la casilla ... ejemplo A,12 -- B para buscar en una casilla -- M para marcarla. -- Cuando creas que ya has terminado de marcar todas las minas inserta W (despejar) pero ten -- cuidado porque si buscas en una casilla en la que se esconda una mina... BOOM!!!! AL contrario -- que en el juego original, en este, es necesario marcar todas las minas antes de despejar todo -- el tablero (W). Si queda alguna mina sin marcar perderas la partida, eso si.. puedes poner -- tantas marcas como desees (aunque haya mas marcas que minas), pero ten en cuenta que se te -- quitarán puntos por cada marca (M) que no sea necesaria (y por cada acción que hagas!). -- Posible mejora: QUE PENA QUE NO SE PUEDAN USAR COLORES TODAVÍA!!! (o incluso ratón). ----------------------------------------------------------------------------------------- With text_io, Ada.Numerics.Discrete_Random, Ada.integer_text_io; Use text_io, Ada.integer_text_io; PROCEDURE Buscaminas is Lose: boolean := False; --> Verifica si has ganado o perdido la partida. Num_Minas: constant integer := 15; --> Numero de minas... Num_Filas: constant integer := 15; --> Tamaño del tablero Y Num_Columnas: constant integer := 15; --> Tamaño del tablero X Minas: integer := 0; --> lleva la cuenta de las minas que procesa CARGA MINAS Y PREPARA MATRIZ. Coord1: character := 'A'; --> Coordenada x Coord1bis: integer := 0; --> Para arreglar luego la coord1. Coord2: integer := 0; --> Coordenada Y Instruccion: character := 'B'; --> Buscar... marcar... ganar... -- IMPORTANTE!!! Se pueden cambiar el numero de minas sin problemas pero, intentar cambiar -- el tamaño del tablero requiere cambios muy profundos (habría que rehacer el programa desde -- el principio!!!) Se podría implementar para que al comenzar preguntase al jugador el tamaño -- del tablero, pero eso requiere mucho trabajo!!! (si es que en el fondo estoy echo un perro!) -- Si a alguien le da la picada de intentarlo de esta manera... le deseo buena suerte porque -- la va a necesitar! :) Matriz: array (0..Num_Filas + 1,0..Num_Columnas + 1) of Integer; --> Matriz para las minas Tapa: array (1..Num_Filas,1..Num_Columnas) of Character; --> Visión del tablero (lo que se ve...) :) Intentos: Integer := 0; --> Numero de busquedas, mas que nada sirve para la puntuación. Puntuación: Integer := 1000; --> Puntos!!! i´m the best! Ranking: File_Type; --> registro de archivo para los records (me parece que al final no lo voy a usar). ---------------------------- FUNCIÓN ALEATORIA PARA CREAR MINAS ------------------------------- -- IMPORTNATE!!! --> Se ha realizado un randomice mucho mayor al necesario, para asegurar -- mediante la operación de modulo, que el resultado del randomice sea más variable, -- de esta manera se obtienen resultados más diversos. Mientras mayor sea el rango del subtype -- tp_rango mejor... pero cuidadín!!! el programa irá mas lento! (calcular -- modulos lleva su tiempo, sobre todo si son numeros muy altos) :) FUNCTION xaleatorio RETURN integer IS subtype tp_rango is positive range 1..321; package random_X IS NEW Ada.Numerics.Discrete_Random(tp_rango); g: Random_X.Generator; begin Random_X.Reset(g); return ((random_X.Random(g) mod Num_Columnas) +1 ); END xaleatorio; FUNCTION yaleatorio RETURN integer IS subtype tp_rango is positive range 1..321; package random_Y IS NEW Ada.Numerics.Discrete_Random(tp_rango); g: Random_Y.Generator; begin Random_Y.Reset(g); return ((Random_Y.Random(g) mod Num_Filas) +1 ); END yaleatorio; -- Después de todo esto, al final, ha sido un fracaso... Las minas salen -- casi siempre en la diagonal de la matriz :( ------------------------------ INICIALIZAR LAS MATRICES ----------------------------------------- -- Pura rutina para poner los vectores a cero al iniciar... buf! PROCEDURE Borrar_Matriz is begin -- Para evitar posibles errores de Constraints and Discrete Ranges he ampliado en una unidad mas matrices. -- usando una especie de muro de contención de valor 20. De esta maera en seguida se reconoce si estoy en la fronteras. For j in 0..Num_Filas +1 loop For i in 0..Num_Columnas +1 loop Matriz(i,j) := 20; --> Limite de la matriz activa. end loop; end loop; For j in 1..Num_Filas loop For i in 1..Num_Columnas loop Matriz(i,j) := 0; --> Borra todas las minas. end loop; end loop; END; PROCEDURE Borrar_Tapa is begin For j in 1..Num_Filas loop For i in 1..Num_Columnas loop Tapa(i,j) := '#'; --> Borra el tablero. end loop; end loop; END; ---------------------------- DIBUJA EL TABLERO --------------------------------------------- PROCEDURE Tablero is begin --move_cursor(Row=>1,Column=>1); New_line; Put (" " & character'val(201)); For i in 1..Num_Columnas +2 loop Put(character'val(196)); end loop; Put(character'val(187)); new_line; For j in 1..Num_Filas loop Put (" " & character'val(179) & " "); For i in 1..Num_Columnas loop Put (Tapa(i,j)); end loop; Put (" "& character'val(179)); Put(j,3); -- A que queda bonito!!! :) Pues no te haces una idea de lo que cuesta!!! argh! if j = 1 then put (" "); end if; if j = 2 then put (" " & character'val(201)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(187)); end if; if j = 3 then put (" " & character'val(179) & " PUNTUACION:"); put (puntuación,5);put (" $ " & character'val(179)); end if; if j = 4 then put (" " & character'val(179) & " "& character'val(179)); end if; if j = 5 then put (" " & character'val(179) & " Minas:"); put (Num_Minas,3);put(" " & character'val(179)); end if; if j = 6 then put (" " & character'val(179) & " Tama¤o:"); put (Num_Filas,3); put (" x");put (Num_Columnas,3);put(" " & character'val(179)); end if; if j = 7 then put (" " & character'val(179) & " Intentos:"); put (Intentos,3);put(" " & character'val(179)); end if; if j = 8 then put (" " & character'val(200)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(188)); end if; if j = 10 then put (" " & character'val(201)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(187)); end if; if j = 11 then put (" " & character'val(179) & " * " & character'val(16) & " Minas! " & character'val(179));end if; if j = 12 then put (" " & character'val(179) & " ° " & character'val(16) & " No hay nada... " & character'val(179));end if; if j = 13 then put (" " & character'val(179) & " # " & character'val(16) & " Sin descubrir " & character'val(179));end if; if j = 14 then put (" " & character'val(179) & " M " & character'val(16) & " Mina marcada! " & character'val(179));end if; if j = 15 then put (" " & character'val(200)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(188)); end if; new_line; end loop; Put (" " & character'val(200)); For i in 1..Num_columnas +2 loop Put(character'val(196)); end loop; Put(character'val(188)); new_line; Put (" ABCDEFGHIJKLMNO "); new_line; --> muy util para saber que casilla señalar! END; ---------------------------- DIBUJA LA SOLUCION --------------------------------------------- -- Cuando se termine el juego será necesario enseñar todo el tablero... para que los -- jugadores puedan conprobar cuales han sido sus fallos o aciertos! Buena suerte!!! -- Posible mejora: QUE PENA QUE NO SE PUEDAN USAR COLORES TODAVÍA!!! PROCEDURE Solución is n: integer; begin --move_cursor(Row=>1,Column=>1)??? ¿donde esta el screen.adb... no lo encuentro!?; New_line; Put (" " & character'val(201)); For i in 1..Num_columnas +2 loop Put(character'val(196)); end loop; Put(character'val(187)); new_line; For j in 1..Num_Filas loop Put (" " & character'val(179) & " "); For i in 1..Num_Columnas loop n:= j; case Matriz(i,j) is --> de alguna manera había que tradudir de when 0 => -- integer a character... Put ('°'); --> espacio en blanco. when 1 => Put ('1'); when 2 => Put ('2'); when 3 => Put ('3'); when 4 => Put ('4'); when 5 => Put ('5'); when 6 => Put ('6'); --> Número de minas cercanas. when 7 => Put ('7'); when 8 => Put ('8'); when 9 => --> Atención al detalle! Los nueves son Put ('*'); -- minas que luego se traducen a '*' When others => Put ('°'); --> Si encuentras algo que no sabes lo que es => espacio en blanco. end case; end loop; Put (" "& character'val(179)); Put(n,3); -- A que queda bonito!!! :) if j = 1 then put (" "); end if; if j = 2 then put (" " & character'val(201)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(187)); end if; if j = 3 then put (" " & character'val(179) & " PUNTUACION:"); put (puntuación,5);put (" $ " & character'val(179)); end if; if j = 4 then put (" " & character'val(179) & " "& character'val(179)); end if; if j = 5 then put (" " & character'val(179) & " Minas:"); put (Num_Minas,3);put(" " & character'val(179)); end if; if j = 6 then put (" " & character'val(179) & " Tama¤o:"); put (Num_Filas,3); put (" x");put (Num_Columnas,3);put(" " & character'val(179)); end if; if j = 7 then put (" " & character'val(179) & " Intentos:"); put (Intentos,3);put(" " & character'val(179)); end if; if j = 8 then put (" " & character'val(200)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(188)); end if; if j = 10 then put (" " & character'val(201)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(187)); end if; if j = 11 then put (" " & character'val(179) & " * " & character'val(16) & " Minas! " & character'val(179));end if; if j = 12 then put (" " & character'val(179) & " ° " & character'val(16) & " No hay nada... " & character'val(179));end if; if j = 13 then put (" " & character'val(179) & " # " & character'val(16) & " Sin descubrir " & character'val(179));end if; if j = 14 then put (" " & character'val(179) & " M " & character'val(16) & " Mina marcada! " & character'val(179));end if; if j = 15 then put (" " & character'val(200)); for i in 1..22 loop put(character'val(196));end loop; put(character'val(188)); end if; new_line; end loop; Put (" " & character'val(200)); For i in 1..Num_columnas +2 loop Put(character'val(196)); end loop; Put(character'val(188)); new_line; Put (" ABCDEFGHIJKLMNO "); new_line; END; ------------------------- CARGA MINAS Y PREPARA MATRIZ -------------------------------- -- Genera aleatoriamente una serie de minas igual a la constante Num_Minas que reparte por -- el array Matriz. A continucaión genera el resto de las casillas buscando en las proximidades -- minas... huuuy! PROCEDURE Cargar_Matriz is x: integer:= xaleatorio; y: integer := yaleatorio; begin --Generando minas... For i in 1..Num_Minas loop While Matriz(x,y)= 9 or x=0 or x= Num_columnas +1 or y = 0 or y = Num_filas +1 loop x:= xaleatorio; y:= yaleatorio; --> hay que tener cuidad de no repetir casilla o salirse de la matriz activa. end loop; Matriz(x,y) := 9; end loop; --Buscando minas... For i in 1..Num_Filas loop For j in 1..Num_Columnas loop -- Podría haber habido problemas en casillas como la (1,1), por eso he tenido la -- precaución de definir el array Matriz desde (0..Num_Filas +1, 0.. Num_Columnas +1) If Matriz(i+1,j-1) = 9 then minas := minas +1; end if; If Matriz(i+1,j) = 9 then minas := minas +1; end if; If Matriz(i+1,j+1) = 9 then minas := minas +1; end if; If Matriz(i,j-1) = 9 then minas := minas +1; end if; If Matriz(i,j+1) = 9 then minas := minas +1; end if; If Matriz(i-1,j-1) = 9 then minas := minas +1; end if; If Matriz(i-1,j) = 9 then minas := minas +1; end if; If Matriz(i-1,j+1) = 9 then minas := minas +1; end if; If Matriz(i,j)=9 then minas := 9; end if; --> se asegura de que si la casilla --tenía una mina, no la cambie por una cifra--- CUIDADO!!! LOS 9 SON MINAS!!! Matriz(i,j):= minas; --> Total de minas en los alrededores... Minas := 0; end loop; end loop; END; -------------------------- DESPEJAR ESPACIOS EN BLANCO ------------------------------------- -- Se supone que este procedure debería buscar cuadros en blanco adyacenetes hasta que -- se tope con una mina o algo en la matriz que no sea un 0. El sistema es algo complejo... -- asi que no te comas mucho el coco intentando entender los bucles :) -- Anda que no me ha costado sacarlo!!! Sin duda alguna esto es lo que más cuesta -- de hacer del programa. PROCEDURE despejar(coord1bis: in integer; coord2: in integer) is Mem: array (0..Num_Columnas+1,0..Num_Filas+1)of integer; begin -- inicializamos Mem... muy importante! For i in 1..Num_Columnas loop For j in 1..Num_Filas loop mem(i,j):= 0; end loop; end loop; -- ponemos el espacio en blanco en la casilla y la marcamos como la 1. Tapa(coord1bis,coord2) := '°'; mem(coord1bis,coord2) := 1; --tablero; put("funciona"); for n in 1..30 loop --> indice de las casillas que buscamos --> miramos en la cuadricula en busca de casillas n --put(n); For i in 1..Num_Columnas loop For j in 1..Num_Filas loop if mem(i,j)= n and matriz(i,j) = 0 then if matriz(i+1,j-1)= 0 and mem(i+1,j-1)= 0 then mem(i+1,j-1):= n +1;end if; if matriz(i+1,j)= 0 and mem(i+1,j)= 0 then mem(i+1,j):= n +1;end if; if matriz(i+1,j+1)= 0 and mem(i+1,j+1)= 0 then mem(i+1,j+1):= n +1;end if; if matriz(i,j-1)= 0 and mem(i,j-1)= 0 then mem(i,j-1):= n +1;end if; if matriz(i,j+1)= 0 and mem(i,j+1)= 0 then mem(i,j+1):= n +1;end if; if matriz(i-1,j-1)= 0 and mem(i-1,j-1)= 0 then mem(i-1,j-1):= n +1;end if; if matriz(i-1,j)= 0 and mem(i-1,j)= 0 then mem(i-1,j):= n +1;end if; if matriz(i-1,j+1)= 0 and mem(i-1,j+1)= 0 then mem(i-1,j+1):= n +1;end if; if matriz(i+1,j-1) > 0 and matriz(i+1,j-1) < 9 then Tapa(i+1,j-1):= character'val(48 + matriz(i+1,j-1));end if; if matriz(i+1,j) > 0 and matriz(i+1,j) < 9 then Tapa(i+1,j):= character'val(48 + matriz(i+1,j));end if; if matriz(i+1,j+1) > 0 and matriz(i+1,j+1) < 9 then Tapa(i+1,j+1):= character'val(48 + matriz(i+1,j+1));end if; if matriz(i,j-1) > 0 and matriz(i,j-1) < 9 then Tapa(i,j-1):= character'val(48 + matriz(i,j-1));end if; if matriz(i,j+1) > 0 and matriz(i,j+1) < 9 then Tapa(i,j+1):= character'val(48 + matriz(i,j+1));end if; if matriz(i-1,j-1) > 0 and matriz(i-1,j-1) < 9 then Tapa(i-1,j-1):= character'val(48 + matriz(i-1,j-1));end if; if matriz(i-1,j) > 0 and matriz(i-1,j) < 9 then Tapa(i-1,j):= character'val(48 + matriz(i-1,j));end if; if matriz(i-1,j+1) > 0 and matriz(i-1,j+1) < 9 then Tapa(i-1,j+1):= character'val(48 + matriz(i-1,j+1));end if; --> y si sus proximidades estan libres las marcamos con n+1 para luego volver arriba y hacer lo mismo con ellas. end if; end loop; end loop; end loop; --y lluego se descubren todas las casillas que han sido numeradas... for i in 1..Num_Columnas loop for j in 1..Num_Filas loop if mem(i,j) /= 0 then Tapa(i,j) := '°'; end if; end loop; end loop; END; ------------------------- PRINCIPIO ------------------------------------------------- -- Y aqui es donde empieza el mondongo de verdad... Begin Borrar_Tapa; Borrar_Matriz; Cargar_Matriz; Loop Tablero; New_line; -- Introducimos las instrucciones... Put("Coordenada X (letra)? "); get(coord1); skip_line; Put("Coordenada Y (numero)? "); get(coord2); skip_line; Put("(B)uscar, (M)arcar, (W) destapar? "); get(instruccion); new_line; -- Arregla la coordenada X para que sea en numero. Vale lo sé... es una cutrería!!! -- Hubiera sida mejor character'pos(coord1)-character'pos('A') +1 pero es que así no me -- reconoce mayusculas y minusculas... mmmhhh... definitivamente ESTO SE PUEDE MEJORAR! case coord1 is when 'A'| 'a' => coord1bis := 1; when 'B'|'b' => coord1bis := 2; when 'C'| 'c' => coord1bis := 3; when 'D'| 'd' => coord1bis := 4; when 'E'| 'e' => coord1bis := 5; when 'F'| 'f' => coord1bis := 6; when 'G'| 'g' => coord1bis := 7; when 'H'| 'h' => coord1bis := 8; when 'I'| 'i' => coord1bis := 9; when 'J'| 'j' => coord1bis := 10; when 'K'| 'k' => coord1bis := 11; when 'L'| 'l' => coord1bis := 12; when 'M'| 'm' => coord1bis := 13; when 'N'| 'n' => coord1bis := 14; when 'O'| 'o' => coord1bis := 15; when others => coord1Bis := 0; end case; -- Y actua sobre la casilla... Case instruccion is when 'M'| 'm' => --> marcar minas.... case Tapa(coord1bis,coord2) is when 'M' => Tapa(coord1bis,coord2) := '#'; when '#' => Tapa(coord1bis,coord2) := 'M'; when others => delay(0.1);--> tenía que poner algo y no sabía qué. :) CUTRE! end case; --> me obliga a usar others! no me deja quitarlo.. :( snif! when 'B'| 'b' => --> destapar casillas... if Matriz(coord1bis,coord2)= 9 then lose:= true; end if; --> BoooM! HAS ENCONTRADO UNA MINA. if Matriz(coord1bis,coord2)= 0 then despejar(coord1bis,coord2); end if; --> despejar cuadros en blanco. if Matriz(coord1bis,coord2) /= 0 and Matriz(coord1bis,coord2) /= 9 then Tapa(coord1bis,coord2) := character'val(48 + Matriz(coord1bis,coord2)); end if; when others => delay(0.1); --> me obliga a usar others! no me deja quitarlo.. :( snif! end case; intentos:= intentos +1; puntuación:= puntuación -10; Exit when instruccion = 'W' or instruccion = 'w'; Exit when Lose = true; end loop; -- A partir de aqui calcula si has ganado o has perdido y con cuantos puntos lo has hecho. For j in 1..Num_Filas loop For i in 1..Num_Columnas loop if Matriz(i,j)=9 and Tapa(i,j)= 'M' then puntuación := puntuación + 100; end if; if Matriz(i,j)/=9 and Tapa(i,j)= 'M' then puntuación := puntuación - 500; end if; if matriz(i,j)=9 and Tapa(i,j) /= 'M' then Lose:= True; end if; end loop; end loop; if Lose = True then puntuación:= 0; end if; Solución; New_line; put(" ");new_line; put(" Tu puntuacion a sido de ");put(puntuación,0);put(" $"); new_line; if Lose = False then put(" Has ganado!!!"); else put(" Has perdido!!! Patan!!! Todavia te quedaban minas por marcar"); end if; --delay(10.0); --> y al cabo de un rato se finaliza o mejor aún... :) get_immediate(instruccion); --> espera a que pulses una tecla antes de terminar. END Buscaminas;