old/PAS/List/JOPPE.PAS

Uses Graph,CRT;
Type
  PZveno = ^Zveno;
  Zveno  = record
         Name : string;
         num  : word;
         next : PZveno;
         prev : PZveno;
  end;

Var
  last, chain   : PZveno;
  curname       : string;
  period        : byte;
  tick          : byte;
  ends          : boolean;
  rcount        : word;
  num           : word;

Procedure Add(Name:string;var chain:PZveno;var num:word);
Var
  nz    : pzveno;
begin
  New(nz);
  nz^.name := name;
  nz^.next := last;
  nz^.prev := chain;
  inc(num);
  nz^.num := num;
  last^.prev := nz;
  chain^.next := nz;
  chain := nz;
end;

Function Remove(var zv:PZveno):boolean;
var cur : PZveno;ret:boolean;
begin
  cur := zv;
  ret := true;
  if (zv^.next <> zv^.prev) then ret := false;
  zv^.prev^.next := zv^.next;
  zv^.next^.prev := zv^.Prev;
  zv := zv^.next;
  Dispose(cur);
  Remove := ret;
end;

Function Count(chain:PZveno):byte;
var cur:pzveno;ret:byte;
begin
  cur := chain^.next;
  ret := 1;
  repeat
    inc(ret);
    cur := cur^.next;
  until cur = chain;
  Count := ret;
end;

Procedure Init;
var
 grDriver: Integer;
 grMode: Integer;
begin
 grDriver := Detect;
 InitGraph(grDriver, grMode,' ');
end;

Procedure WriteBall(cur,all,color:byte;cenX,cenY,radius:word;name:string);
var
  x1, y1 : word;
  angle  : real;
begin
  SetColor(color);
  angle := 2*PI/All*cur;
  x1 := cenx + round(radius*cos(angle));
  y1 := ceny + round(radius*sin(angle));
  Circle(x1,y1,10);
  SetTextJustify(CenterText,CenterText);
  SetColor(White);
  OutTextXY(x1,y1,name);
end;

Procedure KillBall(cur,all:byte;cenX,cenY,radius:word);
var
  x1, y1 : word;
  angle  : real;
begin
  SetColor(RED);
  angle := 2*PI/All*cur;
  x1 := cenx + round(radius*cos(angle));
  y1 := ceny + round(radius*sin(angle));
  SetLineStyle(SolidLn, 0, ThickWidth);
  Line(x1-6,y1+6,x1+6,y1-6);
end;

Begin
  New(chain);
  WriteLn('Enter Soilders'' names, blank for end:');
  ReadLn(curname);
  num := 1;
  if curname<>'' then chain^.name := curname else Halt(0);
  chain^.num:=1;
  last := chain;

  repeat
    ReadLn(curname);
    if curname<>'' then Add(curname,chain,num);
  until curname = '';

  WriteLn('Count: ',Count(chain));

  Write('Enter preiod: ');
  ReadLn(period);

  INit;
  rcount := count(chain);
  chain := last;
  For tick := 1 to rCount do
   begin
    WriteBall(tick,rcount,tick mod 15,320,240,200,chain^.name);
    chain := chain^.next;
   end;
{------------------------------------}
  tick := 0;
  chain := last;
  repeat
    ends := false;
    if tick mod period = 0 then
     begin
      tick := 0;
      KillBall(chain^.num,rcount,320,240,200);
      ends := Remove(chain);
      ReadKey;
     end
    else
     chain := chain^.next;
    inc(tick);
  until ends;
{  WriteLn('The last is - ',chain^.name);}
  WriteBall(chain^.num,rcount,RED,320,240,200,'Winner');
  Remove(Chain);
  Readln;
  CloseGraph;
End.