|
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: 7808 (0x1e80)
Types: TextFile
Names: »DOBBELT.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
└─ ⟦this⟧ »DOBBELT.PAS«
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
└─ ⟦this⟧ »DOBBELT.PAS«
└─⟦3702e543b⟧ Bits:30003064 Demoprogrammer A-J til Pascal bog
└─ ⟦this⟧ »DOBBELT.PAS«
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
└─ ⟦this⟧ »DOBBELT.PAS«
PROGRAM dobbelt;
TYPE
str40 = STRING(.40.);
link = ^ post;
post = RECORD
frem, tilbage : link;
navn : str40;
adresse : str40;
END;
VAR
ud, top, bund, 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 *)
PROCEDURE indsaet(VAR foerste, sidste : link; nypost : link);
VAR
foran, kandidat : link;
fundet : BOOLEAN;
BEGIN (* indsaet *)
IF foerste = NIL (* kæden er tom *)
THEN
BEGIN
foerste := nypost;
sidste := nypost;
END
ELSE IF nypost^.navn < foerste^.navn (* før første post *)
THEN
BEGIN
nypost^.frem :=foerste;
foerste^.tilbage := nypost;
foerste :=nypost;
END
ELSE (* find rigtig plads til nypost *)
BEGIN
fundet :=FALSE;
foran := foerste;
kandidat :=foerste^.frem;
WHILE (kandidat <> NIL) AND NOT fundet DO
IF nypost^.navn < kandidat^.navn
THEN fundet := TRUE
ELSE
BEGIN
foran := kandidat;
kandidat := kandidat^.frem;
END;
IF foran <> sidste
THEN
BEGIN
nypost^.frem := kandidat;
nypost^.tilbage := foran;
kandidat^.tilbage := nypost;
foran^.frem :=nypost;
END
ELSE
BEGIN
foran^.frem := nypost;
nypost^.tilbage := foran;
sidste := nypost;
END;
END;
WRITELN;
WRITE(nypost^.navn, ' er nu indsat i kæden. ');
return;
END; (* indsaet *)
PROCEDURE fjern(VAR foerste, sidste : link; glpost : link);
VAR
foran, kandidat : link;
fundet : BOOLEAN;
BEGIN (* fjern *)
IF foerste = NIL (* kæden tom *)
THEN fundet := FALSE
ELSE IF foerste^.navn = glpost^.navn (* fjern post 1 *)
THEN
IF foerste^.frem = NIL
THEN
BEGIN
foerste := NIL;
sidste := NIL;
fundet := TRUE;
END
ELSE
BEGIN
foerste^.frem^.tilbage := NIL;
foerste := foerste^.frem;
fundet := TRUE;
END
ELSE (* Søg efter navnet *)
BEGIN
fundet := FALSE;
foran := foerste;
kandidat := foerste^.frem;
WHILE (kandidat <> NIL) AND NOT fundet DO
IF glpost^.navn = kandidat^.navn
THEN
BEGIN
IF kandidat <> sidste
THEN
BEGIN
foran^.frem := kandidat^.frem;
kandidat^.frem^.tilbage := foran;
END
ELSE
BEGIN
foran^.frem := NIL;
sidste := foran;
END;
fundet := TRUE;
END
ELSE
BEGIN
foran := kandidat;
kandidat := kandidat^.frem;
END;
END;
IF fundet
THEN WRITE(glpost^.navn, ' er slettet fra kæden. ')
ELSE WRITE(glpost^.navn, ' findes ikke i kæden. ');
return;
END; (* fjern *)
PROCEDURE udskrivfrem(foerste : link);
VAR
pp : link;
BEGIN (* udskrivfrem *)
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^.frem;
END;
return;
END; (* udskrivfrem *)
PROCEDURE udskrivtilbage(sidste : link);
VAR
pp : link;
BEGIN (* udskrivtilbage *)
pp := sidste;
WRITELN;
WRITELN('Kæden indeholder følgende personer:');
WRITELN;
WHILE pp <> NIL DO
BEGIN
WRITELN(pp^.navn);
WRITELN(pp^.adresse);
WRITELN;
pp := pp^.tilbage;
END;
return;
END; (* udskrivtilbage *)
BEGIN (* dobbelt *)
top := NIL;
bund := 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 forfra.');
GOTOXY(10,13); WRITE('B. Udskrive kæden bagfra.');
GOTOXY(10,15); WRITE('A. Afslutte programmet.');
GOTOXY(10,17); WRITE('Tast kommando: ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (.'I', 'i', 'F', 'f', 'U', 'u', 'B', 'b',
'A', 'a'.);
WRITELN(ch);
CASE ch OF
'I', 'i' : BEGIN
NEW(pp);
WRITELN;
WRITE('Navn: '); READLN(pp^.navn);
WRITE('Adresse: '); READLN(pp^.adresse);
pp^.frem := NIL;
pp^.tilbage := NIL;
indsaet(top, bund, pp);
END;
'F', 'f' : BEGIN
WRITELN;
WRITE('Hvem skal fjernes: ');
READLN(ud^.navn);
fjern(top, bund, ud);
END;
'U', 'u' : udskrivfrem(top);
'B', 'b' : udskrivtilbage(bund);
END;
UNTIL ch IN (.'A', 'a'.);
END. (* dobbelt *)
«eof»