[ Foro de Pascal ]

archivo de texto

26-Jan-2014 23:25
natalia tavora
7 Respuestas

Necesito hacer una funcion que  mezcle las letras de una palabra... lo tengo y es ...

 
FUNCTION MEZCLAPALABRAS(PALABRA:STRING):STRING;
	VAR
	CONT,A,B,CANPAL:INTEGER;
	aux1,aux2:char;
	AUXILIAR:STRING;{PALABRA REVUELTA...}
BEGIN
	CONT:=0;
	CANPAL:=LENGTh(PALABRA);
	REPEAT
		RANDOMIZE;
		A:=RANDOM(CANPAL);
		B:=RANDOM(CANPAL);
		aux1:=PALABRA[A];
		PALABRA[A]:=PALABRA[B];
		PALABRA[B]:=aux1;
		CONT:=CONT+1;
	UNTIL (CONT=CANPAL);
	MEZCLAPALABRAS:=PALABRA;
END;
 


mi problema es que necesito levantar la palabra que le paso como parametro de un archivo y no se como hacer eso... estoy  pensando en que deberia modificar la funcion porque "seleccionar al azar" tiene que ser de la lista de palabras que estan guardadas en el archivo....


26-Jan-2014 23:33
natalia tavora

aca publico un ejemplo para que tengan mas o menos una idea de lo que quiero hacer... pero a este ejemplo le falta la parte de archivos....

 
PROGRAM JUEGO;
USES CRT;
 
VAR
	I:INTEGER;
	intento,palabra2,palabra:string;
 
FUNCTION MEZCLAPALABRAS(PALABRA:STRING):STRING;
VAR
	CONT,A,B,CANPAL:INTEGER;
	aux1,aux2:char;
	AUXILIAR:STRING;{PALABRA REVUELTA...}
BEGIN
	CONT:=0;
	CANPAL:=LENGTh(PALABRA);
	REPEAT
		RANDOMIZE;
		A:=RANDOM(CANPAL);
		B:=RANDOM(CANPAL);
		aux1:=PALABRA[A];
		PALABRA[A]:=PALABRA[B];
		PALABRA[B]:=aux1;
		CONT:=CONT+1;
	UNTIL (CONT=CANPAL);
 
 
	MEZCLAPALABRAS:=PALABRA;
END;
BEGIN
clrscr;
palabra:='Argentina';
palabra:=upcase(palabra);
PALABRA2:=MEZCLAPALABRAS(PALABRA);
textcolor(yellow);
gotoxy(24,3); writeln('Juego de Palabras');
textcolor(white);
gotoxy(19,5); writeln('Las letras para formar la palabra son:');
gotoxy(25,7); writeln(palabra2);
gotoxy(25,9); writeln('Intento:');
readln(intento);
gotoxy(19,11); writeln('Presione enter despues de escribir la palabra');
if (intento=palabra)then
begin
gotoxy(27,13); writeln('La palabra es: ',palabra);
gotoxy(27,15); writeln('ACERTASTE');
readln;
END;
if (intento<>palabra)then
begin
textcolor(red);
gotoxy(27,15); writeln('Lo siento, la palabra era ',palabra);
end;
readln;
END.
 



26-Jan-2014 23:37
natalia tavora

pense en hacer otra funcion algo asi...

 
function elegir_palabra():string;
	var
		p:integer;
		palabra:string;
	begin
		abrir_archivo();
		p:=filesize(F_palabras);
		randomize;
		random(p);
		seek(f_palabras,p);
		read(f_palabras,palabra);
		elegir_palabra:=palabra;
		close(f_palabras);
	end;
 


para seleccionar aleatoriamente la palabra del archivo pero no se si funcione....


27-Jan-2014 21:14
Nacho Cabanes (+32)

Vamos por partes... estás mezclando cosas muy distintas.

Por una parte tienes la función de desordenar una palabra. ¿Esa ya te funciona bien? Si no es así, existen algoritmos capaces de desordenar un array (o en tu caso un "string") de una forma sencilla, como el de Fisher-Yates, que básicamente recorre el array de principio a final, intercambiando el elemento actual con uno al azar de los restantes:

http://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle

Por otra parte, escoger una palabra al azar desde un fichero no es trivial, porque no tiene sentido hacer "seek" en un fichero de texto, ya que es muy poco probable que todas las palabras tengan la misma longitud. Lo habitual es volcar desde el fichero a un array o una estructura similar, en la que sí puedas escoger elementos al azar de forma sencilla. Otra alternativa es crear un índice del contenido del fichero, para saber dónde está el principio de cada palabra, pero eso resulta mucho más trabajoso y sólo tiene sentido si tienes muy poca memoria disponible (por lo que no puedes volcar todo a un array) y a la vez quieres maximizar la velocidad de acceso a los datos (por lo que no haces una lectura secuencial de todos los datos en fichero).


27-Jan-2014 22:53
natalia tavora

la funcion de mezclar palabras me funciona perfectamente... esta comprobada en el codigo del programa que publico como ejemplo... lo que pasa es que en el ejemplo no usa archivos... solo le paso una palabra...
el problema es que necesito que esa palabra sea levantada de un archivo de texto....
desarrolle el ejemplo del programa que publique en este mismo tema con la parte de archivos pero tiene algunos problemas...
el codigo me quedo de la siguiente manera...

 
PROGRAM JUEGO;
USES CRT,SysUtils;
 
VAR
	I:INTEGER;
	intento,palabra2,palabra:string;
	FPalabras:text;
 
Procedure palabras_basicas();
	Var
		i:Integer;
		palabra:string;
begin
	assign(FPalabras,'C:\palabras.txt');
	rewrite(FPalabras);
	For i:= 0 to 9 do // guardo una palabra por linea
	Begin
		Case (i) of
			0: Palabra:='Rock ';
			1:	Palabra:='programacion';
			2:  Palabra:='calendario';
			3:  Palabra:='colectivo';
			4:  Palabra:='television';
			5:  Palabra:='amnesia';
			6:  Palabra:='Perico';
			7:  Palabra:='rocio';
			8:  Palabra:='Tormenta';
			9:  Palabra:='Alvarado';
		End;
		Writeln(FPalabras,palabra);
		close(FPalabras);
	End;
end;
Procedure elegir_palabra(Var palabra:string);
	var
		p:integer;
begin
	rewrite(FPalabras);
	p:=filesize(FPalabras);// cantidad de lineas del archivo lineas....
	randomize;
	random(p);// selecciono una linea al azar para levantar la palabra
	seek(FPalabras,p);///busco esa linea,..
	read(FPalabras,palabra);// levanto  la palabra del archivo
	writeLn(palabra);
	close(FPalabras);
end;
FUNCTION MEZCLAPALABRAS(PALABRA:STRING):STRING; 
VAR
	CONT,A,B,CANPAL:INTEGER;
	aux1,aux2:char;
	AUXILIAR:STRING;{PALABRA REVUELTA...}
BEGIN
	CONT:=0;
	CANPAL:=LENGTh(PALABRA);
	REPEAT
		RANDOMIZE;
		A:=RANDOM(CANPAL);
		B:=RANDOM(CANPAL);
		aux1:=PALABRA[A];
		PALABRA[A]:=PALABRA[B];
		PALABRA[B]:=aux1;
		CONT:=CONT+1;
	UNTIL (CONT=CANPAL);
 
 
	MEZCLAPALABRAS:=PALABRA;
END;
BEGIN
clrscr;
palabras_basicas();
palabra:=elegir_palabra();
palabra:=upcase(palabra);
PALABRA2:=MEZCLAPALABRAS(PALABRA);
textcolor(yellow);
gotoxy(24,3); writeln('Juego de Palabras');
textcolor(white);
gotoxy(19,5); writeln('Las letras para formar la palabra son:');
gotoxy(25,7); writeln(palabra2);
gotoxy(25,9); writeln('Intento:');
readln(intento);
gotoxy(19,11); writeln('Presione enter despues de escribir la palabra');
if (intento=palabra)then
begin
gotoxy(27,13); writeln('La palabra es: ',palabra);
gotoxy(27,15); writeln('ACERTASTE');
readln;
END;
if (intento<>palabra)then
begin
textcolor(red);
gotoxy(27,15); writeln('Lo siento, la palabra era ',palabra);
end;
readln;
close(FPalabras);
END.
 



28-Jan-2014 00:13
Nacho Cabanes (+32)

Insisto: "seek" se sitúa en una cierta posición, en bytes, así que no sirve para ficheros de texto: en el byte 3 no estará la tercera palabra , sino la tercera letra de todo el fichero. Por tanto, este procedimiento no lee una palabra al azar, sino una palabra que empiece en un cierto byte (normalmente, la primera palabra, a partir de cierta posición):

 
Procedure elegir_palabra(Var palabra:string);
	var
		p:integer;
