|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5504 (0x1580)
Types: TextFile
Names: »KAEDE4.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
└─ ⟦this⟧ »KAEDE4.PAS«
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, ' paragraphs.');
WRITELN;
WRITELN('1 paragraph = 16 bytes.');
WRITE('Tast <RETURN>: ');
READLN(ch);
END;
END;
UNTIL ch IN (.'A', 'a'.);
END. (* kaede4 *)
«eof»