Comparte este artículo en tus redes sociales favoritas

Raúl Izquierdo, en su página web, ha puesto a disposición de los visitantes
las soluciones de las 2 prácticas: práctica 1 (rombo) y práctica 2 (calendario)

Práctica 1

(*******************************************
*NOMBRE: #Nombre#
*PRIMER APELLIDO: #Apellido#
*SEGUNDO APELLIDO: ##
*DNI: ##
********************************************)
MODULE ROMBO;
FROM InOut IMPORT ReadInt, WriteLn, WriteString;
VAR fila, lado, arroba, caracter, contador, espacios :INTEGER;

BEGIN
WriteString( "Introduzca lado del rombo (entre 1 y 20) : " );
ReadInt(lado);
WriteLn;
IF (lado>0) AND (lado<21)> 0 THEN (* si caracter es impar *)
IF arroba = 1 THEN (* si toca escribir @ *)
WriteString( "@" ); arroba := 0
ELSE (* toca escribir o *)
WriteString( "o" ); arroba := 1
END;
ELSE (* caracter es par escribir . *)
WriteString( "." );
END; (*fin bucle mitad superior izquierda *)
contador:=contador+1; caracter:=caracter+1
END;
contador:=1;
IF (fila MOD 2)=0 THEN (* si la fila es par invertir arroba*)
IF arroba = 1 THEN arroba :=0;
ELSE
arroba := 1;
END;
END;
WHILE contador <= fila-1 DO (*bucle mitad superior derecha *) IF (caracter MOD 2 ) <> 0 THEN (* si caracter es impar *)
IF arroba = 1 THEN (* toca escribir @ *)
WriteString( "@" ); arroba := 0
ELSE (* toca escribir o *)
WriteString( "o" ); arroba := 1
END;
ELSE (* caracter es par escribir . *)
WriteString( "." );
END; (* fin bucle mitad superior derecha *)
contador:=contador+1; caracter:=caracter+1
END;
WriteLn;
END; (* fin bucle para la mitad superior *)
FOR fila := lado-1 TO 1 BY -1 DO (*bucle mitad inferior *)
FOR espacios := 1 TO (lado-fila) DO (* *)
WriteString( " " ); (*escribe espacios en blanco*)
END; (* *)
contador :=1 ; caracter := 1; arroba := 1;
WHILE contador <= fila DO (* bucle mitad superior izquierda *) IF (caracter MOD 2 ) <> 0 THEN (* si caracter es impar *)
IF arroba = 1 THEN (* si toca escribir @ *)
WriteString( "@" ); arroba := 0
ELSE (* toca escribir o *)
WriteString( "o" ); arroba := 1
END;
ELSE (* caracter es par escribir . *)
WriteString( "." );
END; (* fin bucle mitad inferior izquierda *)
contador:=contador+1; caracter:=caracter+1
END;
contador:=1;
IF (fila MOD 2)=0 THEN (* si la fila es par invertir arroba*)
IF arroba = 1 THEN arroba :=0;
ELSE
arroba := 1;
END;
END;
WHILE contador <= fila-1 DO (* bucle mitad inferior derecha *) IF (caracter MOD 2 ) <> 0 THEN (* si caracter es impar *)
IF arroba = 1 THEN (* toca escribir @ *)
WriteString( "@" ); arroba := 0
ELSE (* toca escribir o *)
WriteString( "o" ); arroba := 1
END;
ELSE (* caracter es par escribir . *)
WriteString( "." );
END; (* fin bucle mitad inferior derecha *)
contador:=contador+1; caracter:=caracter+1
END;
WriteLn;
END; (* fin bucle para la mitad inferior *)
END;
END ROMBO.

