/* <Scol Technologies License> */
/* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */
/* For conditions of distribution and use, see copyright notice in dms/l/license.txt */
/* or on 'www.scol-technologies.org' */

/* sDHDMS - mar 00 - by Sylvain HUET */
/* users part */


var USER_global=1;;
var USER_client=2;;
var USER_changeClass=1;;
var USER_changeParam=2;;
var USER_changeAll=3;;


fun Itembyref(p,ref)=!strcmp p.refItem ref;;

/* id management */
var guestnb=1;;
fun UgetNewId()=
 set guestnb=guestnb+1;
 guestnb-1;;

fun uibyu(ui,u)=ui.userUI==u;;
fun uibyid(ui,id)=ui.userUI.idU==id;;
fun msgbyname(a,b)=let a->[x _] in !strcmp x b;;

fun Ulist(d)=d.ulistDMI;;
fun UgetUser(ui)=ui.userUI;;
fun UgetUserI(d,u)=search_in_list d.ulistDMI @uibyu u;;
fun UgetUserIid(d,id)=search_in_list d.ulistDMI @uibyid id;;
fun UgetLocation(ui)=ui.locUI;;
fun UgetClass(ui)=ui.classUI;;
fun UgetParams(ui)=ui.paramUI;;
fun UgetParam(ui,n)=getInfos ui.paramUI n;;
fun UgetVisibility(ui)=ui.visiUI;;
fun UgetRights(ui)= ui.visiUI.rightsVT;;


fun filtergroup(l,x,y,z)=
 if l==nil then nil
 else let l->[ui nxt] in
 let ui.visiUI ->v in
 if (max abs v.xVT-x max abs v.yVT-y abs v.zVT-z)<=1
  then ui::filtergroup nxt x y z
 else filtergroup nxt x y z;;

fun getproxgroup(t,seen,itab,x,y,z)=
 let t.groupTree -> array in
 if itab==SIZE_GRID_MODULO
 then
  if seen then t.listTree
  else array.SIZE_GRID_MODULO
 else
 conc filtergroup array.itab x y z
 conc filtergroup array.(1023&(itab+1)) x y z
 conc filtergroup array.(1023&(itab+31)) x y z
 conc filtergroup array.(1023&(itab+32)) x y z
 conc filtergroup array.(1023&(itab+33)) x y z
 conc filtergroup array.(1023&(itab-1)) x y z
 conc filtergroup array.(1023&(itab-31)) x y z
 conc filtergroup array.(1023&(itab-32)) x y z
 conc filtergroup array.(1023&(itab-33)) x y z
  if seen then nil else array.SIZE_GRID_MODULO;;

fun filtercommut(l)=
 if l==nil then nil
 else let l->[a nxt] in
 if a.visiUI.commutVT then a::filtercommut nxt
 else filtercommut nxt;;

fun _foouilist2(l)=
 if l==nil then 0
 else let l->[ui n] in
 (_fooS strcatn (itoa ui.userUI.idU)::" > "::ui.classUI::"("::(itoh ui.visiUI.itabVT)::")"::nil;
  _foouilist2 n);;

fun _foouilist(l)=
 if l==nil then _fooS "NIL" else _fooS "NOTNIL";
 _foouilist2 l;
 l;;
   
fun _fooLTree(l)=
 if l==nil then 0
 else let l->[t nxt] in
 (_fooS strcat t.labelTree " {";
  _foouilist t.groupTree.SIZE_GRID_MODULO;
  _fooLTree t.sonsTree;
  _fooS "}";
  _fooLTree nxt);;

fun _fooTree(d)=
 _fooS strcat "_fooTree " d.classDMI;
 _fooLTree d.utreeDMI::nil;;

/* Visibility Tree manager */
fun visigroup(v,t,seen,flagcommut,r)=
 let getproxgroup t seen v.itabVT v.xVT v.yVT v.zVT-> l in
 conc if flagcommut then l
 else filtercommut l r;;

fun visiblerec(v,l,seen,r)=
 if l==nil then r else let l->[t nxt] in
 visiblerec v nxt seen (visiblerec v t.sonsTree seen (visigroup v t seen seen r));;

