/* Loto Server - DMS - june 2000 - by julien ZORKO */

/* -------------Debugging functions------------- 
 */
fun DDmes(message)= _fooS strcatn "\n%%%%%%%%%%%%% "::message::"\n"::nil;0;;

/* -------------Data structures-------------
 */
struct Tgrid=[GRrows:I, GRcols:I, GRcontent:[I r1], GRwon:[I r1], GRnulls:I] mkTgrid;;
struct Tplayer=[PLstate:S, PLcli:CLIENT, PLgrid:Tgrid] mkTplayer;;
struct Tgame=[GAname:S, GAstate:S, GAtime:I, GAtimer:Timer, GAplayers:[Tplayer r1], GAcurToken:I, GAtakenTok:[CLIENT I], GAallTokens:[I r1] ] mkTgame;;
struct Tgames=[GASstate:S, GASrun:I, GASnb:I, GASgames:[Tgame r1]] mkTgames;;

/* -------------Data Objects-------------
 */ 
typeof games=Tgames;;
typeof mygrid=Tgrid;; 
typeof allclients=[CLIENT r1];;
typeof adminList=[CLIENT r1];;
typeof freeplayers=Tgame;;
typeof dmiHead=S;;
typeof paramsFile=S;;

/* -------------Global variables---------
 */
var maxGames=16;;
var maxPlayers=10;;
var gameLife=60000;; /* time before auto kill if nobodyelse connect it */ 
var beforeBegin=10;; /* when 2 players are connected time before play for other players who want connect*/
var beforeEnd=5000;;
var tokenFlow=5000;; /* time between two different tokens */
var freeplayersGame="** Free Players **";;

/* -------------Client functions (defcom objects)-------------
 */
defcom CupdatePlayerList=UpdatePlayerList S;;
defcom CplayerListChanged=PlayerListChanged;;
defcom CupdateGameList=UpdateGameList S;;
defcom CdrawGrid=DrawGrid I I S;;
defcom CdrawToken=DrawToken I;;
defcom CdrawTokens=DrawTokens I I S;;
defcom Clogin=Login S;;
defcom Clogout=Logout;;
defcom CmodifyParams=ModifyParams S;;
defcom CwriteInfo=WriteInfo S I I;;

fun broad(x,s)=_DMSsend this x s;;
  
/* ------------Basic functions-------------
 */

fun _SearchInList(l,i)=
 if l==nil then nil
 else let l -> [a nxt] in
  if i==a  then l
  else _SearchInList nxt i;;

fun _RemoveAllFromList(l,i)=
 if l==nil then nil
 else let l -> [a nxt] in
  if i==a then _RemoveAllFromList nxt i
  else a::_RemoveAllFromList nxt i;;   

/* copied from 'DMS/LIB/_mlistlib.pkg' */ 
fun is_in_list (l, x)=
 if l==nil then 0
 else let l->[a nxt] in
  (a==x)||is_in_list nxt x;;
     
/* copied from 'DMS/LIB/_mlistlib.pkg' */ 
fun replace_nth_in_list (list, n, x)=
  if n < 0 then list
  else let list -> [first next] in
   if n==0 then x::next
   else first::replace_nth_in_list next n-1 x;;

/* copied from 'DMS/LIB/_mlistlib.pkg' */ 
fun remove_nth_from_list (list, n)=
  if n < 0 then list
  else let list -> [first next] in
       if n==0 then next
       else first::remove_nth_from_list next n-1;;

fun remove_list_from_list(l,dl)=
 let dl -> [a b] in
 if a==nil then l
 else let remove_from_list l a -> newlist in remove_list_from_list newlist b;;

fun dividelist(x,p)=
 if p==nil then nil
 else
  let p->[a n] in
  let dividelist x n ->[m1 m2] in
  if x>a then [a::m1 m2]
  else [m1 a::m2];;
  
fun quicksort(l)=
 if l==nil then nil
 else
  let l->[vl nl] in
  let dividelist vl nl -> [va na] in
  listcat quicksort va vl::quicksort na;;

fun _GetCliPlayerList(playerlist)=
  let playerlist -> [first next] in
  if first==nil then nil
  else (first.PLcli)::(_GetCliPlayerList next);;

fun _GetPlayerByCli(cli,playerlist)=
  let playerlist -> [first next] in
  if first==nil then nil
  else if first.PLcli==cli then first 
  else _GetPlayerByCli cli next;;
  
fun _GetGameOfCli(gl,cli)=
  let gl -> [first next] in
  if first==nil then nil 
  else if (_GetPlayerByCli cli first.GAplayers)==nil then _GetGameOfCli next cli
  else first;;
  
