| 1 | PROGRAM BIORHYTHMUS(INPUT,OUTPUT); |
| 2 | |
| 3 | CONST AMP=30; |
| 4 | ZWEIPI=6.283185308; |
| 5 | |
| 6 | TYPE DATUM=RECORD TAG,MONAT,JAHR: INTEGER END; |
| 7 | |
| 8 | VAR GEB,VON,BIS,HEUTE: DATUM; |
| 9 | ALTER,LIMIT: INTEGER; |
| 10 | ZEILE: ARRAY[-AMP..+AMP] OF CHAR; |
| 11 | |
| 12 | |
| 13 | PROCEDURE LIESDATUM(VAR X: DATUM); |
| 14 | (* EINGABEFORMAT: JJ-MM-TT *) |
| 15 | VAR C: CHAR; |
| 16 | BEGIN |
| 17 | READ(X.JAHR,C,X.MONAT,C,X.TAG) |
| 18 | END (* LIESDATUM *); |
| 19 | |
| 20 | |
| 21 | PROCEDURE DRUCKEDATUM(X: DATUM); |
| 22 | |
| 23 | PROCEDURE WRITE00(N: INTEGER); |
| 24 | BEGIN WRITE(N DIV 10 :1, N MOD 10 :1) END; |
| 25 | |
| 26 | BEGIN |
| 27 | WRITE00(X.JAHR); WRITE("-"); |
| 28 | WRITE00(X.MONAT);WRITE("-"); |
| 29 | WRITE00(X.TAG) |
| 30 | END (* DRUCKEDATUM *); |
| 31 | |
| 32 | |
| 33 | FUNCTION TAGESANZAHL(X: DATUM): INTEGER; |
| 34 | VAR F,G: INTEGER; |
| 35 | BEGIN |
| 36 | IF X.MONAT>2 |
| 37 | THEN BEGIN G:=1900 + X.JAHR; F:=X.MONAT + 1 END |
| 38 | ELSE BEGIN G:=1900 + X.JAHR - 1; F:=X.MONAT + 13 END; |
| 39 | TAGESANZAHL:=TRUNC(365.25*G) + TRUNC(30.6*F) + X.TAG - 621049 |
| 40 | END (* TAGESANZAHL *); |
| 41 | |
| 42 | |
| 43 | PROCEDURE NAECHSTERTAG(VAR X: DATUM); |
| 44 | |
| 45 | FUNCTION MONATSTAGE(X: DATUM): INTEGER; |
| 46 | BEGIN |
| 47 | CASE X.MONAT OF |
| 48 | 1,3,5,7,8,10,12: MONATSTAGE:=31; |
| 49 | 4,6,9,11: MONATSTAGE:=30; |
| 50 | 2: IF X.JAHR MOD 4 = 0 THEN MONATSTAGE:=29 |
| 51 | ELSE MONATSTAGE:=28 |
| 52 | END |
| 53 | END (* MONATSTAGE *); |
| 54 | |
| 55 | BEGIN |
| 56 | X.TAG := X.TAG + 1; |
| 57 | IF X.TAG>MONATSTAGE(X) |
| 58 | THEN BEGIN X.MONAT := X.MONAT + 1; |
| 59 | X.TAG := 1; |
| 60 | IF X.MONAT>12 |
| 61 | THEN BEGIN X.JAHR := X.JAHR +1; |
| 62 | X.MONAT := 1 |
| 63 | END |
| 64 | END |
| 65 | END (* NAECHSTERTAG *); |
| 66 | |
| 67 | |
| 68 | PROCEDURE LOESCHEZEILE; |
| 69 | VAR I: INTEGER; |
| 70 | BEGIN |
| 71 | FOR I := -AMP TO AMP DO ZEILE[I] := " " |
| 72 | END (* LOESCHEZEILE *); |
| 73 | |
| 74 | |
| 75 | PROCEDURE DRUCKEZEILE; |
| 76 | VAR I: INTEGER; |
| 77 | BEGIN |
| 78 | WRITE("-" :4); |
| 79 | FOR I := -AMP TO AMP DO WRITE( ZEILE[I] ); |
| 80 | WRITELN("-") |
| 81 | END (* DRUCKEZEILE *); |
| 82 | |
| 83 | |
| 84 | PROCEDURE KOPFLEISTE; |
| 85 | VAR I: INTEGER; |
| 86 | BEGIN |
| 87 | WRITELN; WRITELN; |
| 88 | WRITELN("JJ-MM-TT -1", "0":AMP, "1":AMP); |
| 89 | WRITE("^":13); |
| 90 | FOR I:=1 TO AMP-1 DO WRITE("."); |
| 91 | WRITE("^"); |
| 92 | FOR I:=1 TO AMP-1 DO WRITE("."); |
| 93 | WRITELN("^") |
| 94 | END (* KOPFLEISTE *); |
| 95 | |
| 96 | |
| 97 | |
| 98 | |
| 99 | BEGIN (* H A U P T P R O G R A M M *) |
| 100 | |
| 101 | WRITE("GEBURTSDATUM"); LIESDATUM(GEB); |
| 102 | WRITE("BIORHYTHMEN VON"); LIESDATUM(VON); |
| 103 | WRITE(" BIS"); LIESDATUM(BIS); |
| 104 | HEUTE := VON; |
| 105 | ALTER := TAGESANZAHL(HEUTE) - TAGESANZAHL(GEB); |
| 106 | LIMIT := TAGESANZAHL( BIS ) - TAGESANZAHL(GEB); |
| 107 | KOPFLEISTE; |
| 108 | REPEAT |
| 109 | LOESCHEZEILE; |
| 110 | ZEILE[ ROUND(AMP*SIN(ALTER*ZWEIPI/23)) ] := "P"; |
| 111 | ZEILE[ ROUND(AMP*SIN(ALTER*ZWEIPI/28)) ] := "S"; |
| 112 | ZEILE[ ROUND(AMP*SIN(ALTER*ZWEIPI/33)) ] := "I"; |
| 113 | DRUCKEDATUM(HEUTE); |
| 114 | DRUCKEZEILE; |
| 115 | NAECHSTERTAG(HEUTE); |
| 116 | ALTER := ALTER + 1 |
| 117 | UNTIL ALTER>LIMIT |
| 118 | END. |