program scsicor;

uses dos,crt,format,definit,daqlib,hardlib,treat,caliams;
const
      nb_plane=10; {6 reference + 2 double sided AMS}
      report=100;
      nb_cl=5;
      log_book='log_book.txt';
type bla=array[1..nb_plane]of integer;
  bla_bln=array[1..nb_plane]of boolean;
const bound:bla=(0,3*64,6*64,9*64,12*64,15*64,18*64,28*64,34*64,44*64);
      good_ev_cond:bla_bln=(true,true,true,true,true,true,false,false,false,false);
var
    nb_data:integer;
    nb_cl_written:longint;
    filename:string;
function find_plane(x:real):integer;
var i,j,k:integer;
begin
 i:=trunc(x);
 for j:=1 to nb_plane do
  if bound[j]<i then k:=j;
 find_plane:=k;
end;

function local_coord_plane(x:real):real;
begin
 local_coord_plane:=x-bound[find_plane(x)]
end;

function good_event(t:tcluster):boolean;
var
 i:integer;
 actual:tcluster;
 x:real;
 tmp:boolean;
 ok:bla_bln;
begin
 for i:=1 to nb_plane do ok[i]:=false;
 actual:=t;
 while actual<>nil do begin
  ok[find_plane(actual^.first)]:=true;
  actual:=actual^.next;
 end;
 tmp:=true;
 for i:=1 to nb_plane do if good_ev_cond[i] then tmp:=tmp and ok[i];
 good_event:=tmp;
end;

function permute(var p,q:tcluster):boolean;
var r,s:tcluster;
begin
 permute:=false;
 if (q^.next)=nil then exit;
 if (find_plane(q^.first)=find_plane((q^.next)^.first)) and
     (q^.integral<(q^.next)^.integral) then begin
   permute:=true;
   if p=q then begin {pointe sur le premier element}
     r:=q;
     s:=(q^.next)^.next;
     q:=q^.next;
     q^.next:=r;
     r^.next:=s;
    end
    else begin {les elements a permuter ne sont pas au debut}
     r:=q^.next;
     s:=r^.next;
     p^.next:=r;
     r^.next:=q;
     q^.next:=s;
    end;
 end;
end;

procedure trie_cluster(var t:tcluster);
var nb_perm:integer;
     perm,tmp:boolean;
    previous,actual:tcluster;
begin
  if t=nil then exit;
  repeat
   nb_perm:=0;
   actual:=t;
   previous:=t;
   while actual^.next<>nil do begin
         tmp:=actual<>t;
         perm:=permute(previous,actual);
         if perm then nb_perm:=nb_perm+1;
         if tmp then previous:=previous^.next else begin
            t:=actual;
            previous:=actual;
            actual:=actual^.next;
         end;
         if tmp and not perm then actual:=actual^.next;
   end;
  until nb_perm=0;
end;

procedure dump_good(var f:text;n_event:integer;t:tcluster;sc:out_scint;tdc:out_count;iss:longint);
var
 i,j:integer;
 actual:tcluster;
 mult:bla;
begin
 writeln(f,n_event);
 writeln(f,iss:7);
 for i:=1 to max_sci do write(f,sc[i]:5,' '); writeln(f);
 for i:=0 to 9 do write(f,tdc[i]:5,' '); writeln(f);
 actual:=t;
 for i:=1 to nb_plane do mult[i]:=0;
 while actual<>nil do with actual^ do begin
       i:=find_plane(first);
       cog:=local_coord_plane(cog);
       interp2:=local_coord_plane(interp2);
       first:=round(local_coord_plane(first));
       mult[i]:=mult[i]+1;
       actual:=next;
 end;
 actual:=t;
 for i:=1 to nb_plane do begin
   if mult[i]<=nb_cl then writeln(f,mult[i]) else writeln(f,nb_cl);
   for j:=1 to mult[i] do begin
     if j<=nb_cl then with actual^ do begin
        writeln(f,cog:7:2,' ',interp2:7:2,' ',integral:7:2,' ',
        sovern:7:2,' ',first:4,' ',length:2);
        nb_cl_written:=nb_cl_written+1;
     end;
     actual:=actual^.next;
   end;
 end;
