Directory of image this file is from
This file as a plain text file

PROGRAM STAMMBAUM(INPUT,OUTPUT);
CONST N=10;
TYPE INHALT=ARRAY[1..7]OF CHAR;
VAR LISTE:ARRAY[1..N] OF INHALT;
    WAHL:CHAR; I:INTEGER; WORT:CHAR; STOP:BOOLEAN;
    NAME1,NAME2:INHALT; LISTENLAENGE:INTEGER;
PROCEDURE DIREKTVERWANDT;
VAR   NUMMER1, NUMMER2, GROESSER, KLEINER:INTEGER;
    ENDE:BOOLEAN;
FUNCTION NAMENSUCHE(VAR A:INHALT):INTEGER;
VAR I,J:INTEGER; ABBRUCH, GLEICH:BOOLEAN;
BEGIN
J:=0; ABBRUCH:=FALSE; GLEICH:=TRUE;
REPEAT
J:=J+1;
FOR I:=1 TO 7 DO BEGIN
IF (LISTE[J,I]<>A[I]) THEN GLEICH:=FALSE END;
IF GLEICH THEN BEGIN NAMENSUCHE:=J; ABBRUCH:=TRUE END;
UNTIL ABBRUCH OR (J=N);
IF  ABBRUCH=FALSE THEN BEGIN WRITELN; WRITE("DIE PERSON");
FOR I:=1 TO 7 DO WRITE(A[I]); WRITE("KOMMT IM STAMMBAUM NICHT VOR.")  END END;
BEGIN(*HAUPTPROCEDURE*);
WRITELN; WRITE("GEBEN SIE DIE 2 NAMEN EIN(REST MIT ' ' AUFFUELLEN!)");
READLN; FOR I:=1 TO 7 DO READ(NAME1[I]);
READLN; FOR I:=1 TO 7 DO READ(NAME2[I]);
NUMMER1:=NAMENSUCHE(NAME1); NUMMER2:=NAMENSUCHE(NAME2);
IF NUMMER1>NUMMER2 THEN BEGIN GROESSER:=NUMMER1; KLEINER:=NUMMER2 END
ELSE BEGIN GROESSER:=NUMMER2; KLEINER:=NUMMER1 END;
ENDE:=FALSE; I:=0;
REPEAT
I:=I+1; GROESSER:=GROESSER DIV 2;
IF (GROESSER=KLEINER) THEN BEGIN WRITELN; WRITE("DIE PERSONEN SIND DIREKT IM",
I,". TEN GRAD VERWANDT.");
ENDE:=TRUE END;
UNTIL ENDE OR (GROESSER<KLEINER);
IF (ENDE=FALSE) THEN BEGIN WRITELN; WRITE("DIE PERSONEN SIND NICHT DIREKT VERWANDT.")
END END; (*OF DIREKTVERWANDT*)
PROCEDURE EINLESEN;
VAR INDEX,I,J:INTEGER; BEENDE:BOOLEAN;
BEGIN 
WRITELN("GEBEN SIE BITTE DIE NAMEN DER FAMILIE,");
WRITELN("DIE IN EINEN STAMMBAUM EINGELESEN WERDEN SOLL EIN.");
INDEX:=0; BEENDE:=FALSE;
REPEAT READLN; INDEX:=INDEX+1;
       I:=0;REPEAT I:=I+1;
       READ (LISTE[INDEX,I]);
       UNTIL EOLN;
       FOR J:=I+1 TO 7
       DO LISTE[INDEX,J]:=" ";
IF (LISTE[INDEX,1]="*") THEN BEENDE:=TRUE;
UNTIL BEENDE OR (INDEX=N);
LISTENLAENGE:=INDEX
END;
PROCEDURE VORSCHUB (N:INTEGER);
VAR I,J:INTEGER;
BEGIN FOR I:=1 TO N
      DO WRITELN
END; (*OF VORSCHUB*)
PROCEDURE BAUMAUSGEBEN;
VAR PLATZ,INDEX,I,J,POTENZ,EBENE,HILFE:INTEGER;NAME:INHALT;
FUNCTION GLEICH (A ,B:INHALT):BOOLEAN;
VAR I:INTEGER;
BEGIN GLEICH :=TRUE;
FOR I:=1 TO 7
DO IF A[I]<>B[I]
   THEN GLEICH:=FALSE
END;
BEGIN
WRITELN;WRITE ("VON WELCHER PERSON SOLL DER STAMMBAUM AUSGEDRUCKT WERDEN?");
READLN;FOR I:=1 TO 7 DO READ (NAME[I]);INDEX:=0;PLATZ:=0;
REPEAT INDEX:=INDEX+1;
IF GLEICH(LISTE[INDEX],NAME)
       THEN PLATZ:=INDEX;
UNTIL (INDEX=PLATZ) OR (INDEX>LISTENLAENGE);
IF INDEX >LISTENLAENGE
THEN BEGIN 
      WRITELN;
      WRITE("DIE GENANNTE PERSON IST NICHT IM STAMMBAUM ENTHALTEN!") END