fun visibleup(v,t,seen,r)=
 if t==nil then r
 else visibleup v t.fatherTree seen (visigroup v t seen 1-seen r);;

fun visibrothers(v,t,seen,r)=
 conc getproxgroup t seen v.itabVT v.xVT v.yVT v.zVT r;;

/* v : instance, t: tree node */
fun visibleTree(v,t,seen,r)=
 visibleup v t.fatherTree seen (visibrothers v t seen (visiblerec v t.sonsTree seen r));;

fun createTree(f,l,ui,x,rights)=
 let rights->[a nxr] in
 if l==nil then
  let mkTree [a mktab SIZE_GRID_MODULO+1 nil nil f nil] -> t in
  (set t.groupTree.(x.itabVT)=set t.listTree=ui::nil;
   set f.sonsTree=t::f.sonsTree;
   set x.treeVT=t)
 else let l->[t nxt] in
  if strcmp a t.labelTree then createTree f nxt ui x rights
  else if nxr==nil then
   (set t.groupTree.(x.itabVT)=ui::t.groupTree.(x.itabVT);
    set t.listTree=ui::t.listTree;
    set x.treeVT=t)
  else createTree t t.sonsTree ui x nxr;;

fun addTree(t,ui,x)=
 if x.rightsVT==nil then
 (set t.groupTree.(x.itabVT)=ui::t.groupTree.(x.itabVT);
  set t.listTree=ui::t.listTree;
  set x.treeVT=t)
 else createTree t t.sonsTree ui x x.rightsVT;;

fun delTree(t)=
 let t.fatherTree->f in
 if f==nil then t
 else
 (set f.sonsTree=remove_from_list f.sonsTree t;
  if f.sonsTree==nil then delTree f
  else f);;
 
fun removeTree(ui,x)=
 let x.treeVT->t in
 (set t.groupTree.(x.itabVT)=remove_from_list t.groupTree.(x.itabVT) ui;
  set t.listTree=remove_from_list t.listTree ui;
  if t.listTree==nil then delTree t else nil;
  set x.treeVT=nil);;

fun treeNew(rights,commut)=mkVTree [commut rights nil nil nil nil SIZE_GRID_MODULO];;
fun treeNewWithPos(rights,commut,x,y,z)=
 mkVTree [commut rights nil x y z (x&31)+(z&31)<<5];;

/* visibility api */
fun addVisi(d,ui)=let ui.visiUI -> x in addTree d.utreeDMI ui x;;

fun removeVisi(d,ui)=let ui.visiUI ->x in removeTree ui x;;

/* f=0 : list of people that the ui can see
   f=1 : list of people who can see the ui */  
fun getVisi(ui,f)=let ui.visiUI ->x in visibleTree x x.treeVT f nil;;

fun stringVisi(ui)=let ui.visiUI -> x in
  strbuild ("T"::x.rightsVT)::((itoa x.commutVT)::nil)::nil;;

fun uitocli(l)=if l==nil then nil else let l->[ui nxt] in
 let ui.userUI.cliU -> c in 
 if c==nil then uitocli nxt else c::uitocli nxt;;

/* listminus : remove q elements from p list */
fun listminus(p,q)=
 if p==nil then nil
 else let p->[a nxt] in
 if findList q a then listminus nxt q
 else a::listminus nxt q;;

 
 
/* UserInstance part */

fun deluicli(ui,cli)=execch ui.locUI.chnDMI ui.cbDelCliUI [ui cli];;
fun deluicli2(cli,ui)=deluicli ui cli;;

/* PARAMUI *//* renvoie la liste des paramètres non taggés par une '*'*/
/* PARAMUI */fun filterStarParam(lparam)=
/* PARAMUI */  if lparam==nil then
/* PARAMUI */    nil
/* PARAMUI */  else
/* PARAMUI */    let lparam-> [[pname pvalue] rest] in
/* PARAMUI */      if (nth_char pname 0)=='* then
/* PARAMUI */        filterStarParam rest
/* PARAMUI */      else
/* PARAMUI */        [pname pvalue]::(filterStarParam rest)
/* PARAMUI */;;

