DataMuseum.dk

top - download

    Length: 4864 (0x1300)
    Types: TextFile
    Names: »KAEDE2.PAS«

└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »KAEDE2.PAS« 

TextFile

        PROGRAM kaede2;
        
          TYPE
            str40 = STRING(.40.);
            link = ^ post;
            post = RECORD
                     naeste : link;
                     navn : str40;
                     adresse : str40;
                   END;
          
          VAR
            ud, top, pp : link;
            ch : CHAR;
          
          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; glpost : link);
            
            VAR
              foran, kandidat : link;
              fundet : BOOLEAN;
              ch : CHAR;
              
            BEGIN (* fjern *)
              IF foerste = NIL (* kæden tom *)
                THEN fundet := FALSE
              ELSE IF foerste^.navn = glpost^.navn (* fjern post 1 *)
                THEN
                  BEGIN
                    foerste := foerste^.naeste;
                    fundet := TRUE;
                  END
              ELSE (* Søg efter navnet *)
                BEGIN
                  fundet := FALSE;
                  foran := foerste;
                  kandidat := foerste^.naeste;
                  WHILE (kandidat <> NIL) AND NOT fundet DO
                    IF glpost^.navn = kandidat^.navn
                      THEN
                        BEGIN
                          foran^.naeste := kandidat^.naeste;
                          fundet := TRUE;
                        END
                      ELSE
                        BEGIN
                          foran := kandidat;
                          kandidat := kandidat^.naeste;
                        END;
                END;
              IF fundet
                THEN WRITELN(glpost^.navn,  ' er slettet fra kæden')
                ELSE WRITELN(glpost^.navn,  ' findes ikke i kæden');
              WRITE('Tast <RETURN>: ');
              READLN(ch);
            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 (* kaede2 *)
            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('Tast kommando: ');
              REPEAT
                READ(KBD, ch);
              UNTIL ch IN (.'I', 'i', 'F', 'f', 'U', 'u', '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);
              END;
            UNTIL ch IN (.'A', 'a'.);
          END. (* kaede2 *)
«eof»