fun _DeletePlayer(cli,playerlist)=
  let playerlist -> [first next] in
  if first==nil then nil
  else if first.PLcli==cli then next 
  else first::(_DeletePlayer cli next);;  
 
fun _InfosToPlayers(g,txt,style,color)= 
  apply_on_list _GetCliPlayerList g.GAplayers @broad CwriteInfo [txt style color];; 

fun _InfosToPlayer(cli,txt)= _DMSsend this cli CwriteInfo [txt 0 0xff00];;  
  
/* -----------random functions -------------
 */ 
fun randdif(range,list)=
 let range -> [a b] in 
 let (mod rand b-a+1)+a -> new in
 if is_in_list list new then (randdif range list)
 else new;;
 
/* list of 'length' random different integers selected in 'range' [a;b]*/
fun randlist(range,length)=
 if length==0 then nil 
 else let range -> [a b] in 
      let randlist range length-1 -> next in
      let randdif range next -> new in 
      new::next;;
 
fun _RandToken(l)=
  if l==nil then nil 
  else ( let sizelist l -> s in
         let randlist [0 s-1] 1 -> [i _] in
         nth_list l i );; 
 
/* ------------Grid functions--------------
 */ 
fun _GetGridNumbers(rows,cols,range)=
 if cols<=0 then nil
 else let range -> [a b] in
  listcat (quicksort randlist range rows) (_GetGridNumbers rows (cols-1) [a+10 b+10]);; 

fun _DeleteNumbers(list,wlist)=
 let wlist -> [aw wlist] in
 if aw==nil then list 
 else let replace_nth_in_list list aw 0 -> list in
      _DeleteNumbers list wlist;;  
 
fun _NewGridContent(gr)=
 let _GetGridNumbers gr.GRrows gr.GRcols [1 10] -> grid in
  _DeleteNumbers grid (randlist [0 26] gr.GRnulls);;

fun _GetNewGrid(cli)=
 srand (time+_DMSgetId cli);
 /* when players finish a game they get a new grid in the same time so
    and have the same content if their id is not added in the srand call */ 
 let _GetPlayerByCli cli freeplayers.GAplayers -> pl in
 if pl==nil then 0 else
 let pl.PLgrid -> gr in
 let _NewGridContent gr -> newgrid in
 let listtostr newgrid -> newgridstr in
 ( set pl.PLgrid.GRcontent = newgrid;
   _DMSsend this cli CdrawGrid [gr.GRrows gr.GRcols newgridstr];
   _DMSsend this cli CdrawTokens [gr.GRrows gr.GRcols  newgridstr] );; 

fun __GetNewGrid()=_GetNewGrid DMSsender;;

  
/* ------------GameS functions--------------
 */

fun _is_game_name(a,name)=!strcmp a.GAname name;;

fun _game_by_name(name)=search_in_list games.GASgames @_is_game_name name;;

fun _replace_game_in_list (list, oldname, new)=
  if list==nil then nil
  else let list -> [first next] in
       if !strcmp first.GAname oldname then new::next
       else first::_replace_game_in_list next oldname new;;

fun _GetGameName(name,i)=
 let if i==nil then [name 0] else [strcatn name::"["::(itoa i)::"]"::nil i+1] -> [newname i] in
 if (_game_by_name newname)==nil then newname
 else _GetGameName name i;;

fun _GameState(game)=
 if !strcmpi game.GAstate "wait1" then "1 player"
 else if !strcmpi game.GAstate "wait" then strcatn "starts in "::(itoa game.GAtime)::"s"::nil
 else if !strcmpi game.GAstate "play" then "playing"
 else if !strcmpi game.GAstate "end" then "finished"
 else if !strcmpi game.GAstate "free" then "!"
 else "error";;
  
fun _GetStrGameList(gamelist)=  
  let gamelist -> [first nxt] in
  if first==nil then nil
  else let strcatn first.GAname::" ("::(_GameState first)::")"::nil -> firstline in 
       firstline::_GetStrGameList nxt;;
  
fun _UpdateGameList(gamelist)=
 apply_on_list allclients @broad 
   CupdateGameList [(linebuild _GetStrGameList  gamelist)];;
   
fun _KillGame(tim,g)=
 _deltimer tim;
 let _GetCliPlayerList (listcat g.GAplayers freeplayers.GAplayers) -> clientlist in
 ( _deltimer g.GAtimer;
   apply_on_list (_GetCliPlayerList g.GAplayers) @broad Clogout [];
   apply_on_list clientlist @broad CplayerListChanged []);;
  
