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

var bitmapfile="Dms/Games/Chess/chess.bmp";;
defcom Cregister=register;;
defcom Cspeak0=speak0 S;;
defcom Cplay=play I I;;

defcom Cspeak=speak I S;;
defcom Cmove=move I I I;;
defcom Cquit=quit I;;
defcom Creset=reset I;;

typeof bitmap=ObjBitmap;;
typeof win=ObjWin;;
typeof banner=ObjText;;
typeof text=ObjText;;
typeof cmd=ObjText;;
typeof list=ObjList;;
typeof title=S;;
typeof games=[[S r1] r1];;


struct Game=[numGame:I,posGame:S,typeGame:I,opponentIdGame:I,reverseGame:I,
 winGame:ObjWin,bannerGame:ObjText,textGame:ObjText,
 editGame:ObjText,boardGame:ObjBitmap,indexGame:I] mkGame;;
var nbgames=16;;
typeof boards=tab Game;;

fun _boardmessage (g,mess)=
 let g.textGame -> text in
{
  _ADDtext text mess ;
  let ( _GETlineCount text ) -> size in 
  {
    while ( size > 60 ) do
    {
      _DELline text 0 ;
      set size = size - 1 
    } ;
    _SCROLLtext text 0 size
  };
 mess
};;


fun _resets(x,g,r)=
 if r then
 (_DMSsend this Creset [g.numGame];
  _boardmessage g (_loc this "CHESS_SEND" nil))
 else nil;;

fun _reset(a,g)=
 _DLGrflmessage _DLGMessageBox _channel g.winGame (_loc this "CHESS_RESET" nil)
 (_loc this "CHESS_RESETDOYOU" nil) 2 @_resets g
;;

fun drawboard(g,b,p)=
 _FILLbitmap b 0;
 let 0-> i in while i<64 do
 (let nth_char p if g.reverseGame then 63-i else i -> s in
   let if s==32 then 0
       else if s<'a then s+1-'A
       else s+7-'a -> x in
   let ((i>>3)+(mod i 8))&1 -> y in
   _CPbitmap16 b (mod i 8)*32 (7-i/8)*32 bitmap x*32 y*32 32 32 nil;
   set i=i+1);
 let 64-> i in while i<96 do
 (let nth_char p i -> s in
   let if s==32 then 0
       else if s<'a then s+1-'A
       else s+7-'a -> x in
   _CPbitmap16 b (mod i 8)*32 (i/8)*32 bitmap x*32 0 32 32 nil;
   set i=i+1);
  0;;

fun posbyxy(g,x,y)=
 let [(x-10)/32 (y-40)/32] -> [i j] in
 if i<0 || i>=8 || j<0 || j>=12 then nil
 else if j<8 then if g.reverseGame then 63-i-(7-j)*8 else i+(7-j)*8
 else i+8*j;;

fun _clickG(a,g,x,y,b)=
 if b!=1 then nil
 else let posbyxy g x y -> j in
 if (nth_char g.posGame j)==32 then nil
 else set g.indexGame=j;;

fun _unclickG(a,g,x,y,b)=
 if b!=1 then nil
 else if g.indexGame==nil then nil
 else let posbyxy g x y -> j in
 if j==g.indexGame || j==nil then nil
 else
  (_DMSsend this Cmove [g.numGame g.indexGame j];
   _boardmessage g (_loc this "CHESS_MOVE" nil));
 set g.indexGame=nil;;

fun _cursorG(a,g,x,y,b)=
 let posbyxy g x y -> j in
 if j==nil || (nth_char g.posGame j)==32 then _SETwinCursor g.winGame StdCursor
 else _SETwinCursor g.winGame CrossCursor;;

fun _textG(x,g)=
 if (_GETlineCount g.editGame) >= 2 then 
  let _GETline g.editGame 0 -> ligne in 
    (_DMSsend this Cspeak [g.numGame ligne];
     _DELline g.editGame 0)
 else nil;;

fun _destroyG(a,g)=
 set boards.(g.numGame)=nil;
 _DMSsend this Cquit [g.numGame];
 _DSbitmap g.boardGame;;

fun _paintG(a,g)= _BLTbitmap g.winGame g.boardGame 10 40;;

defcom SmainCom=main S;;
defcom S_load=_load S;;

fun _contacto(a,g)=
 if g.opponentIdGame==nil then nil
 else _DMSevent this "select" itoa g.opponentIdGame nil;;

fun _reverse(a,g)=
 set g.reverseGame=1-g.reverseGame;
 drawboard g g.boardGame g.posGame;
 _paintG nil g;;

fun __openGame(n,pos,type)=
 let mkGame [n pos type nil if type==1 then 1 else 0 nil nil nil nil nil nil] -> g in
 let nth_list games n -> l in
 let strcatn (_loc this "CHESS_GAME" nil)::" "::(itoa n+1)::" : "::(hd l)::" / "::(hd tl l)::nil -> banner in
 let _CRwindow _channel win nil nil 486 434 WN_MENU+WN_MINBOX banner -> win in
 (_CBwinDestroy win @_destroyG g;
  _CBwinPaint win @_paintG g;
  set g.bannerGame=_CRtext _channel win 10 10 256 20 ET_DOWN banner;
  set g.winGame=win;
  set g.textGame=_CRtext _channel win 276 10 200 360 ET_VSCROLL|ET_AVSCROLL|ET_DOWN "";
  set g.editGame=_CReditText _channel win 276 374 200 20 ET_AHSCROLL|ET_AVSCROLL|ET_DOWN "";
  _CBtext g.editGame @_textG g;
  _CBbutton (_CRbutton _channel win 276 404 60 20 0 (_loc this "CHESS_REVERSE" nil)) @_reverse g;
  if type==0 || type==1 then
   (_CBbutton (_CRbutton _channel win 336 404 40 20 0 (_loc this "CHESS_RESET" nil)) @_reset g;
    _CBbutton (_CRbutton _channel win 376 404 100 20 0 (_loc this "CHESS_CONTACT" nil)) @_contacto g;
    _CBwinClick win @_clickG g;
    _CBwinUnclick win @_unclickG g;
    _CBcursorMove win @_cursorG g)
  else nil;
  set g.boardGame=_CRbitmap _channel 256 384;
  drawboard g g.boardGame pos;
  _paintG nil g;
  set boards.n=g
 );
 0;;

