DataMuseum.dk

top - download

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »KANNIBAL.PAS«

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─ ⟦this⟧ »KANNIBAL.PAS« 
└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »KANNIBAL.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »KANNIBAL.PAS« 

TextFile

        PROGRAM kannibal;
        
          TYPE
            pointer = ^ mand;
            mand = RECORD
                     naeste : pointer;
                     nr : INTEGER;
                   END;
          
          VAR
            top : pointer;
            antal, frem : INTEGER;
          
          FUNCTION ja : BOOLEAN;
          
            VAR
              ch : CHAR;
            
            BEGIN (* ja *)
              REPEAT
                READ(KBD, ch);
              UNTIL ch IN (.'J', 'j', 'N', 'n'.);
              CASE ch OF
                'J', 'j' : ja := TRUE;
                'N', 'n' : ja := FALSE;
              END;
            END; (* ja *)
          
          FUNCTION faerdig : BOOLEAN;
          
            BEGIN (* faerdig *)
              WRITELN;
              WRITE('Ønsker du et nyt gilde (j/n): ');
              faerdig := NOT ja;
            END; (* faerdig *)
          
          PROCEDURE opretning;
          
            FUNCTION naesteperson(i : INTEGER) : pointer;
            
              VAR
                p : pointer;
              
              BEGIN (* naesteperson *)
                IF i <= antal
                  THEN
                    BEGIN
                      NEW(p);
                      naesteperson := p;
                      p^.nr := i;
                      p^.naeste := naesteperson(i + 1);
                    END
                  ELSE
                    naesteperson := top; (* ringen sluttes *)
              END; (* naesteperson *)
            
            BEGIN (* opretning *)
              NEW(top);
              top^.nr := 1;
              top^.naeste := naesteperson(2);
            END; (* opretning *)
          
          PROCEDURE initialiser;
          
            BEGIN (* initialiser *)
              WRITE(CLRHOM);
              WRITELN('VELKOMMEN TIL KANNIBALGILDE');
              WRITELN;
              WRITELN('Et skib forliser, og nogle af sømændene redder  ');
              WRITELN('sig mirakuløst i land. Men desværre tages de til');
              WRITELN('fange af nogle kannibaler. Disse stiller sømæn- ');
              WRITELN('dene op i ring og gør klar til gilde.           ');
              WRITELN('For at finde ud af hvem der skal spises, tæller ');
              WRITELN('de hele tiden et bestemt antal frem.            ');
              WRITELN('Du skal nu bestemme, hvor mange sømænd, der red-');
              WRITELN('der sig i land, og hvor meget kannibalerne skal ');
              WRITELN('tælle frem:                                     ');
              WRITELN;
              WRITE('Hvor mange sømænd: ');
              REPEAT
                READLN(antal);
              UNTIL antal >= 1;
              WRITE('Hvor meget skal der tælles frem: ');
                REPEAT
                  READLN(frem);
                UNTIL frem >=1;
              opretning;
            END; (* initialiser *)
          
          PROCEDURE spis;
          
            VAR
              i, j : INTEGER;
              p : pointer;
            
            PROCEDURE udmed(k, l: INTEGER);
            
              BEGIN (* udmed *)
                WRITELN('Nummer', k : 3, ' blev spist i ', l : 3,
                        '. omgang');
              END; (* udmed *)
              
            BEGIN (* spis *)
              IF frem >= 2
                THEN
                  BEGIN
                    FOR i := 1 TO antal - 1 DO
                      BEGIN
                        FOR j := 1 TO frem - 2 DO
                          top := top^.naeste;
                        udmed(top^.naeste^.nr, i);
                        p := top^.naeste^.naeste;
                        top^.naeste := p;
                        top := p;
                      END;
                    udmed(top^.nr, antal);
                  END
                ELSE 
                  BEGIN
                    FOR i := 1 TO antal DO
                      BEGIN
                        udmed(top^.nr, i);
                        top := top^.naeste;
                      END;
                  END;
            END; (* spis *)
          
          BEGIN (* kannibal *)
            REPEAT
              initialiser;
              spis;
            UNTIL faerdig;
            WRITELN;
          END. (* kannibal *)
«eof»