DataMuseum.dk

top - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »KAEDE4.PAS«

└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »KAEDE4.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »KAEDE4.PAS« 
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »KAEDE4.PAS« 

TextFile

        PROGRAM kaede4;
        
          TYPE
            str40 = STRING(.40.);
            link = ^ post;
            post = RECORD
                     naeste : link;
                     navn : str40;
                     adresse : str40;
                   END;
          
          VAR
            ud, top, pp, friliste : link;
            ch : CHAR;
          
          PROCEDURE frigoer(pp : link);
          
            BEGIN (* frigoer *)
              pp^.naeste := friliste;
              friliste := pp;
            END; (* frigoer *)
          
          PROCEDURE opret(VAR pp : link);
          
            BEGIN (* opret *)
              IF friliste = NIL
                THEN NEW(pp)
                ELSE
                  BEGIN
                    pp := friliste;
                    friliste := friliste^.naeste;
                  END;
              pp^.naeste := NIL;
            END; (* opret *)
          
          PROCEDURE indsaet(VAR foerste : link; nypost : link);
            
            VAR
              ch : CHAR;
            
            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. ',
                          'Tast <RETURN>: ');
                    READLN(ch);
                 END
              ELSE (* find rigtig plads til nypost via rekursivt kald *)
                indsaet(foerste^.naeste, nypost);
            END; (* indsaet *)
          
          PROCEDURE fjern(VAR foerste : link; VAR glpost : link);
            
            VAR
              ch : CHAR;
              ud : link;
              
            BEGIN (* fjern *)
              IF foerste = NIL (* kæden tom *)
                THEN
                  BEGIN
                    WRITE(glpost^.navn, ' findes ikke i kæden',
                            ' Tast <RETURN>: ');
                    READLN(ch);
                  END
              ELSE IF foerste^.navn = glpost^.navn (* fjern post 1 *)
                THEN
                  BEGIN
                    ud := foerste;
                    foerste := foerste^.naeste;
                    frigoer(ud);
                    WRITE(glpost^.navn, ' er nu slettet fra kæden. ',
                            'Tast <RETURN>: ');
                    READLN(ch);
                  END
              ELSE (* Søg efter navnet via rekursivt kald *)
                fjern(foerste^.naeste, glpost);
            END; (* fjern *)
          
          PROCEDURE udskriv(foerste : link);
          
            VAR
              pp : link;
              ch : CHAR;
              
            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;
              WRITE('Tast <RETURN>: ');
              READLN(ch);
            END; (* udskriv *)
          
          BEGIN (* kaede4 *)
            top := NIL;
            friliste := 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('L. Ledig lagerplads.');
              GOTOXY(10,17); WRITE('Tast kommando: ');
              REPEAT
                READ(KBD, ch);
              UNTIL ch IN (.'I', 'i', 'F', 'f', 'U', 'u', 'A', 'a',
                            'L', 'l'.);
              WRITELN(ch);
              CASE ch OF
                'I', 'i' : BEGIN
                             opret(pp);
                             WRITELN;
                             WRITE('Navn: '); READLN(pp^.navn);
                             WRITE('Adresse: '); READLN(pp^.adresse);
                             indsaet(top, pp);
                           END;
                'F', 'f' : BEGIN
                             WRITELN;
                             WRITE('Hvem skal fjernes: ');
                             READLN(ud^.navn);
                             fjern(top, ud);
                           END;
                'U', 'u' : udskriv(top);
                'L', 'l' : BEGIN
                             WRITELN;
                             WRITE('Rest lager: ', MEMAVAIL, ' bytes.');
                             WRITE(' Tast <RETURN>: ');
                             READLN(ch);
                           END;
              END;
            UNTIL ch IN (.'A', 'a'.);
          END. (* kaede4 *)
«eof»