{
  Read voting sheets generated by export.scr in Deus ex Machina
  and generate page with results.
  Supports e_select.scr and e_inputl.scr fields, others are ignored.

  Cte anketni listky generovane skriptem export.scr v Deus ex Machine
  a generuje stranku s vysledky.
  Podporuje skripty e_select.scr a e_inputl.scr, ostatni jsou ignorovany.

  27.6.1999  Dement

  (6.8. small bugfix)
}

Uses Dos,Objects;

Const max=1000; {max otazek v ank.listku}

Var s:SearchRec;
    res:array[1..max] of PStringCollection;
    ndx,i,votes:integer;
    f:text;
    g,h:file of char;
    c:char;

    st:string; {globalni promenna pouzivana vsemi procedurami}

Procedure RawOutput(st:string);
begin
 while st<>'' do begin
   write(h,st[1]);
   delete(st,1,1);
   end;
end;

Procedure Output(n:word);
begin
 for n:=n downto 1 do begin
   if st='' then begin
     writeln('bug1');
     halt;
     end;
   write(h,st[1]);
   delete(st,1,1);
   end;
end;

Procedure Test;
var i,answa,hits:word;
    numba:string[10];
begin
 if copy(st,1,2)='' then begin
   inc(ndx);
   Output(2);
   if copy(st,1,2)='e_' then begin
     Output(2);
     with res[ndx]^ do
     {zpracuje tlacitka}
     if copy(st,1,11)='select.scr ' then begin
       Output(11);
       answa:=0;
       while st[1]<>'' do begin
         if answa>0 then Output(1);
         inc(answa);
         while not (st[1] in ['',';']) do Output(1);
         str(answa,numba);
         hits:=0;
         if count>0 then begin
           for i:=0 to count-1 do
            if copy(PString(At(i))^,1,length(numba)+1)=numba+' ' then inc(hits);
           str(100*hits/count:0:0,numba);
           RawOutput(' '+numba+'%');
           end;
         end;
       if count<>votes then begin
         str(count,numba);
         RawOutput(';('+numba);
         str(votes,numba);
         RawOutput('/'+numba+')');
         end;
       end
     else
     {zpracuje inputlajnu}
     if copy(st,1,10)='inputl.scr' then begin
       Output(10);
       while st[1]<>'' do Output(1);
       Output(2);
       RawOutput(#13#10);
       if count>0 then
        for i:=0 to count-1 do begin
          RawOutput(#9+' - ');
          RawOutput(PString(At(i))^);
          RawOutput(#13#10);
          end;
       end;
     end
   else
     {jiny skript}
     Output(1);
   end
 else
   {nic zajimaveho}
   Output(1);
end;

BEGIN
 if paramcount<>1 then begin
   writeln('Usage: ANK r47  - read voting sheets r47.*, voting page r47 and write r47-res.');
   writeln('Pouziti: ANK r47  - precte listky r47.*, anketni stranku r47 a zapise r47-res.');
   halt;
   end;
 for i:=1 to max do begin
   New(res[i],Init(20,100));
   res[i]^.Duplicates:=true;
   end;
 votes:=0;
 {cyklus pres listky: precte odpovedi do pole kolekci res[cislo otazky]}
 FindFirst(paramstr(1)+'.*',AnyFile,s);
 if doserror<>0 then begin
   writeln('Voting forms ',paramstr(1),'.* not found.');
   writeln('Nenasel jsem zadny anketni listek ',paramstr(1),'.*.');
   halt;
   end;
 while doserror=0 do begin
   st:=paramstr(1);
   while not (st[length(st)] in ['\',':',#0]) do dec(st[0]);
   st:=st+s.name;
   if (length(st)>4)
    and (st[length(st)-3]='.')
    and (st[length(st)-2] in ['0'..'9'])
    and (st[length(st)-1] in ['0'..'9'])
    and (st[length(st)] in ['0'..'9']) then begin
     writeln(st);
     assign(f,st);
     reset(f);
     inc(votes);
     if not eof(f) then readln(f,st);
     while not eof(f) do begin
       readln(f,st);
       ndx:=0;
       while (length(st)>0) and (st[1] in ['0'..'9']) do begin
         ndx:=10*ndx+ord(st[1])-48;
         delete(st,1,1);
         end;
       delete(st,1,1);
       if (ndx>0) and (ndx<max) then res[ndx]^.Insert(NewStr(st))
        else writeln(' ',ndx,':',st);
       end;
     close(f);
     end;
   FindNext(s);
   end;
 {cyklus pres otazky: zpracuje a zapise odpovedi}
 writeln;
 writeln(paramstr(1));
 assign(g,paramstr(1));
 reset(g);
 if ioresult<>0 then begin
   writeln('I need voting page ',paramstr(1),' to create result page.');
   writeln('Potrebuji stranku ',paramstr(1),' s anketou, podle ni vygeneruji stranku s vysledky.');
   halt;
   end;
 st:=paramstr(1)+'-res';
 if (length(st)>10)
  and (pos('\',copy(st,length(st)-9,10))=0)
  and (pos(':',copy(st,length(st)-9,10))=0) then
   st:=copy(paramstr(1),1,length(paramstr(1))-4)+'-res';
 assign(h,st);
 rewrite(h);
 if ioresult<>0 then begin
   writeln('Unable to create result page ',st,'.');
   writeln('Nelze vytvorit stranku s vysledky ',st,'.');
   halt;
   end;
 writeln(st);
 st:='';
 ndx:=0;
 while not eof(g) do begin
   read(g,c);
   st:=st+c;
   if length(st)=255 then Test;
   end;
 while st<>'' do Test;
 close(h);
 close(g);
END.