|=---------------------------------------------------------------=| |=----------------=[ Список - Структура данных ]=----------------=| |=---------------------------------------------------------------=| |=---------------=[ Copyright (c) Flame Of Soul ]=---------------=| |=--------------=[ [E-mail]: _allbasse@yandex.ru ]=--------------=| |=---------------------------------------------------------------=| |=----------------------------=[ PAS ]=--------------------------=| |=---------------------------------------------------------------=| program rolls(input,output);
type insto = (before,after); str = string(10); longstr = string(60); dtype = str; node = record key : dtype; next : ^ node; prev : ^ node; end; ptr = ^ node; roll_tp = record start : ^ node; fin : ^ node; cnt : integer; mark : ^ node; end; roll = ^ roll_tp;
var l : roll; a : str; qry : array [1..10] of str; qry_len : integer; buff : longstr;
procedure roll_add (l : roll; val:dtype; dir:insto); var q : ^ node; begin new(q); if (l^.mark<>nil) then begin with l^.mark^ do begin if (dir=before) then begin q^.prev:=prev; if (prev<>nil) then prev^.next:=q else l^.start:=q; prev:=q; q^.key:=val; q^.next:=l^.mark; l^.mark:=q; end else begin q^.next:=next; if (next<>nil) then next^.prev:=q else l^.fin:=q; next:=q; q^.key:=val; q^.prev:=l^.mark; l^.mark:=q; end; inc(l^.cnt); end; end else begin with l^ do begin mark:=q; q^.next:=nil; q^.prev:=nil; q^.key:=val; fin:=q; start:=q; cnt:=1; end; end; end; { roll_add }
procedure roll_rewind(l : roll; mto:integer); var k : integer; begin with l^ do begin if (abs(mto)<>cnt) then begin if (mto>0) then begin while (mto>0) do begin dec(mto); if (mark^.next=nil) then begin writeln ('Roll: Right of roll reached, set last position'); break; end else mark:=mark^.next; end; end else begin while (mto<0) do begin inc(mto); if (mark^.prev=nil) then begin writeln ('Roll: Left of roll reached, set first position'); break; end else mark:=mark^.prev; end; end; end else begin if (mto>0) then mark:=fin else mark:=start; end; end; end; { roll_rewind }
procedure roll_delete(l : roll; off:integer); var m : ^ node; begin
if (off<>0) then roll_rewind(l,off);
if (l=nil) then begin writeln ("Roll doesn't exist"); exit; end;
if (l^.cnt=1) then begin
if (l^.mark=nil) then writeln('Roll: Mark is null!'); dispose(l^.mark); l^.start:=nil; l^.fin:=nil; l^.cnt:=0; l^.mark:=nil; exit; end;
if (l^.cnt=0) then begin writeln('Roll: Roll is empty, exit'); exit; end;
if (l^.mark=nil) then begin writeln("Roll: can't delete null element, exit"); exit; end;
if (l^.mark^.next<>nil) and (l^.mark^.prev<>nil) then begin { 'E' next and prev elements } l^.mark^.prev^.next:=l^.mark^.next; l^.mark^.next^.prev:=l^.mark^.prev; m:=l^.mark; l^.mark:=l^.mark^.next; dispose(m); end else begin if (l^.mark^.next=nil) then begin { 'E' only prev element } roll_rewind(l,l^.cnt); l^.mark^.prev^.next:=nil; l^.fin:=l^.mark^.prev; dispose(l^.mark); l^.mark:=l^.fin; end else begin { 'E' only next element } if (l^.mark^.prev=nil) then begin roll_rewind(l,-l^.cnt); l^.mark^.next^.prev:=nil; l^.start:=l^.mark^.next; dispose(l^.mark); l^.mark:=l^.start; end; end; end; dec(l^.cnt); end; { roll_delete }
function roll_get (l : roll; var val:dtype):boolean; begin if (l^.mark<>nil) then begin val:=l^.mark^.key; roll_get:=true; end else roll_get:=false; end; { roll_get }
procedure new_roll (var l : roll); begin new(l); with l^ do begin start:=nil; fin:=nil; cnt:=0; end; end; { new_roll }
function roll_search (var l : roll; val:dtype; dir:insto):boolean; var find : boolean;
procedure find_next(q : ptr); begin if (q<>nil) then begin if (q^.key=val) then begin find:=true; l^.mark:=q; end else if (dir=before) then find_next(q^.prev) else find_next(q^.next); end; end; { find_next }
begin find:=false; find_next(l^.mark); roll_search:=find; end; { roll_search }
procedure roll_dump (l : roll); var q : ^ node; begin with l^ do begin q:=start; while (q<>nil) do begin write(q^.key:5); q:=q^.next; end; writeln; end; end; { roll_dump }
function roll_cnt (l : roll):integer; begin roll_cnt:=l^.cnt; end; { roll_cnt }
function roll_eof (l : roll):boolean; begin roll_eof:=(l^.cnt=0); end; { roll_eof }
procedure break_roll (var l : roll); begin roll_rewind(l,-l^.cnt); while (l^.cnt>0) do roll_delete(l,0); dispose(l); l:=nil; end; { break_roll }
function val (x : str):integer; var i,res : integer; e : char; zn : integer; begin i:=1; e:='1'; res:=0; if (x[1]='-') then begin inc(i); zn:=-1; end else zn:=1;
while (e<>'') do begin e:=x[i]; if (e>='0') and (e<='9') then res:=res*10+ord(e)-ord('0') else begin break; end; inc(i); end; val:=zn*res; end; { val }
procedure readqry(line : longstr); var e : char; i,t,z : integer; sp : integer; s : boolean; useq : boolean; begin qry[1]:=''; i:=1; s:=false; useq:=false; z:=length(line); t:=0; while not (t=z) do begin inc(t); e:=line[t]; sp:=0; if useq then begin if (e="'") then begin useq:=false; sp:=5; end; end else case e of ' ' : sp:=1; { space } "'" : begin useq:=true; sp:=2; end; end; { case }
if (sp=0) then begin qry[i]:=qry[i] + e; s:=true; end else if s then begin inc(i); qry[i]:=''; s:=false; end; end; qry_len:=i; end; { readqry }
procedure qry_add; var q : insto; begin if (qry_len=1) then begin writeln('Roll: empty query'); exit; end;
if (qry_len<3) then q:=after else if (qry[3]='b') or (qry[3]='before') then q:=before else if (qry[3]='a') or (qry[3]='after') then q:=after;
roll_add(l,qry[2],q); end; { qry_add }
procedure qry_delete; var off : integer; begin if (qry_len=1) then off:=0 else off:=val(qry[2]); roll_delete(l,off); end; { qry_delete }
procedure qry_rewind; var off : integer; begin if (qry_len=1) then off:=-roll_cnt(l) else begin if (qry[2]='s') or (qry[2]='start') then off:=-roll_cnt(l) else if (qry[2]='e') or (qry[2]='end') then off:=roll_cnt(l) else off:=val(qry[2]); end; roll_rewind(l,off); end; { qry_rewind }
procedure qry_force_delete; var a : integer; begin if (qry_len=1) then a:=roll_cnt(l) else a:=val(qry[2]);
if (a>roll_cnt(l)) then writeln ('Roll: roll shorter that need') else begin roll_rewind(l,-roll_cnt(l)); while (a>0) do begin dec(a); roll_delete(l,0); end; end;
end; { qry_force_delete }
procedure qry_get; var a : dtype; begin if (roll_get(l,a)) then writeln(a) else writeln('Roll: Some errors on geting value occured'); end; { qry_get }
procedure qry_find; var q : insto; begin if (qry_len=2) then q:=after else begin if (qry[3]='before') or (qry[3]='b') then q:=before; end; if not roll_search(l,qry[2],q) then writeln('MERoll: Find have no results'); end; { qry_find }
procedure qry_help; begin writeln("Roll help Commands: [a]dd (key) ([a]fter(def),[b]efore) - insert new node; [r]ewind (to) - rewind mark to [s]tart, [e]nd or offset; [g]et - get value of active node; [d]elete (? offset) - delete active or offset node; [fd]elete (num) - delete first (num) nodes; [f]ind (key) (direct, def=after) - set mark poiter to this val [e]mpty - empty roll or not. "); end; { qry_help }
procedure qry_go; begin if (qry[1]='add') or (qry[1]='a') then qry_add; if (qry[1]='delete') or (qry[1]='d') then qry_delete; if (qry[1]='rewind') or (qry[1]='r') then qry_rewind; if (qry[1]='print') or (qry[1]='p') then roll_dump(l); if (qry[1]='get') or (qry[1]='g') then qry_get; if (qry[1]='help') then qry_help; if (qry[1]='empty') or (qry[1]='e') then writeln(roll_eof(l)); if (qry[1]='find') or (qry[1]='f') then qry_find; if (qry[1]='fdelete') or (qry[1]='fd') then qry_force_delete; end; { qry_go }
begin qry_help; new_roll(l); while not eof do begin readln(buff); readqry(buff); qry_go; end; break_roll(l); writeln('Good bye!'); end. |=-----------------------------=[ PAS ]=---------------------------=| |=-----------------------------------------------------------------=|