(******************* FUNCION DiaSemana ************************)
PROCEDURE DiaSemana (v2,v3:INTEGER):INTEGER;
(*FUNCION DiaSemana: Argumentos por valor : mes, anno
devuelve un numero entero que representa el dia de la semana
del dia 1 del mes/anno 1=lunes .. 7=domingo
ALGORITMO SACADO DE http://www.cnice.mecd.es/eos/MaterialesEducativos/mem
2000/astronomia/scripts/calendario/cal_dia_semana.htm*)
VAR v2x, v4, v5, v6, v7, v8, v9, v10 :INTEGER;
BEGIN
v2x:=v2;
IF v2=1 THEN v2x:=13; v3:=v3-1; END;
IF v2=2 THEN v2x:=14; v3:=v3-1; END;
v4:= (v2x+1)*3 DIV 5;
v5:= v3 DIV 4;
v6:= v3 DIV 100;
v7:= v3 DIV 400;
v8:= 1+(v2x*2)+v3+v4+v5-v6+v7+2; (* dia 1=>v1=1)*)
v9:= v8 DIV 7;
v10:= v8-(v9*7);
v10:= v10+6;
IF v10 > 7 THEN v10:=v10-7; END;
RETURN v10
END DiaSemana;
(******************* FUNCION EsBisiesto ************************)
PROCEDURE EsBisiesto (x1:INTEGER):BOOLEAN;
(*FUNCION EsBisiesto: Argumentos por valor : anno
devuelve TRUE si anno es bisiesto *)
BEGIN
IF (x1 MOD 4) = 0 THEN
IF ((x1 MOD 100) = 0) AND ((x1 MOD 400) <> 0) THEN
RETURN FALSE;
ELSE
RETURN TRUE
END;
ELSE
RETURN FALSE
END
END EsBisiesto;
(******************* FUNCION DiasMes ************************)
PROCEDURE DiasMes (y1:INTEGER):INTEGER;
(*FUNCION DiasMes: Argumentos por valor : mes
devuelve el numero de dias de un mes sin tener en cuenta si es bisiesto
31,28,31,30,31,30,31 ... *)
BEGIN
CASE y1 OF
4,6,9,11 : RETURN 30 |
2 : RETURN 28 |
ELSE RETURN 31;
END;
END DiasMes;
(******************* PROCEDIMIENTO EscribeCalendario ********************)
PROCEDURE EscribeCalendario (m,a,ds,dm: INTEGER);
(*PROCEDIMIENTO EscribeCalendario: Argumentos por valor: mes, año,
diadelasemana,diasdelmes *)
VAR columna,k:INTEGER;
BEGIN
CASE m OF
1: WriteString("ENERO ") |
2: WriteString("FEBRERO ") |
3: WriteString("MARZO ") |
4: WriteString("ABRIL ") |
5: WriteString("MAYO ") |
6: WriteString("JUNIO ") |
7: WriteString("JULIO ") |
8: WriteString("AGOSTO ") |
9: WriteString("SEPTIEMBRE") |
10: WriteString("OCTUBRE ") |
11: WriteString("NOVIEMBRE ") |
12: WriteString("DICIEMBRE ") |
END;
WriteInt(a,17);WriteLn;
WriteString("===========================");WriteLn;
WriteString("LU MA MI JU VI | SA DO");WriteLn;
WriteString("===========================");WriteLn;
columna:=1;
(*escribe espacios antes del dia 1*)
WHILE columna < ds DO
IF columna = 5 THEN
WriteString(" . | ")
ELSE
WriteString(" . ")
END;
INC(columna);
END;
(*escribe dias del mes*)
FOR k := 1 TO dm DO
WriteInt(k,2);
CASE columna OF
5: WriteString(" | ") |
7: IF k < dm THEN WriteLn END |
ELSE WriteString(" ")
END;
INC(columna);
IF columna > 7 THEN columna:=1 END;
END;
(*escribe espacios despues del dia 31*)
IF columna > 1 THEN
WHILE columna<8 DO
CASE columna OF
2,3,4,6: WriteString(" . ") |
5: WriteString(" . | ") |
7: WriteString(" .")
END;
INC(columna);
END;
WriteLn;
ELSE
WriteLn;
END;
END EscribeCalendario;
(******************* PROGRAMA PRINCIPAL ************************)
BEGIN
WriteString( "Introduzca mes (1..12): " );
ReadInt(mes); WriteLn;
IF ((mes>0) AND (mes<13)) THEN
WriteString( "Introduzca año (1601..3000): " );
ReadInt(anno); WriteLn;WriteLn;
IF ((anno>1600) AND (anno<3001)) THEN
diaComienzoMes:=DiaSemana(mes,anno);
TotalDiasMes:=DiasMes(mes);
IF mes=2 THEN
IF EsBisiesto(anno) THEN
TotalDiasMes:=TotalDiasMes+1;
END;
END;
EscribeCalendario(mes,anno,diaComienzoMes,TotalDiasMes);
END;
END;
END Calendario.