fun _CreateGame(game)=
 if (sizelist games.GASgames) > maxGames then nil else
 let _starttimer _channel gameLife -> tim in
 let _GetGameName game nil -> newgame in
 let mkTgame [newgame "nobody" beforeBegin tim nil nil nil nil] -> ng in
 ( set games.GASgames = ng::games.GASgames;
   _rfltimer tim @_KillGame ng;
   ng );;
 
fun _IniGames()= 
 set games = mkTgames ["ini" 0 0 nil];
 set games.GASgames = (mkTgame [freeplayersGame "free" 0 nil nil nil nil nil])::games.GASgames;
 set freeplayers = _game_by_name freeplayersGame;;

fun _DisplayGameList(cli)=
 _DMSsend this cli CupdateGameList [linebuild _GetStrGameList games.GASgames];; 

/* -------------- Player functions -------------
 */
fun _IsPlayerOf(p,game)= is_in_list (_GetCliPlayerList game.GAplayers) p;;
  
fun _TplayerToStrList(plist)=
 if plist==nil then nil
 else let plist -> [player list] in (_DMSgetLogin (player.PLcli))::(_TplayerToStrList list);;

fun _UpdatePlayerList(cli, game)=
 let _game_by_name game -> g in 
  _DMSsend this cli CupdatePlayerList [linebuild _TplayerToStrList g.GAplayers];;

fun __RefreshPlayerList(game)=
 _UpdatePlayerList DMSsender game;;


/* ------------ Game functions ----------------
 */
 
fun _EvTokensPerLines(t,cont,i)=
 let cont -> [a b] in
 if a==nil then tabtolist t
 else 
 ( if (a==0) || (a>90) then
     let mod i (sizetab t) -> ind in
     set t.ind = t.ind + 1      
   else nil;
   _EvTokensPerLines t b i+1 );;
 
fun _EvNumberOfCompletedRows(l,val,i)=
 let l -> [a b] in
 if a==nil then i 
 else if a==val then _EvNumberOfCompletedRows b val i+1
      else _EvNumberOfCompletedRows b val i;;
 
fun sum_list(l)= 
 let l -> [a b] in
 if a==nil then 0
 else a+(sum_list b);;
 
fun _Scores(pl,winner)=
 let mktab pl.PLgrid.GRrows 0 -> lines in
 let _EvTokensPerLines lines pl.PLgrid.GRcontent 0 -> tpl in
 let sum_list tpl -> tks in
 let _EvNumberOfCompletedRows tpl pl.PLgrid.GRcols 0 -> sc in
 ( if (sc==3) || (pl.PLcli==winner) then _DMSevent this pl.PLcli "score" "60" nil 
   else _DMSevent this pl.PLcli "score" (itoa tks+sc*5-pl.PLgrid.GRnulls) nil;
   0);;

 
fun _EndGame(g,winner)=
  set g.GAstate = "end";
  apply_on_list g.GAplayers @_Scores winner;
  _UpdateGameList games.GASgames;
  _deltimer g.GAtimer;
  set g.GAtimer = _starttimer _channel beforeEnd;
  _rfltimer g.GAtimer @_KillGame g;;  
 
fun _NewToken(t,g)=
 if g.GAtakenTok==nil then nil
 else let g.GAtakenTok -> [cli _] in
      let _GetPlayerByCli cli g.GAplayers -> pl in
      let pl.PLgrid-> gr in
      let g.GAcurToken -> tok in
      let _SearchInList gr.GRcontent tok -> token in
      let tok+100 -> v in
      ( mutate token <- [v _];
        set gr.GRwon=v::gr.GRwon;
        set g.GAallTokens = remove_from_list g.GAallTokens tok;
        _DMSsend this cli CdrawTokens [gr.GRrows gr.GRcols (listtostr gr.GRcontent)];
        _InfosToPlayers g (strcat (_DMSgetLogin cli) " got it !") FF_WEIGHT 0xff00;
        if (sizelist gr.GRwon) == (gr.GRrows*gr.GRcols-gr.GRnulls) 
        then ( _InfosToPlayers g (strcat (_DMSgetLogin cli) " WINS !!") FF_WEIGHT 0xff;	  
               _EndGame g cli; 
               nil ) 
        else nil;
        set g.GAtakenTok = nil );
 let _RandToken g.GAallTokens -> value in
 ( if value==nil || (!strcmp g.GAstate "end") then nil 
   else ( apply_on_list (_GetCliPlayerList g.GAplayers) @broad CdrawToken [value];nil );
   set g.GAcurToken = value );;
  