fun __hear(i,s)=
 if i<0 || i>=nbgames then nil
 else let boards.i -> b in
 if b==nil then nil
 else _boardmessage b s;;

fun __update(i)=
 if i<0 || i>=nbgames then nil
 else let boards.i -> b in
 if b==nil then nil
 else let nth_list games i -> l in 
 let strcatn (_loc this "CHESS_GAME" nil)::" "::(itoa i+1)::" : "::(hd l)::" / "::(hd tl l)::nil -> txt in
 (_SETwindowName b.winGame txt;
  _SETtext b.bannerGame txt);; 

fun __pos(i,p)=
 if i<0 || i>=nbgames then nil
 else let boards.i -> b in
 if b==nil then nil
 else
 (set b.posGame=p;
  drawboard b b.boardGame p;
  _paintG nil b);;

fun __opponentId(i,id)=
 if i<0 || i>=nbgames then nil
 else let boards.i -> b in
 if b==nil then nil
 else set b.opponentIdGame=id;;

fun _select(a,b)=
 let b->[win game i] in
 (_DSwindow win;
  _DMSsend this Cplay [game i]);;

fun choicewindow(i,l)=
 let _CRwindow _channel win 200 120 320 130 WN_MENU+WN_MINBOX (_loc this "CHESS_SEL" nil) -> win in
 (_CRtext _channel win 10 10 300 20 ET_DOWN
   strcatn (_loc this "CHESS_GAME" nil)::" "::(itoa i+1)::" : "::(hd l)::" / "::(hd tl l)::nil;
  if strcmp hd l "..." then nil
  else _CBbutton (_CRbutton _channel win 20 40 280 20 0 (_loc this "CHESS_PWHITES" nil)) @_select [win i 0];
  if strcmp hd tl l "..." then nil
  else _CBbutton (_CRbutton _channel win 20 70 280 20 0 (_loc this "CHESS_PBLACKS" nil)) @_select [win i 1];
  _CBbutton (_CRbutton _channel win 20 100 280 20 0 (_loc this "CHESS_JUST" nil)) @_select [win i 2]
 );
 0;;


fun _contact(a,b,n,txt)=
  choicewindow n nth_list games n;;
 
fun _message (mess)=
 _ADDtext text mess ;
 let ( _GETlineCount text ) -> size in 
 {
   while ( size > 60 ) do
   {
     _DELline text 0 ;
     set size = size - 1 
   } ;
   _SCROLLtext text 0 size
 };
 mess
;;

fun _textE(x,y)=
 if (_GETlineCount cmd) >= 2 then 
  let _GETline cmd 0 -> ligne in 
    (_DMSsend this Cspeak0 [ligne];
     _DELline cmd 0)
 else nil;;

fun _destroyE(a,b)=
 _DMSdelete this;;

fun _end(b)=
 _DMSdelete this;;

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

fun _resizeE(a,b,w,h)=
 if (h<70)||(w<20) then nil else
 (_SIZEtext banner w-10 20 5 5;
  _SIZElist list w-10 (h-65)*100/250 5 30;
  _SIZEtext text w-10 (h-65)*150/250 5 30+(h-65)*105/250;
  _SIZEtext cmd w-10 20 5 h-25);;

fun createwin(w,h)=
 set banner=_CRtext _channel win 5 5 w-10 20 ET_BORDER+ET_AHSCROLL
  strcat title strcat " " (_loc this "CHESS_SEL2" nil);
 set list=_CRlist _channel win 5 30 w-10 (h-65)*100/250 LB_DOWN+LB_VSCROLL;
 _CBlistDclick list @_contact 0;

 set text=_CRtext _channel win 5 (h-65)*135/250 w-10 (h-65)*150/250 ET_VSCROLL|ET_AVSCROLL|ET_DOWN "";
 set cmd=_CReditText _channel win 5 h-25 w-10 20 ET_AHSCROLL|ET_AVSCROLL|ET_DOWN (_loc this "CHESS_HELLO" nil);
 _CBtext cmd @_textE 0;;

fun IniDMI(param)=
 set title=_DMSgetName this;
 set boards=mktab nbgames nil;
 set bitmap=_LDbitmap _channel _checkpack bitmapfile;
 let _DMSgetZone this (_loc this "CHESS_BOARDS" nil) @_end @_resize @_end ->[wn x y w h] in
 if wn==nil then
 (set win=_CRwindow _channel DMSwin nil nil 280 315 WN_MENU+WN_MINBOX+WN_SIZEBOX title;
  _CBwinDestroy win @_destroyE 0;
  createwin 280 315)
 else
 (set win=_CRwindow _channel wn x y w h WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER title;
  createwin w h);
 _CBwinSize win @_resizeE 0;
 _DMSsend this Cregister [];
0;;

fun displgame(l,i)=
 if l==nil then 0
 else let l->[a n] in
  (_ADDlist list 100 strcatn (itoa i)::"-"::(hd a)::"/"::(hd tl a)::nil;
   displgame n i+1);;

fun __games(s)=
 _RSTlist list;
 set games=strextr s;
 displgame games 1;;

fun __hear0(s)=
 _message s;;