DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »POSTKOPI.PAS«

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─⟦this⟧ »POSTKOPI.PAS« 

TextFile

        PROGRAM postkopi;
        
          TYPE
            str40 = STRING(.40.);
            link = ^ post;
            post = RECORD
                     naeste : link;
                     navn : str40;
                     adresse : str40;
                   END;
          
          VAR
            ud, top, topkopi, pp : link;
            ch : CHAR;
            
          PROCEDURE return;
          
            VAR
              ch : CHAR;
            
            BEGIN (* return *)
              WRITE('Tast <RETURN>: ');
              REPEAT
                READ(KBD, ch);
              UNTIL ch = CHR(13);
              WRITELN;
            END; (* return *)
          
          FUNCTION postantal(foerste : link) : INTEGER;
          
            VAR
             taeller : INTEGER;
           
           BEGIN (* postantal *)
             IF foerste = NIL
               THEN postantal := 0
               ELSE
                 BEGIN
                   taeller := 1;
                   WHILE foerste^.naeste <> NIL DO
                     BEGIN
                       taeller := taeller + 1;
                       foerste := foerste^.naeste;
                     END;
                   postantal := taeller;
                 END;
           END; (* postantal *)
          
          PROCEDURE indsaet(VAR foerste : link; nypost : link);
            
            BEGIN (* indsaet *)
              IF foerste = NIL (* kæden er tom *)
                THEN foerste := nypost
              ELSE IF nypost^.navn < foerste^.navn (* før første post *)
                THEN
                  BEGIN
                    nypost^.naeste :=foerste;
                    foerste :=nypost;
                    WRITELN;
                    WRITE(nypost^.navn, ' er nu indsat i kæden. ');
                    return;
                  END
              ELSE (* find rigtig plads til nypost via rekursivt kald *)
                indsaet(foerste^.naeste, nypost);
            END; (* indsaet *)
          
          PROCEDURE fjern(VAR foerste : link; glpost : link);
              
            BEGIN (* fjern *)
              IF foerste = NIL (* kæden tom *)
                THEN
                  WRITELN(glpost^.navn, ' findes ikke i kæden')
              ELSE IF foerste^.navn = glpost^.navn (* fjern post 1 *)
                THEN
                  BEGIN
                    foerste := foerste^.naeste;
                    WRITE(glpost^.navn, ' er slettet fra kæden. ');
                    return;
                  END
              ELSE (* Søg efter navnet via rekursivt kald *)
                fjern(foerste^.naeste, glpost);
            END; (* fjern *)
          
          PROCEDURE udskriv(foerste : link);
          
            VAR
              pp : link;
              
            BEGIN (* udskriv *)
              pp := foerste;
              WRITELN;
              WRITELN('Kæden indeholder følgende personer:');
              WRITELN;
              WHILE pp <> NIL DO
                BEGIN
                  WRITELN(pp^.navn);
                  WRITELN(pp^.adresse);
                  WRITELN;
                  pp := pp^.naeste;
                END;
              return;
            END; (* udskriv *)
          
          PROCEDURE kopi(top1 : link; VAR top2 : link);
          
            VAR
              p, bund : link;
              i, antal : INTEGER;
              
            BEGIN (* kopi *)
              IF top1 = NIL
                THEN top2 := NIL
              ELSE
                BEGIN
                  NEW(top2);
                  top2^ := top1^;
                  bund := top2;
                  antal := postantal(top1);
                  FOR i := 2 TO antal DO
                    BEGIN
                      NEW(p);
                      top1 := top1^.naeste;
                      p^ := top1^;
                      bund^.naeste := p;
                      bund :=p;
                    END;
                END;
            END; (* kopi *)
          
          BEGIN (* postkopi *)
            top := NIL;
            NEW(ud);
            REPEAT
              WRITE(CLRHOM);
              GOTOXY(10, 4); WRITE('SORTERET KÆDE');
              GOTOXY(10, 7); WRITE('I. Indsæt person i kæden.');
              GOTOXY(10, 9); WRITE('F. Fjerne person fra kæden.');
              GOTOXY(10, 11); WRITE('U. Udskrive kæden.');
              GOTOXY(10, 13); WRITE('A. Afslutte programmet.');
              GOTOXY(10, 15); WRITE ('P. Udskrive postantal.');
              GOTOXY(10, 17); WRITE('K. Kopier kæden.');
              GOTOXY(10, 19); WRITE('Tast kommando: ');
              REPEAT
                READ(KBD, ch);
              UNTIL ch IN (.'I', 'i', 'F', 'f', 'U', 'u', 'P', 'p',
                            'K', 'k', 'A', 'a'.);
              WRITELN(ch);
              CASE ch OF
                'I', 'i' : BEGIN
                             NEW(pp);
                             WRITELN;
                             WRITE('Navn: '); READLN(pp^.navn);
                             WRITE('Adresse: '); READLN(pp^.adresse);
                             pp^.naeste := NIL;
                             indsaet(top, pp);
                           END;
                'F', 'f' : BEGIN
                             WRITELN;
                             WRITE('Hvem skal fjernes: ');
                             READLN(ud^.navn);
                             fjern(top, ud);
                           END;
                'U', 'u' : udskriv(top);
                'P', 'p' : BEGIN
                             WRITELN;
                             WRITELN('Antal poster: ', postantal(top), ' ');
                             return;
                           END;
                'K', 'k' : BEGIN
                             kopi(top, topkopi);
                             udskriv(topkopi);
                           END;
              END;
            UNTIL ch IN (.'A', 'a'.);
          END. (* postkopi *)
«eof»