unit lists; interface type plinkage = ^linkage; pLink = ^link; phead = ^head; linkage = object {abstraktni objekt pro tvorbu dvousmernych seznamu } constructor init; {jen kvuli typeof} function lsuc : plink; {naslednik v seznamu } function lpred : plink; {predchudce v seznamu } function prev : plinkage; private nxt,prd:plinkage; end; link = object (linkage) {skutecne prvky seznamu } constructor init; {jen kvuli typeof} destructor done; virtual; procedure out; {vystupeni ze seznamu } procedure into(S:phead); {vstup do seznamu S} procedure precede(X:plinkage); {vstup pred X } procedure follow(X:plinkage); {vstup za X} end; head = object (linkage) { hlava seznamu } function card:integer; {vraci pocet prvku seznamu} constructor init; destructor done; { vyprazdni seznam a uvolni pamwet, kterou zabiraly jeho prvky } procedure clear; { vyprazdni seznam } function empty:boolean; { test zda je seznam prazdny } function first: plink; { prvni prvek seznamu } function last : plink; { posledni prvek seznamu } end; implementation procedure Abstr; begin runerror(211); end; function linkage.lsuc : plink; begin if typeof(nxt^)=typeof(head) then lsuc:=nil else lsuc:=plink(nxt) end; function linkage.lpred : plink; begin if typeof(prd^)=typeof(head) then lpred:= nil else lpred:=plink(prd) end; function linkage.prev : plinkage; begin prev:=prd; end; constructor linkage.init; begin Abstr; end; constructor link.init; begin Abstr; end; destructor link.done; begin { Abstr; } end; procedure link.out; begin if nxt<>nil then begin nxt^.prd:= prd; prd^.nxt:= nxt; prd:=nil; nxt:=nil; end; end; procedure link.into(S:phead); begin precede(S); end; procedure link.precede(X:plinkage); begin out; if X<>nil then begin if X^.nxt<>nil then {jen sichr} begin nxt:=X; prd:=X^.prd; prd^.nxt:= plinkage(@self); nxt^.prd:= plinkage(@self); end; end end; procedure link.follow(X:plinkage); begin out; if X<>nil then begin if X^.nxt<>nil then {jen sichr} begin prd:=X; nxt:=X^.nxt; prd^.nxt:= plinkage(@self); nxt^.prd:= plinkage(@self); end; end end; function head.card:integer; var I:integer; X:plink; begin if empty then card:=0 else begin I:=0; X:=first; while X<>nil do begin inc(I); X:=X^.lsuc; end; card:=I; end; end; constructor head.init; begin nxt:= @self; prd:= @self; end; procedure head.clear; var X:plink; begin while first<>nil do begin X:=first; X^.out; end; end; destructor head.done; var X:plink; begin while first<>nil do begin X:=first; X^.out; dispose(X,done); { vola se virtualni destruktor linku } end; end; function head.empty:boolean; begin empty:= nxt=@self; end; function head.first: plink; begin first:=lsuc; end; function head.last : plink; begin last:= lpred; end; end.