ELSE BEGIN
     FOR I:=1 TO 7
     DO WRITE (LISTE[PLATZ,I]);
     VORSCHUB(3);
     EBENE:=0 ;
     POTENZ:=1 ;
     I:=1 ;
     WHILE (PLATZ+I-1)<>LISTENLAENGE
     DO BEGIN PLATZ:=PLATZ*2;
              POTENZ:=POTENZ*2;
              EBENE:=EBENE+1;
              WRITELN;WRITE(EBENE,".VERWANDTSCHAFTSGRAD"); HILFE:=PLATZ+I-1;
              FOR I:=1 TO POTENZ
              DO FOR J:=1 TO 7
                 DO WRITE (LISTE[HILFE,J]);
             VORSCHUB(3)
        END
     END
END;(*OF BAUMAUSGEBEN*)
PROCEDURE SUNAME;
VAR I,ZAEHLER,NUMMER:INTEGER; VERWANDT:INHALT;
BEGIN I:=0;
WRITELN("ICH SOLL ALSO FUER SIE JEMANDEN SUCHEN, DER ZU DER");
WRITELN("BEZUGSPERSON EINE VON IHNEN BESTIMMTE VERWANDTSCHAFTS-");
WRITELN("BEZIEHUNG HAT. DAFUER BENOETIGE ICH VON IHNEN DIE");
WRITELN("EINGABE DER VERWANDTSCHAFTSBEZIEHUNG!");
WRITELN("DIE EINGABE SOLL WIE FOLGT AUSSEHEN:");
WRITELN("FUER VATER WIRD EIN V EINGELESEN, FUER MUTTER EIN");
WRITELN("M.BEISPIEL: GESUCHT WIRD DER VATER DES VATERS DER MUTTER");
WRITELN("DER BEZUGSPERSON. EINGABE: VVM !");
WRITELN("MEHR IST NICHT ZU TUN! BITTE GEBEN SIE NUN DIE");
WRITELN("VERWANDTSCHAFTSBEZIEHUNG EIN!!!!!!!!!!!!!!!!");
REPEAT I:=I+1;
READLN; READ(VERWANDT[I]);
ZAEHLER:=I
UNTIL (I=7) OR EOLN;
NUMMER:=1;
FOR I:=ZAEHLER DOWNTO 1
DO IF VERWANDT[I]="V"
   THEN NUMMER:=NUMMER*2
   ELSE NUMMER:=NUMMER*2+1;
WRITELN; FOR I:=1 TO 7 DO WRITE(LISTE[NUMMER,I])
END;
PROCEDURE VERWANDTER;
 VAR   I,L,STELLE1,STELLE2:INTEGER;
FUNCTION INDEX:INTEGER;
VAR NAME:INHALT;
    I,L :INTEGER;
    GLEICH:BOOLEAN;
BEGIN
    FOR I:=1 TO 7 DO
      READ(NAME[I]);
    I:=0;
    REPEAT
      I:=I+1;
      GLEICH:=TRUE;
      FOR L:= 1 TO 7 DO
        IF ( NAME[L]<>LISTE[I,L]) THEN 
        BEGIN  GLEICH:=FALSE;
               L:=7
        END;
    UNTIL GLEICH OR(I> N);
    IF (I> N) THEN
    BEGIN WRITE("NAME IST NICHT IN DER LISTE EINGETRAGEN!");
          INDEX:=0
    END
    ELSE INDEX:=I
END;
PROCEDURE VERWANDSCHAFTSBEZIEHUNG;
VAR STELLE1,STELLE2,L :INTEGER;
BEGIN
WRITE("BEZIEHUNGSPERSON ?");
STELLE1:=INDEX;
IF STELLE1<>0 THEN BEGIN
    WRITE (" VERWANDTER ?");
    STELLE2:=INDEX
    END;
IF STELLE2<>0 THEN BEGIN
    REPEAT
      L:=STELLE2 MOD 2;
      IF L=1 THEN WRITE("M")
             ELSE WRITE("V");
      STELLE2:=STELLE2 DIV 2;
    UNTIL STELLE2< STELLE1
    END
END;
BEGIN
VERWANDSCHAFTSBEZIEHUNG;
END;
BEGIN(*HAUPTPROGRAMM*);
STOP:=FALSE;
REPEAT
WRITELN; WRITE("SIE KOENNEN ZWISCHEN FOLGENDEN ALGORITHMEN WAEHLEN:");
WRITELN;
WRITE("A:EINLESEN EINES STAMMBAUMS");
WRITELN;
WRITE("B: AUSGABE EINES (TEIL-) STAMMBAUMS");
WRITELN;
 WRITE("C : UNTERSUCHUNG AUF DIREKTE VERWANDTSCHAFT UND VERWANDTSCHAFTSGRAD");
WRITELN;
 WRITE("D : SUCHE EINER PERSON BEI VORGEGEBENER VERWANDTSCHAFTSBEZIEHUNG");
WRITELN;
 WRITE("E : AUSGABE DER VERWANDTSCHAFTSBEZIEHUNG BEI VORGEGEBENEN NAMEN");
WRITELN; WRITE("BITTE GEBEN SIE DEN KENNBUCHSTABEN DES ALGORITHMUS EIN.");
READLN; READ(WAHL);
CASE WAHL OF
"A":EINLESEN;
"B":BAUMAUSGEBEN;
"C":DIREKTVERWANDT;
"D":SUNAME;
"E":VERWANDTER
END;
WRITELN;WRITE("WUENSCHEN SIE WEITEREN DURCHLAUF?");
WRITELN;WRITE("ANTWORTEN SIE BITTE MIT 'J' ODER 'N'.");
READLN; READ(WORT);
IF (WORT="N") THEN STOP:=TRUE;
UNTIL STOP END.