/* Goban Server - DMS - Mar 98 - by Sylvain HUET */

defcom Chear0=hear0 S;;
defcom Cgames=games S;;

defcom CopenGame=openGame I S I S S;;
defcom Chear=hear I S;;
defcom Cpos=pos I S;;
defcom Cmove=move I I I;;
defcom Cwhite=white I S;;
defcom Cblack=black I S;;
defcom Cupdate=update I;;
defcom CopponentId=opponentId I I;;

typeof inigame=S;;
struct Game=[p1Game:CLIENT,p2Game:CLIENT,showGame:[CLIENT r1],posGame:S,
  whiteGame:S,blackGame:S]mkGame;;

var nbgames=16;;
typeof games=tab Game;;

typeof chaters=[CLIENT r1];;

fun chatbylogin(a,b)=!strcmp a.loginCLI b;;

fun broad(x,s)=_DMSsend this x s;;
fun broads(x,s)=if x==DMSsender then nil else _DMSsend this x s;;

fun mklistgames(i)=
 if i==nbgames then nil
 else let games.i -> g in
  ((let g.p1Game -> x in if x==nil then "..." else _DMSgetLogin x)::
   (let g.p2Game -> x in if x==nil then "..." else _DMSgetLogin x)::nil)::
    mklistgames i+1;;

/* game part */

fun removegame(i,d)=
 let games.i -> g in
 (if !findList g.showGame d then nil
  else
  (set g.showGame=remove_from_list g.showGame d;
   apply_on_list g.showGame @broad
    Chear [i strcatn ">"::(_DMSgetLogin d)::" "::(_loc this "GOB_LEAVE" nil)::nil]);
  if g.p1Game==d then
   (set g.p1Game=nil;
    apply_on_list chaters @broad Cgames [strbuild mklistgames 0];
    apply_on_list g.showGame @broad Cupdate [i])
  else if g.p2Game==d then
   (set g.p2Game=nil;
    apply_on_list chaters @broad Cgames [strbuild mklistgames 0];
    apply_on_list g.showGame @broad Cupdate [i])
  else nil
 );;

fun logout(cli)=
 if !findList chaters cli then nil
 else
 (set chaters=remove_from_list chaters cli;
  apply_on_list chaters @broad
   Chear0 [strcatn ">"::(_DMSgetLogin cli)::" "::(_loc this "GOB_LEAVE" nil)::nil];
  let 0-> i in while i<nbgames do
   (removegame i cli;
    set i=i+1)
 )
;;

fun activate(from,cli,action,param,rep)=
 if !strcmp action "start" then
  _DMScreateClientDMI this cli nil
 else if !strcmp action "destroy" then
  (_DMSdelClientDMI this cli;
   logout cli)
 else nil;;

fun IniDMI(param)=
 _DMSregisterDMI this @activate nil @logout nil;
 set inigame=listtostr tabtolist mktab 19*19 32;
 set games=
  let mktab nbgames nil -> t in
  (let 0->i in while i<nbgames do
   (set t.i=mkGame [nil nil nil strdup inigame "0" "0"];
    set i=i+1);
   t);;

fun __quit(n)=
 if n<0 || n>=nbgames then nil
 else removegame n DMSsender;;

fun __speak(n,s)=
 if n<0 || n>=nbgames then nil
 else if s==nil || 0==strlen s then nil
 else let games.n -> g in
  if !findList g.showGame DMSsender then nil
  else
   apply_on_list g.showGame @broad
    Chear [n strcatn "<"::(_DMSgetLogin DMSsender)::"> "::s::"\n"::nil];;


fun boardcase(i)= strcat ctoa (mod i 19)+'A ctoa (i/19)+'a;;

fun __move(n,i,k)=
 if n<0 || n>=nbgames || i<0 || i>=19*19 then nil
 else if k!=32 && k!='b && k!='w then nil
 else let games.n -> g in
  if g.p1Game!=DMSsender && g.p2Game!=DMSsender then nil
  else let g.posGame -> p in
  (set_nth_char p i k;
   apply_on_list g.showGame @broad Cmove [n i k];
   apply_on_list g.showGame @broad
    Chear [n strcatn ">"::(_DMSgetLogin DMSsender)::" : "::
    (boardcase i)::" - "::(if k==32 then (_loc this "GOB_EMPTY" nil) else if k=='b then (_loc this "GOB_WHITE" nil)
     else (_loc this "GOB_BLACK" nil))::"\n"::nil]);;