begin
	rewrite(FPalabras);
	p:=filesize(FPalabras);// cantidad de BYTE del archivo lineas....
	randomize;
	random(p);// selecciono una linea al azar para levantar la palabra
	seek(FPalabras,p);///Incorrecto: busca  UN BYTE
	read(FPalabras,palabra);// Incorrecto: deberías leer con ReadLn
	writeLn(palabra);
	close(FPalabras);
end;
 


Repito lo que te he dicho antes: la solución más simple es volcar todas las palabras desde fichero a un array, y extraer al azar desde ese array.

Por otra parte, tu rutina de generar el fichero es innecesariamente complicada. Harías lo mismo de forma mucho más simple con:

 
Procedure palabras_basicas();
	Var
		i:Integer;
		palabra:string;
begin
	assign(FPalabras,'C:\palabras.txt');
	rewrite(FPalabras);
		Writeln(FPalabras,'Rock ');
		Writeln(FPalabras,'programacion');
		Writeln(FPalabras,'calendario');
		Writeln(FPalabras,'colectivo');
		Writeln(FPalabras,'television');
		Writeln(FPalabras,'amnesia');
		Writeln(FPalabras,'Perico');
		Writeln(FPalabras,'rocio');
		Writeln(FPalabras,'Tormenta');
		Writeln(FPalabras,'Alvarado');
		close(FPalabras);
end;
 


(O puedes crear el fichero con un editor de texto, como el Bloc de notas)


29-Jan-2014 15:20
natalia tavora

bueno, cargue las palabras usando el procedimiento  que usted me sugiere,y levanto las palabras desde un arrglo  el problema  es que ahora cuando presiono la opcion de jugar la pantalla se me queda en negro  unos segundos y me saca....
le paso de nuevo el codigo

 
Program Nt001;
	Uses crt,SysUtils,Dos;
	type 
	vector=array[0..10]of string;
	var
		existe,Op:Integer;
		nombre, password: string;
		Idioma,Op2:Char;
		Fpalabras:text;
		VecPalabras:vector;
Procedure palabras_basicas();
	Var
		i:Integer;
		palabra:string;
begin
	assign(FPalabras,'C:\palabras.txt');
	rewrite(FPalabras);
		Writeln(FPalabras,'Rock ');
		Writeln(FPalabras,'programacion');
		Writeln(FPalabras,'calendario');
		Writeln(FPalabras,'colectivo');
		Writeln(FPalabras,'television');
		Writeln(FPalabras,'amnesia');
		Writeln(FPalabras,'Perico');
		Writeln(FPalabras,'rocio');
		Writeln(FPalabras,'Tormenta');
		Writeln(FPalabras,'Alvarado');
		close(FPalabras);
end;
Procedure ALAzar(var palabra:string; var VecPalabras:vector);/// guardo las palabras del archivo en un vector....
var
Numero,i:integer;
begin
	For i:=0 to 9 do
	Begin
		assign(FPalabras,'C:\palabras.txt');
		reset(FPalabras);
		readln(Fpalabras,palabra);
		VecPalabras[i]:=palabra;
	end;
	Numero:=random(9);
	palabra:=VecPalabras[numero];
	palabra:=upcase(palabra);
end;
FUNCTION MEZCLAPALABRAS(palabra:string):STRING;
	VAR
	p,CONT,A,B,CANPAL:INTEGER;
	aux1,aux2:char;
	AUXILIAR:STRING;{PALABRA REVUELTA...}
BEGIN
	CONT:=0;
	CANPAL:=LENGTh(PALABRA);
	REPEAT
		RANDOMIZE;
		A:=RANDOM(CANPAL);
		B:=RANDOM(CANPAL);
		aux1:=PALABRA[A];
		PALABRA[A]:=PALABRA[B];
		PALABRA[B]:=aux1;
		CONT:=CONT+1;
	UNTIL (CONT=CANPAL);
	MEZCLAPALABRAS:=PALABRA;
	close(Fpalabras);
END;
Procedure Recuadro_principal(color:integer);
	VAR
	I:INTEGER;
	BEGIN
	TEXTCOLOR(COLOR);
	for I :=1 to 80 do
	begin
		gotoxy(I,1);
		write('?');
		gotoxy(I,24);
		write('?');
	end;
	for I :=1 to 24 do
	begin
		 gotoxy(1,I);
		 write('?');
		 gotoxy(80,I);
		 write('?');
	end;
		 gotoxy(80,1);write('?');//?
		 gotoxy(80,24);write('?');//?
		 gotoxy(1,1);write('?');//?
		 gotoxy(1,24);write('?');//?
	 end;