fun sendCreateCli2(ui,z)=
 let z->[d i cli] in
 _on_ cli CcreateUI [i ui.userUI.idU ui.userUI.flagU ui.classUI
/* PARAMUI */ strbuild filterStarParam ui.paramUI stringVisi ui];;
  
fun sendDeleteCli2(ui,z)=let z->[d i cli] in
 (_on_ cli CdeleteUI [i ui.userUI.idU];
  deluicli ui cli);;

fun sendCreateCli(l,d,cli)=apply_on_list l @sendCreateCli2 [d _DMSgetHandle d cli];;
fun sendDeleteCli(l,d,cli)=apply_on_list l @sendDeleteCli2 [d _DMSgetHandle d cli];;

fun broadUI(l,comm)= apply_on_list uitocli l @broad comm;;

fun sendCreateUI(l,ui)=
/* PARAMUI */ broadUI l CcreateUI [_DMSgetHandle ui.locUI ui.userUI.idU ui.userUI.flagU ui.classUI strbuild (filterStarParam ui.paramUI) stringVisi ui];;

fun sendDeleteUI(l,ui)=
 broadUI l CdeleteUI [_DMSgetHandle ui.locUI ui.userUI.idU];
 apply_on_list uitocli l @deluicli2 ui;;


typeof globalUser=[[I User] r1];;

/* API */

fun UcreateUser(c)=
 if c.userCLI==nil then
  let mkUser[UgetNewId c (USER_global|if c==nil then 0 else USER_client) nil] -> u in
  (set globalUser=[u.idU u]::globalUser;
   u)
 else c.userCLI;;

fun UgetGlobalUser(i)= switch globalUser i;;

fun UdelGlobalUser(u)= set globalUser=remove_from_list globalUser getSwitch globalUser u.idU; 0;;

fun UgetId(u)=u.idU;;
fun UgetClient(u)=u.cliU;;
fun UgetFlag(u)=u.flagU;;

fun UaddItem(u,i)=
 if i==nil then nil else
 let search_in_list u.itemU @Itembyref i.refItem -> j in
 if j==nil then (set u.itemU=i::u.itemU; nil)
 else set j.countItem=j.countItem +i.countItem;;

fun UsubItem(u,ref,n)=
 let search_in_list u.itemU @Itembyref ref -> j in
 if j==nil then 0
 else let j.countItem -> p in
 (if p<=n then (set u.itemU=remove_from_list u.itemU j; nil)
  else set j.countItem=p-n;
  p);;

fun UfindItem(u,ref)=
 search_in_list u.itemU @Itembyref ref;;

fun UclearItem(u)=
 set u.itemU=nil;
 0;;

fun _ITEMcreate(ref,name,count,date)=mkItem [ref name count date];;
fun _ITEMref(i)=i.refItem;;
fun _ITEMname(i)=i.nameItem;;
fun _ITEMcount(i)=i.countItem;;

fun UcreateUI(d,u,class,param,visi)=
 let UgetUserI d u ->x in if x!=nil then x
 else let mkUserI [u class param d visi nil nil nil nil 1 nil] -> ui in
 (set d.ulistDMI=ui::d.ulistDMI;
  addVisi d ui;
  sendCreateUI remove_from_list (getVisi ui 1) ui ui;
  if u.cliU==nil then nil
  else sendCreateCli (getVisi ui 0) d u.cliU;
  ui);;

fun Udelete(ui)=
 set ui.locUI.ulistDMI=remove_from_list ui.locUI.ulistDMI ui;
 sendDeleteUI (getVisi ui 1) ui;
 removeVisi ui.locUI ui;
 0;;

fun UdelClient(d,cli)=
 let UgetUserI d cli.userCLI -> ui in
 if ui==nil then nil else
 (apply_on_list getVisi ui 0 @deluicli cli;
  Udelete ui;
  execch ui.locUI.chnDMI ui.cbDeleteUI [ui]);;