fun __reset(n)=
 if n<0 || n>=nbgames then nil
 else let games.n -> g in
 if g.p1Game!=DMSsender && g.p2Game!=DMSsender then nil
 else
 (set g.posGame=strdup inigame;
  apply_on_list g.showGame @broad Cpos [n g.posGame];
  apply_on_list g.showGame @broad
    Chear [n strcatn ">"::(_DMSgetLogin DMSsender)::" "::(_loc this "GOB_HASRESET" nil)::nil]);;

fun __white(n,i)=
 if n<0 || n>=nbgames then nil
 else let games.n -> g in
 if g.p1Game!=DMSsender && g.p2Game!=DMSsender then nil
 else if !strcmp g.whiteGame i then nil else
 (set g.whiteGame=i;
  apply_on_list g.showGame @broads Cwhite [n i]);;
fun __black(n,i)=
 if n<0 || n>=nbgames then nil
 else let games.n -> g in
 if g.p1Game!=DMSsender && g.p2Game!=DMSsender then nil
 else if !strcmp g.blackGame i then nil else
 (set g.blackGame=i;
  apply_on_list g.showGame @broads Cblack [n i]);;

/* selection part */
fun __speak0(s)=
 if s==nil || 0==strlen s then nil
 else apply_on_list chaters @broad
  Chear0 [strcatn "<"::(_DMSgetLogin DMSsender)::"> "::s::"\n"::nil];;

fun who0(x,s)=
 _DMSsend this s
  Chear0 [strcatn ">"::(_DMSgetLogin x)::" "::(_loc this "GOB_ISTHERE" nil)::nil];;

fun __register()=
 if findList chaters DMSsender then nil
 else
 (apply_on_list chaters @broad
   Chear0 [strcatn ">"::(_DMSgetLogin DMSsender)::" "::(_loc this "GOB_ISCOM" nil)::nil];
  _DMSsend this DMSsender Cgames [strbuild mklistgames 0];
  apply_on_list chaters @who0 DMSsender;
  set chaters=DMSsender::chaters;
  _DMSevent this DMSsender "entering" nil nil);;


fun who(x,i)=
 _DMSsend this DMSsender
  Chear [i strcatn ">"::(_DMSgetLogin x)::" "::(_loc this "GOB_ISTHERE" nil)::nil];;

fun __play(n,type)=
 if n<0 || n>=nbgames then nil
 else if !findList chaters DMSsender then nil
 else let games.n -> g in
 if findList g.showGame DMSsender then nil
 else if g.p1Game!=nil && type==0 then nil
 else if g.p2Game!=nil && type==1 then nil
 else
 (if type==0 then set g.p1Game=DMSsender
  else if type==1 then set g.p2Game=DMSsender
  else nil;
  set g.showGame=DMSsender::g.showGame;
  if type!=0 && type!=1 then
   apply_on_list g.showGame @broad
    Chear [n strcatn ">"::(_DMSgetLogin DMSsender)::" "::(_loc this "GOB_WATCH" nil)::nil]
  else
  (apply_on_list chaters @broad Cgames [strbuild mklistgames 0];
   apply_on_list g.showGame @broad Cupdate [n];
   if g.p1Game==nil || g.p2Game==nil then nil
   else
    (_DMSsend this g.p2Game CopponentId [n _DMSgetId g.p1Game];
     _DMSsend this g.p1Game CopponentId [n _DMSgetId g.p2Game]);
   apply_on_list g.showGame @broad
    Chear [n strcatn ">"::(_DMSgetLogin DMSsender)::" "::(_loc this "GOB_PLAY" nil)::nil]);
  _DMSsend this DMSsender CopenGame [n g.posGame type g.whiteGame g.blackGame];
  apply_on_list g.showGame @who n;
  if (type==0 || type==1)&& g.p1Game!=nil && g.p2Game!=nil then
   (_DMSsend this g.p2Game CopponentId [n _DMSgetId g.p1Game];
    _DMSsend this g.p1Game CopponentId [n _DMSgetId g.p2Game])
  else nil
  );;