fun __IHaveIt(game,t,value)=
  let _game_by_name game -> g in
  let _GetPlayerByCli DMSsender g.GAplayers -> pl in
  let pl.PLgrid -> gr in 
  ( if (_IsPlayerOf DMSsender g) && (value==g.GAcurToken) 
    then ( let _SearchInList gr.GRcontent value -> token in 
           let (hd token)+100 -> v in
	   if v==nil 
           then let gr.GRwon -> [first next] in
	   ( _InfosToPlayer DMSsender "You don't have it!";
	     if first==nil then nil 
	     else let first-100 -> tok in
	     let _SearchInList gr.GRcontent first -> t in
	     ( mutate t <- [tok _];
	       set gr.GRwon = next;
	       set g.GAallTokens = tok::g.GAallTokens;
	       nil ) ) 
	   else ( _InfosToPlayer DMSsender "You want it?";
                  let g.GAtakenTok -> [cli mint] in 
	          if t<mint then set g.GAtakenTok = [DMSsender t] else nil; 
	          nil) )
    else nil;
    _DMSsend this DMSsender CdrawTokens[pl.PLgrid.GRrows pl.PLgrid.GRcols (listtostr gr.GRcontent)] );
  0;;


/* ----------- Client functions -------------
 */
fun _BeginGame(g)=
  let _starttimer _channel tokenFlow -> toktimer in
  ( _rfltimer toktimer @_NewToken g;
    _NewToken toktimer g;
    set g.GAtimer=toktimer; 
    set g.GAstate="play");;
 
fun _WaitBeforeBegin(tt,g)=
  if g.GAtime<2 
  then ( _deltimer tt; _BeginGame g; nil) 
  else (set g.GAtime=g.GAtime-1;nil);
  _UpdateGameList games.GASgames; 
  0;;
 
fun __LoginGame(game,new)= 
 if (strcmp game freeplayersGame) && (_IsPlayerOf DMSsender freeplayers) then
 let if new then _CreateGame game else _game_by_name game -> g in
 if g==nil then nil else  
 if (sizelist g.GAplayers) >= maxPlayers then nil else 
 let _GetPlayerByCli DMSsender freeplayers.GAplayers -> newplayer in 
 ( _DMSsend this DMSsender Clogin [g.GAname]; 
   set freeplayers.GAplayers = _DeletePlayer DMSsender freeplayers.GAplayers;
   set g.GAplayers = newplayer::g.GAplayers;
   set g.GAallTokens = listcat (_RemoveAllFromList newplayer.PLgrid.GRcontent 0) g.GAallTokens;
    
   if !strcmp g.GAstate "nobody" then (set g.GAstate="wait1";0) 
   else if !strcmp g.GAstate "wait1" 
   then ( _deltimer g.GAtimer;
          set g.GAtimer = _starttimer _channel 1000;
          _rfltimer g.GAtimer @_WaitBeforeBegin g; 
          set g.GAstate="wait";
          0)
   else 0;
   
   let _GetCliPlayerList (listcat g.GAplayers freeplayers.GAplayers) -> clientlist in
   ( _UpdateGameList games.GASgames;
     apply_on_list clientlist @broad CplayerListChanged [];
     0 ) )
  else nil;;
     
fun _LogoutGame(cli,g)=
 if g==nil then nil else 
  let _GetPlayerByCli cli g.GAplayers -> player in
  ( set g.GAplayers = _DeletePlayer cli g.GAplayers;
    set freeplayers.GAplayers = player::freeplayers.GAplayers;
    set g.GAallTokens = remove_list_from_list g.GAallTokens player.PLgrid.GRcontent;
    set player.PLgrid.GRwon = nil;

    if g.GAplayers==nil
    then ( set games.GASgames = removef_from_list games.GASgames @_is_game_name g.GAname;
           _UpdateGameList games.GASgames ) 
    else if (sizelist g.GAplayers)==1 then
    ( if !strcmp g.GAstate "play" then 
        let g.GAplayers -> [pl _] in 
        ( _EndGame g pl.PLcli; 
          nil )
      else if !strcmp g.GAstate "wait" then
        let _starttimer _channel gameLife -> tim in
        ( _deltimer g.GAtimer;
          set g.GAstate="wait1";
	  set g.GAtimer=tim;
          _rfltimer tim @_KillGame g;
          0 )
      else nil )
    else nil;
    
    _GetNewGrid cli;
    apply_on_list allclients @broad CplayerListChanged [] );;     
  
fun __LogoutGame(game)=  
 if (game!=nil) && (strcmp game freeplayersGame) then
  let _game_by_name game -> g in
  _LogoutGame DMSsender g
 else nil;;
 
