(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*  Soubor: MSPOJSEZ.PAS                                                   *)
(*  Obsah: jeden jednoduchy zkouskovy priklad                              *)
(*  Autor: Mircosoft                                                       *)
(*  Posledni uprava: 29.5.2007                                             *)
(*  Pro kompilaci: nic                                                     *)
(*  Pro spusteni: nic                                                      *)
(*  Upozorneni: tyto zdrojove kody pouzivate na vlastni nebezpeci          *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

{Zadani:
Vytvorte jednosmerny spojovy seznam. V kazdem prvku bude jedna polozka typu
string a jeden ukazatel na nasledujici prvek.
Vymazte prvek seznamu PRED prvkem, na ktery ukazuje ukazatel Znacka.}

program SpojovySeznam;

(********************** vlastni reseni zadane ulohy: ************************)

type UkNaPrvek = ^PrvekSeznamu;
     prvekseznamu = record
                    retezec:string;
                    dalsi:uknaprvek;
                    end;

var prvni,znacka:uknaprvek;

function VymazPred(cim:uknaprvek; var zacatek:uknaprvek):boolean;
{vymaze prvek pred Cim v seznamu zacinajicimu ukazatelem Zacatek a vraci true,
pokud se to povede.}
var mazany,predchozi:uknaprvek;
Begin
if (zacatek=nil)or(cim=nil)or(cim=zacatek) then begin {neni co mazat -> konec}
                                                vymazpred:=false;
                                                exit;
                                                end;
mazany:=zacatek; predchozi:=nil;
while (mazany^.dalsi<>nil)and(mazany^.dalsi<>cim) do begin {pidalkovity pohyb po seznamu}
                                                     predchozi:=mazany;
                                                     mazany:=mazany^.dalsi;
                                                     end;
if mazany=nil then vymazpred:=false {tohle by teoreticky ani nemelo nastat}
              else begin {a konecne to mazani:}
                   if mazany=zacatek then zacatek:=cim
                                     else predchozi^.dalsi:=cim;
                   dispose(mazany);
                   vymazpred:=true;
                   end;
End;{vymazpred}

(**** ostatni pomocne procedury nutne ke spusteni a predvedeni programu: ****)

procedure pridej(var kam:uknaprvek; co:string);
{prida prvek na zacatek seznamu}
var novy:uknaprvek;
Begin
new(novy);
novy^.retezec:=co;
novy^.dalsi:=kam;
kam:=novy;
End;{pridej}

procedure vypis(co:uknaprvek);
{vypise cely seznam}
var pom:uknaprvek;
Begin
write('vypis seznamu: ');
pom:=co;
while pom<>nil do begin
                  write(pom^.retezec,', ');
                  pom:=pom^.dalsi;
                  end;
writeln;
End;{vypis}

function vyber(kolikaty:word; zacatek:uknaprvek):uknaprvek;
{Vraci ukazatel na Kolikaty (pocitano od 1) prvek ze seznamu zacinajiciho
ukazatelem Zacatek. Pokud ten prvek nenajde, vraci nil.}
var w:word;
    pom:uknaprvek;
Begin
pom:=nil;
if kolikaty<>0 then begin
                    w:=1;
                    pom:=zacatek;
                    while (pom<>nil)and(w<kolikaty) do begin
                                                       inc(w);
                                                       pom:=pom^.dalsi;
                                                       end;
                    end;
vyber:=pom;
End;{vyber}

(************************* predvadeci program: ******************************)

BEGIN
prvni:=nil; {nutna pocatecni inicializace seznamu}

{naplneni seznamu nejakymi blaboly:}
pridej(prvni,'posledni');
pridej(prvni,'predposledni');
pridej(prvni,'pulka');
pridej(prvni,'druhy');
pridej(prvni,'prvni');

{strucne intro:}
writeln;
writeln('************** program spusten *****************');
vypis(prvni);

{zadani Znacky:}
znacka:=vyber(4,prvni);

{vymazani prvku pred Znackou:}
if vymazpred(znacka,prvni) then writeln('Prvek smazan.')
                           else writeln('Neni co mazat.');

{vypis a cekani na enter, aby si uzivatel stacil precist vysledek:}
vypis(prvni);
writeln('Konec enterem.');
readln;
END.