fun UchgClass(ui,class,param)=
/* PARAMUI */ broadUI getVisi ui 1 CchgClassUI [_DMSgetHandle ui.locUI ui.userUI.idU class strbuild (filterStarParam param)];
 set ui.classUI=class;
 set ui.paramUI=param;
 ui
;;


fun UsetParams(ui,r)=
/* PARAMUI */ broadUI getVisi ui 1 CsetParamsUI [_DMSgetHandle ui.locUI ui.userUI.idU strbuild (filterStarParam r)];
 set ui.paramUI=r;
 r
;;


fun UsetParam(ui,r,v)=
/* PARAMUI */if (nth_char r 0)=='* then
/* PARAMUI */   nil
/* PARAMUI */else
/* PARAMUI */  broadUI getVisi ui 1 CsetParamUI [_DMSgetHandle ui.locUI ui.userUI.idU r strbuild v::nil];
 set ui.paramUI=
  if v==nil then DMSremress ui.paramUI r
  else [r v]::DMSremress ui.paramUI r;
 v;;

fun UsetVisibility(ui,visi)=
 if ui==nil then nil
 else let ui.locUI->d in
 let getVisi ui 0 -> see_old in
 let getVisi ui 1 -> seen_old in
 (removeVisi d ui;
  set ui.visiUI=visi;
  addVisi d ui;
  let getVisi ui 0 -> see in
  let getVisi ui 1 -> seen in
  let ui.userUI.cliU -> cli in
  (/*_fooS "UsetVisibility";
   _foouilist2 see_old;
   _foouilist2 seen_old;
   _foouilist2 see;
   _foouilist2 seen;*/
   if cli==nil then nil
   else
   (sendDeleteCli (listminus see_old see) d cli;
    sendCreateCli (listminus see see_old) d cli);
   sendDeleteUI (listminus seen_old seen) ui;
   sendCreateUI (listminus seen seen_old) ui
  ));;

fun UcbClientDestroyed(ui,f)= set ui.cbDelCliUI=f; ui;;
fun UcbDelete(ui,f)=set ui.cbDeleteUI=f; ui;;

fun UsendMessage(ui,cli,action,param)=
 let CsendUI [_DMSgetHandle ui.locUI ui.userUI.idU action param]->comm in
 if cli==nil then broadUI getVisi ui 1 comm
 else _on_ cli comm;;

fun UcbMessage(ui,l)= set ui.msgUI=conc l ui.msgUI; ui;;

fun UremoveMessage(ui,s)= set ui.msgUI=remove_from_list ui.msgUI search_in_list ui.msgUI @msgbyname s; ui;;

fun Ureceive(cli,dst,id,ac,pr)=
 let _DMSgetByHandle dst->d in if d==nil then nil
 else if findList cli.activCLI d then
  let search_in_list d.ulistDMI @uibyid id -> ui in
  if ui==nil then nil
  else
  (execch ui.locUI.chnDMI switchstr ui.msgUI ac [ui cli ac pr];
   if ui.cbCommUI!=nil then execch ui.locUI.chnDMI ui.cbCommUI [ui cli ac pr]
   else nil)
 else nil;;

/* ascendant compatibility */
fun _DMSgetNewId()=UgetNewId;;
fun UcbComm(d,ui,f)= set ui.cbCommUI=f; ui;;
fun UsetUserClass(d,uc,class)=class;;
fun UcbDel(d,ui,f)=UcbDelete ui f;;
fun UcbChange(d,ui,f)=ui;;
fun UcbCreate(d,f)=f;;
fun UcbDelCli(d,ui,f)= UcbClientDestroyed ui f;;

fun UcreateEx(d,u,class,param,cbdel,cbcomm,rights,commut)=
 UcbComm d (UcreateUI d u class param (treeNew rights commut)) cbcomm;;
fun Ucreate(d,u,class,param,cbdel,cbcomm)=UcreateEx d u class param cbdel cbcomm nil 1;;
fun Usend(d,ui,action,param)=0;;
fun UsendCli(d,cli,ui,action,param)= UsendMessage ui cli action param;;