Добавил:
darya13199
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:roll
.pasprogram 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.
Соседние файлы в предмете Программирование