Procedure rules();
Begin
	clrscr;
	Recuadro_principal(white);
	TextColor(Yellow);
	GOTOXY(20,3); WRITELN ('Reglas:');
	TextColor(white);	
	gotoxy(7,5);WRITELN ('Cantidad de jugadores maximo: 2.');
	gotoxy(7,7);WRITELN ('El juego consiste en averiguar una palabra que está desordenada.');
	gotoxy(7,9);WRITELN ('Por cada palabra obtendra un puntaje:');
	gotoxy(7,11);WRITELN ('Si la palabra fue obtenida en el primer intento obtiene 100 puntos.');
	gotoxy(7,13);WRITELN ('Si la palabra fue obtenida en el segundo intento obtiene 75 puntos.');
	gotoxy(7,15);WRITELN ('Si la palabra fue obtenida en el tercer intento obtiene 50 puntos.');
	gotoxy(7,17);WRITELN('Si no acerto en ninguno de los 3 intentos se le descuentan 50 puntos... ');
	textcolor(Yellow);
	gotoxy(15,19);writeln('Presione enter para volver al menu principal...');
	readln();
End;
Procedure creditos ();
Begin
	clrscr;
	Textcolor(Yellow);
	Gotoxy(24,3);writeln('Este programa es presentado por:');
	Textcolor(white);
	Gotoxy(25,7);writeln('Javier Echagüe y Natalia Tavora ');
	Gotoxy(25,9);writeln('Estudiantes del instituto Hilet ');
	Gotoxy(25,11);writeln('1° año De la carrera Analista de Sistemas ');
	Textcolor(11);
	Gotoxy(25,13);writeln('Mar del Plata, Buenos Aires');
	Gotoxy(25,15);writeln('Republica Federal Argentina');
	textcolor(Yellow);
	gotoxy(15,19);writeln('Presione enter para volver al menu principal...');
	readln();
End;
Procedure cambiacolor(op:integer);
	var
		i: integer;
Begin
 
repeat
 
    TextColor(op);
  case (op) of
 
	   1:begin
			TextBackGround(1);
		end;
	   2:begin
			TextBackGround(2);
		end;
	   3: begin
			TextBackGround(3);
		end;
	   4:begin
			TextBackGround(4);
		end;
	   5 :begin
			TextBackGround(5);
		end;
	   6: begin
			TextBackGround(6);
		end;
	End;
  clrscr;
 until ((op>=1) and (op<=8));
end;
Procedure mlista();
	var
	i:integer;
Begin
	clrscr;
	Recuadro_principal(white);
	gotoxy(15,7);writeln('SELECCIONE UN FONDO PREDETERMINADO');
	for i:=1 to 6 do
	begin
		gotoxy(25,8+i);
		textcolor(0+i);
		writeln(0+i,':Fondo');
	end;
	textcolor(white);
	gotoxy(25,20);
	writeln('Su Eleccion es: ');
	gotoxy(42,20);
END;
Procedure pantalla(Palabra2:string);
Begin
textcolor(yellow);
gotoxy(24,3); writeln('Juego de Palabras');
textcolor(white);
gotoxy(19,5); writeln('Las letras para formar la palabra son:');
gotoxy(25,7); writeln(palabra2);
gotoxy(25,9); writeln('Intento:');
gotoxy(19,11); writeln('Presione enter despues de escribir la palabra');
end;
procedure resultado(intento,palabra:string);
Begin
if (intento=palabra)then
begin
gotoxy(27,13); writeln('La palabra es: ',palabra);
gotoxy(27,15); writeln('ACERTASTE');
readln;
END;
if (intento<>palabra)then
begin
textcolor(red);
gotoxy(27,15); writeln('Lo siento, la palabra era ',palabra);
end;
ENd;
procedure OpcionJugar();
var
intento,palabra,palabra2:string;
Begin
ALAzar(palabra,VecPalabras);
PALABRA2:=MEZCLAPALABRAS(PALABRA);
pantalla(Palabra2);
readln(intento);
resultado(intento,palabra);
readln;
End;
Procedure Mostrar_Menu_Principal();
	Begin
		clrscr;
		Recuadro_principal(white);
		gotoxy(16,3);writeln('Seleccione una opcion Segun corresponda');
		gotoxy(25,5);writeln('0: Salir');
		gotoxy(25,7);writeln('1: Opciones');
		gotoxy(25,9);writeln('2: Ver las reglas del Juego');
		gotoxy(25,11);writeln('3: Jugar');
		gotoxy(25,13);writeln('4: Ver Creditos');
		gotoxy(25,15);writeln('Su Eleccion es: ');
		gotoxy(42,15);
	End;