fun _KillClient(cli)=
  _LogoutGame cli (_GetGameOfCli games.GASgames cli);
  set freeplayers.GAplayers = _DeletePlayer cli freeplayers.GAplayers;
  set allclients = remove_from_list allclients cli;
  set adminList = remove_from_list adminList cli;
  apply_on_list allclients @broad CplayerListChanged [];
  _DMSdelClientDMI this cli;
  _DMSevent this cli "destroyed" nil nil;;     
  
fun _NewClient(cli,admin)=
if is_in_list allclients cli then nil 
else let mkTgrid[3 9 nil nil 12] -> gr in
( _DMSevent this cli "entering" nil nil;
  if !strcmp admin "administrateur" 
  then ( set adminList=cli::adminList;  
         _DMScreateClientDMI this cli "administrateur";
         0 )
  else ( _DMScreateClientDMI this cli "";
         0 );
  set gr.GRcontent = _NewGridContent gr; 
  set allclients = cli::allclients;
  set freeplayers.GAplayers = (mkTplayer["new" cli gr])::freeplayers.GAplayers;
  _UpdateGameList games.GASgames;
  apply_on_list allclients @broad CplayerListChanged [];
  _DMSsend this cli CdrawGrid [gr.GRrows gr.GRcols listtostr gr.GRcontent];
  _DMSsend this cli CdrawTokens [gr.GRrows gr.GRcols listtostr gr.GRcontent];
  _DMSsend this cli CdrawToken [0];
  0 );;

/* ---------------- Administration --------------
 */
fun _IsAdmin(cli)= is_in_list adminList cli;;

fun _VerifParams()= 
  (dmiHead==nil)|(gameLife==nil)|(beforeBegin==nil)|
  (beforeEnd==nil)|(tokenFlow==nil)|(maxGames==nil)|(maxPlayers==nil);; 

fun _GetLinesTo(p,word)=
  let p -> [first next] in
  if first==nil then nil
  else let first -> [a b] in
       if !strcmp a word then nil
       else first::(_GetLinesTo next word);; 
 
fun _LoadParameters()=
  let strextr _getpack _checkpack paramsFile -> p in
  ( set dmiHead = strbuild _GetLinesTo p "Parameters";
    set gameLife = 1000*(atoi getInfo p "Vlife");
    set beforeBegin = atoi getInfo p "Vbegin";
    set beforeEnd = 1000*(atoi getInfo p "Vend");
    set tokenFlow = 100*(atoi getInfo p "Vflow");
    set maxGames = atoi getInfo p "Vmaxgames";
    set maxPlayers = atoi getInfo p "Vmaxplayers";
    _VerifParams );; 

fun __Admin(action,name)=
if !(_IsAdmin DMSsender) then nil else 
( if !strcmp action "Params" then let _getpack _checkpack paramsFile -> params in 
                                  _DMSsend this DMSsender CmodifyParams [params]
  else if !strcmp action "kGame" then _KillGame nil (_game_by_name name)
  else if !strcmp action "kPlayer" then _KillClient (_DMSbyLogin name) 
  else nil );;
  
fun __SetParams(params)= 
if !(_IsAdmin DMSsender) then nil else
( _storepack (strcatn dmiHead::"\nParameters\n"::params::nil) paramsFile;
  if (_LoadParameters) 
  then DDmes "Error on parameters" 
  else DDmes "Params OK" );;

/* -------------DMS interface----------------
 */

/* Called each time when an action port is activated 
 */
fun activate(from,cli,action,param,rep)= 
 if !strcmp action "start" then nil
 else if !strcmp action "register" then _NewClient cli ""
 else if !strcmp action "regadmin" then _NewClient cli "administrateur"
 else if !strcmp action "unregister" then _KillClient cli  
 else if !strcmp action "destroy" then _KillClient cli 
 else if !strcmp action "!changeLogin" then 
   let _GetGameOfCli games.GASgames cli -> g in
    _UpdatePlayerList cli g.GAname
 else nil;;

/* Called when a client is leaving the site 
 */
fun clilogout(cli)=_KillClient cli;0;;

/* Called when the client module is destroyed
 */
fun clidelete(cli)= _KillClient cli;;

/* Main function which initializes the module and 
 * defines the callback functions.
 */ 
fun IniDMI(param)= 
/* _showconsole;*/
 _DMSregisterDMI this @activate @clilogout @clidelete nil;
 /* ---- */
 set paramsFile=param;
 _LoadParameters;
 _IniGames; 
0;;