[ Foro de Pascal ]
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....
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.
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....
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).
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.
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)
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.
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.)