/* Stat Server - DMS - March 98 - by Sylvain HUET */

defcom Cstats=stats S;;

typedef Op=
  maxOp I
 |minOp I
 |averageOp [I I]
 |countOp I
 |lastOp S
 |sumOp I;;

typeof patt=[[S Op] r1];;
typeof stat=StatWin;;
typeof file=S;;
typeof ll=[CLIENT r1];;
typeof time0=S;;

fun saveOp(op)=
 match op with
 (maxOp y ->(itoa y)::nil)
|(minOp y ->(itoa y)::nil)
|(averageOp [y n] -> (itoa y)::(itoa n)::nil)
|(countOp i -> (itoa i)::nil)
|(lastOp s -> s::nil)
|(sumOp s -> (itoa s)::nil)
|(_->nil);;

fun fileStat(l)=
 if l==nil then nil
 else let l->[[s op] n] in
 (s::saveOp op)::fileStat n;;

fun saveStat()=
 if file==nil then nil
 else _storepack strbuild (time0::nil)::fileStat patt file;;

fun loadOp(op,l)=
 match op with
 (maxOp _ -> maxOp atoi hd l)
|(minOp _ -> minOp atoi hd l)
|(averageOp _ -> let atoi hd l->i in let atoi hd tl l->j in averageOp
   [if i==nil then 0 else i if j==nil then 0 else j])
|(countOp _ -> let atoi hd l->i in countOp if i==nil then 0 else i)
|(lastOp _ -> lastOp hd l)
|(sumOp _ -> let atoi hd l-> i in sumOp if i==nil then 0 else i)
|(_->nil);;

fun getOp(op)=
let match op with
 (maxOp y ->itoa y)
|(minOp y ->itoa y)
|(averageOp [y n] -> if n==0 then "_" else itoa y/n)
|(countOp i -> itoa i)
|(lastOp s -> s)
|(sumOp s ->itoa s)
|(_->nil)
-> s in if s==nil then "_" else s;;

fun getstat(l)=
 if l==nil then nil else let l->[[_ op] n] in
 (getOp op)::getstat n;;
fun getStat()= strbuild (getstat patt)::nil;;

fun gettitle(l)=
 if l==nil then nil else let l->[[s _] n] in
  s::gettitle n;;
fun getTitle()= strbuild (time0::nil)::(gettitle patt)::nil;;

fun fireOp(op,x,v)=
 match op with
 (maxOp y -> if (y==nil) || v>y then maxOp v else nil)
|(minOp y -> if (y==nil) || v<y then minOp v else nil)
|(averageOp [y n] -> averageOp [v+y n+1])
|(countOp i -> countOp i+1)
|(lastOp s -> lastOp x)
|(sumOp s -> sumOp s+v)
|(_->nil);;

fun broad(a,c)=_DMSsend this a c;;

fun runOp(i,x)=
 let i->[_ op] in
 let fireOp op x atoi x -> newop in
 if newop==nil then nil
 else
 (mutate i<-[_ newop];
  let getStat -> s in
  (_setStatW stat getStat;
   apply_on_list ll @broad Cstats [s]);
  saveStat);
 0;;

fun findOp(x)=
 if !strcmp x "max" then maxOp nil
 else if !strcmp x "min" then minOp nil
 else if !strcmp x "average" then averageOp [0 0]
 else if !strcmp x "count" then countOp 0
 else if !strcmp x "last value" then lastOp nil
 else if !strcmp x "sum" then sumOp nil
 else nil;;

fun activate(from,cli,action,param,rep)=
 if !strcmp substr action 0 2 "in" then
  let nth_list patt atoi substr action 2 1 -> i in
  runOp i param
 else if !strcmp action "show" then
 (_DMScreateClientDMI this cli getTitle;
  if (!_DMSclientAlive cli)||findList ll cli then nil
  else
  (set ll=cli::ll;
   _DMSsend this cli Cstats [getStat];
   _DMSevent this cli "shown" nil nil);
  0)
 else if !strcmp action "hide" then
  if !findList ll cli then nil
  else
  (_DMSdelClientDMI this cli;
   set ll=remove_from_list ll cli;
   _DMSevent this cli "hidden" nil nil)
 else nil;;

fun unregister(cli)=
 if !findList ll cli then nil
 else
 (set ll=remove_from_list ll cli;
  _DMSevent this cli "hidden" nil nil);
 0;;

fun getPatt(l)=
 if l==nil then nil
 else let l->[q n] in
 if !strcmp hd q "stat" then
 [hd tl q findOp hd tl tl q]::getPatt n
 else getPatt n;;

fun _resize(x,s)=
 let x->[win x y w h] in _SIZEwindow stat.winStatW w h x y;
 0;;

fun startStat()=
 let strcatn "Stats."::(_DMSgetName this)::
  "."::time0::nil -> statname in
 set stat=
  let _DMSgetZone this "Stats" nil @_resize nil ->[win x y w h] in
  if win==nil then
   iniStatW _channel DMSwin nil nil 350 190
    statname nil 0 hd tl strextr getTitle 
  else
   iniStatW _channel win x y w h
    statname nil 1 hd tl strextr getTitle;
 _setStatW stat getStat;;

fun iniStat(l,q)=
 if l==nil then 0
 else let l->[i n] in
 let i->[_ op] in
 (mutate i<-[_ loadOp op tl hd q];
  iniStat n tl q);;
 
fun IniDMI(param)=
 _DMSregisterDMI this @activate nil @unregister nil;
 let strextr _getpack _checkpack param ->l in
  (set patt=getPatt l;
   set file=getInfo l "file");
 let strextr _getpack _checkpack file -> l in
 (set time0=if l==nil then ctime time else hd hd l;
  iniStat patt tl l);
 startStat;;