end;

procedure initf(var f1,f2:text);
var exec_filename,ss:string;
   i,lex,lss:integer;
   aa:array[1..8] of word;
begin
 exec_filename:=paramstr(0);
 lex:=length(exec_filename); lss:=lex; ss:='';
 while exec_filename[lex]<>'\' do lex:=lex-1;
 for i:=lex+1 to lss-4 do ss:=ss+exec_filename[i];
 writeln(ss);
 if paramcount=0 then begin
  write('usage: ',ss,' filename(source) [filename(target)]');
  halt;
 end;
 if paramcount=2 then filename:=paramstr(2);
 ss:=paramstr(1);
 if check_hard and init then
 else begin writeln('no hardware'); halt; end;
 assign(f1,filename);
 if fexist(f1) then
    if enquire('overwrite '+filename) then rewrite(f1)
    else begin writeln('end'); halt; end
 else rewrite(f1);
 writeln('Read source file ',ss);
 writeln('Write clusters in file ',filename);
 assign(f2,dump_dir+log_book);
 if fexist(f2) then
    append(f2)
 else rewrite(f2);
 getdate(aa[1],aa[2],aa[3],aa[4]); gettime(aa[5],aa[6],aa[7],aa[8]);
 writeln(f2,aa[3],'/',aa[2],'/',aa[1],' ',aa[5],':',aa[6]);
 writeln(f2,'source ',ss,' to target ',filename);
 write('calibration file? run');
 readi(i);
 str(i,ss);
 writeln(f2,'calibration file: run'+ss+'.evn');
 writeln(f2,n_sig:7:2,cal_sigx:7:2,cal_sign:7:2,cal_occ:7:2,cal_mingain:7:2,
 corr:7:2,' calibration cuts as written in default.set file');
 writeln(f2,cut_seed:7:2,cut_nei:7:2,' cluster cuts, main and neighbour');
 repeat
   write('other comments ');
   readln(ss);
   if ss<>'' then writeln(f2,'comments ',ss)
 until ss='';
end;

procedure docluster;
var
    p:^tped;
    s:^tped;
    g:^tped;
    st:tstat;
    x:^tevent;
    cn:tcn;
   n_event,n_c:longint;
   xo:^signal;
   clust:tcluster;
   ch:char;
   f,book:text;
   sc:out_scint;
   tdc:out_count;
   iss:longint;
   cal_file:string;
   fini:boolean;
   i,u:integer;
   name:longint;
   cns:tcn;
begin
 u:=0;
 fini:=false;
 nb_cl_written:=0;
 initf(f,book);
 clust:=nil;
 n_event:=0;
 n_c:=0;
 new(p);
 new(s);
 new(g);
 new(x);
 new(xo);
 if calib_exist then begin
  read_calib(name,false,p^,s^,g^,st,cns);
  writeln('calibration file read');
 end
 else
  fake_calib(p^,s^,g^,st);
 ch:=' ';
 repeat
  softstart;
  if read_one_full_event(x^,sc,tdc,iss) then begin
   n_event:=n_event+1;
   sub_ped(x^,xo^,p^);
   common_noise(xo^,s^,st,cn,cut_seed);
   substract_cn(xo^,cn);
   clusterize(xo^,s^,st,cut_seed,cut_nei,clust);
   if not spill then n_event:=-n_event;
   if good_event(clust) then begin
      u:=u+1;
      trie_cluster(clust);
      dump_good(f,n_event,clust,sc,tdc,iss);
   end;
   n_event:=abs(n_event);
   if n_event mod report=0 then writeln('event ',n_event,', good event ',u,', number of clusters written: ',nb_cl_written);
  end
  else begin
   writeln('end');
   fini:=true
  end;
 until keypressed or fini;
 writeln(book,'#event ',n_event,', good event ',u/n_event*100:5:2,'%, number of clusters ',nb_cl_written);
 writeln(book);
 close(f);
 close(book);
 dispose(xo);
 dispose(x);
 dispose(g);
 dispose(s);
 dispose(p);
end;

begin
 filename:=dump_dir+'scsicor.lis';
 nb_data:=channel_per_va*nva_local;
 clrscr;
 docluster;
end.