Procedure Mostrar_Menu_Opciones();
	Begin
		clrscr;
		Recuadro_principal(white);
		gotoxy(16,3);writeln('Seleccione una opcion Segun corresponda');
		gotoxy(25,5);writeln('1: Cambiar fondo');
		gotoxy(25,11);writeln('2: Volver al menu principal');
		gotoxy(25,13);writeln('Su Eleccion es: ');
		gotoxy(42,13);
	End;
 
Procedure func_menuopciones(var op:integer);
Begin
	Case op of
 
	1:	Begin
			repeat
				mlista();
				readln(op);
				cambiacolor(op);
			until ((op>=1) or (op<=6));
		end;
	2:	Begin
			clrscr;
			Mostrar_Menu_Principal();
 
		end;
 
	end;
end;
Procedure func_menuprincipal(var op:integer);
	Begin
		case op of
		0: Begin
				clrscr;
				gotoxy(15,13);
				writeln('Saliendo del sistema...');
				delay(600);
			End;
		1: begin
				Mostrar_Menu_Opciones();
				readln(op);
				func_menuopciones(op);
			end;
		2: begin
				rules();
			end;
		3: begin
				clrscr;
				OpcionJugar();
			end;
		4: begin
				creditos ();
			end;
	end;
End;
BEGIN
clrscr;
//presentacion ();//
repeat
	repeat
		Mostrar_Menu_Principal();
		readln(op);
		func_menuprincipal(op);
	until (op>=0) or (op<=4);
until(op=0);	
END.
 


30-Jan-2014 16:28
Nacho Cabanes (+32)

El programa empieza a ser largo como para poder analizar todo y encontrar los fallos "por intuición", así que tendrás que ser escrupulosa y ordenada para analizar qué está comportándose de forma errónea.

Por lo que dices, el fallo debería estar en la opción de jugar:

 
procedure OpcionJugar();
var
intento,palabra,palabra2:string;
Begin
ALAzar(palabra,VecPalabras);
PALABRA2:=MEZCLAPALABRAS(PALABRA);
pantalla(Palabra2);
readln(intento);
resultado(intento,palabra);
readln;
End;
 


La forma más razonable de encontrar el fallo sería, si tu entorno de desarrollo lo permite, poner un punto de interrupción en la primera de esas líneas de código ("ALAzar(palabra,VecPalabras);") y avanzar de ahí paso a paso, de modo que puedas ver qué línea provoca el fallo y qué valores tienen las variables locales en ese momento.

Si tu editor no permite depurar paso a paso, puedes incluir líneas "WriteLn" que te ayuden a ver por dónde avanza tu programa:

 
procedure OpcionJugar();
var
    intento,palabra,palabra2:string;
Begin
    WriteLn('Entrando a Jugar');
    ALAzar(palabra,VecPalabras);
    WriteLn('Vamos a mezclar');
    PALABRA2:=MEZCLAPALABRAS(PALABRA);
    WriteLn('Ya mezclado');
    pantalla(Palabra2);
    readln(intento);
    resultado(intento,palabra);
    readln;
End;
 


Aun así, en un vistazo rápido, he visto algo muy raro aquí:

 
Procedure cambiacolor(op:integer);
	var
		i: integer;
Begin
 
repeat
 
    TextColor(op);
  case (op) of
 
	   1:begin
			TextBackGround(1);
		end;
	   2:begin
			TextBackGround(2);
		end;
	   3: begin
			TextBackGround(3);
		end;
	   4:begin
			TextBackGround(4);
		end;
	   5 :begin
			TextBackGround(5);
		end;
	   6: begin
			TextBackGround(6);
		end;
	End;
  clrscr;
 until ((op>=1) and (op<=8));
end;
 


No entiendo esa función. En primer lugar, porque se puede repetir indefinidamente (y dejar "bloqueado" el programa) si le pasas un dato incorrecto. Y en segundo lugar, porque si el color es (por ejemplo) el 5, pones ese colo tanto para el fondo como para el primer plano, de modo que no se verá lo que escribas a partir de entonces.






(No se puede continuar esta discusión porque tiene más de dos meses de antigüedad. Si tienes dudas parecidas, abre un nuevo hilo.)