/* Chess Server - DMS - feb 98 - by Sylvain HUET */

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

defcom CopenGame=openGame I S I;;
defcom Chear=hear I S;;
defcom Cpos=pos I S;;
defcom Cupdate=update I;;
defcom CopponentId=opponentId I I;;

var inigame="BCDEFDCBAAAAAAAA                                aaaaaaaabcdefdcb                                ";;
struct Game=[p1Game:CLIENT,p2Game:CLIENT,showGame:[CLIENT r1],posGame: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 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 "CHESS_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 "CHESS_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 games=
  let mktab nbgames nil -> t in
  (let 0->i in while i<nbgames do
   (set t.i=mkGame [nil nil nil strdup inigame];
    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 posout(p,j,i)=
 if i==96 then nil
 else if (nth_char p i)==32 then
  set_nth_char p i j
 else posout p j i+1;;

fun boardcase(i)= strcat ctoa (mod i 8)+'a ctoa (i/8)+'1;;

fun __move(n,i,j)=
 if n<0 || n>=nbgames || i<0 || i>=96 || j<0 || j>=96 then nil
 else let games.n -> g in
  if g.p1Game!=DMSsender && g.p2Game!=DMSsender then nil
  else let g.posGame -> p in
  if (nth_char p i)==32 then nil
  else
  (if (nth_char p j)==32 then nil
   else posout p nth_char p j 64;
   set_nth_char p j nth_char p i;
   set_nth_char p i 32;
   apply_on_list g.showGame @broad Cpos [n p];
   if i>=64 || j>=64 then nil 
   else  apply_on_list g.showGame @broad
    Chear [n strcatn ">"::(_DMSgetLogin DMSsender)::" : "::
    (boardcase i)::"-"::(boardcase j)::"\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 "CHESS_HASRESET" nil)::nil]);;

/* 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 "CHESS_ISTHERE" nil)::nil];;

fun __register()=
 if findList chaters DMSsender then nil
 else
 (apply_on_list chaters @broad
   Chear0 [strcatn ">"::(_DMSgetLogin DMSsender)::" "::(_loc this "CHESS_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 "CHESS_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 "CHESS_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 "CHESS_PLAY" nil)::nil]);
  _DMSsend this DMSsender CopenGame [n g.posGame type];
  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
  );;