goclient.pli

net plug source code

# Go Game server plugin for					-*- tcl -*-
# NetPlug general network client in Tcl/Tk
# http://www.lyot.obspm.fr/~dl/netplug.html 
#
# Copyright 1996
# by Laurent Demailly - [e-mail] - http://hplyot.obspm.fr/~dl/
#
# This is an ALPHA version,
# you must NOT give it away without permission from the author.
#
# $Id: goclient.pli,v 3.3 1996/09/23 17:16:10 dl Exp $
#
# $Log: goclient.pli,v $
# Revision 3.3  1996/09/23 17:16:10  dl
# bug fix (strange) an unused $w was bugging the binds...
#
# Revision 3.2  1996/08/20 14:26:22  dl
# shift-click aware. using title new arg of netplug's Connect proc
#
# Revision 3.1  1996/08/06  15:04:03  dl
# addText with $w -> defOut without (new netplug interface)
#
# Revision 2.3  1996/08/04  23:38:34  dl
# fixed unterminated messages handling
#
# Revision 2.2  1996/08/03 12:25:29  dl
# adapted to errflag == 2 when the window is closed
#
# Revision 2.1  1996/07/30  15:44:38  dl
# addTxt->addText with registered (gocli_regTags) tags
#
# Revision 1.12  1996/07/22  11:53:50  dl
# added url
#
# Revision 1.11  1996/07/19  17:36:19  dl
# new socket arg to connect
#
# Revision 1.10  1996/07/19  09:24:46  dl
# adapted to new errflag parameter
#
# Revision 1.9  1996/07/04  19:42:13  dl
# more numerics recognized. still some status to fix...
#
# Revision 1.8  1996/07/03  13:34:15  dl
# more retcode parsed. new highlighting of last stone played.
#
# Revision 1.7  1996/07/01  10:04:32  dl
# improved logic/parsing. not yet 100% fine in multi observing...
#
# Revision 1.6  1996/06/30 22:43:33  dl
# status/color fix
#
# Revision 1.5  1996/06/30 21:53:16  dl
# resize definitive (!) fix.  fix for wrong scale/size use
#
# Revision 1.4  1996/06/30 14:06:34  dl
# resize now works fine even for coords
#
# Revision 1.3  1996/06/30 13:12:53  dl
# some fix in the playing. New: goban is now fully resizable at any time
#
# Revision 1.2  1996/06/28 21:28:37  dl
# first 'playable' version... somehow ;)
#
# Revision 1.1  1996/06/26  12:02:15  dl
# Initial revision
#
#

# keyword
regexp {[.0-9]+} {$Revision: 3.3 $} gocli(version)
set gocli(date) [string trim {$Date: 1996/09/23 17:16:10 $} " \$"]
set gocli(load) [clock format [clock seconds]]

global gocli;
if {![info exist gocli(first)]} {set gocli(first) 1} 

proc GoCliInit {onoff} {
  global env host port gocli netmod;
  if {$onoff} {
    if {$gocli(first)} {
      set gocli(first) 0;
      if {[cequal "" $host]} {
	set host nngs.cosmic.org
      }
      set gocli(host) $host;
      if {[cequal "" $port]} {
	set port 9696
      }
      set gocli(port) $port;
      set gocli(name) "guest";
      set gocli(passwd) "";
    } else {
      set host $gocli(host);
      set port $gocli(port);
    }
    if {!$netmod} GoCliConfigEdit;
    ChangeNewConnectCmd "GoCliConnect \$host \$port";
  } else {
    # restore standard command
    ChangeNewConnectCmd ;
  }
}

proc GoCliConfigEdit {} {
  set w .gocliconf;
  catch {destroy $w}
  toplevel $w;
  wm title $w "Go game client...";
  label $w.l1 -text "Name";
  entry $w.e1 -textvariable gocli(name) -width 9;
  label $w.l2 -text "Password";
  entry $w.e2 -textvariable gocli(passwd) -width 9 -show *;
  grid configure  $w.l1  $w.e1 -sticky w -padx 1m -pady 1m;
  grid configure  $w.l2  $w.e2 -sticky w -padx 1m -pady 1m;
  button $w.bok -text "Ok/Dismiss" -command "destroy $w";
  button $w.bsv -text "Save" -command gocli_save;
  grid configure  $w.bok $w.bsv -sticky we -padx 2m -pady 3m
  bind $w <Return> "$w.bok invoke"
}

proc GoCliConnect {host port} {
  global gocli env conn;
  set n [Connect $host $port "" GoCliParse GoCliUserInput "Go C"];
  if {$n!=-1} {
    set gocli(host) $host;
    set gocli(port) $port;
    set gocli($n,nfm) "";
    set gocli($n,name) $gocli(name);
    set gocli($n,passwd) $gocli(passwd);
    set gocli($n,state) login;
    set gocli($n,srv) "not logged";
    set gocli($n,task) "";

    gocli_regTags $n;

    set w $conn($n,frame);

    frame $w.status;

    label $w.status.state -textvariable gocli($n,state);
    label $w.status.srv -textvariable gocli($n,srv);
    pack $w.status.state $w.status.srv -padx 1m \
      -side left -pady 0 -ipady 0;
    pack $w.status -after $conn($n,entry) -fill x \
      -pady 0 -ipady 0 -side bottom;
  }
}

proc gocli_regTags {n} {
  global gocli conn;
  set w $conn($n,txt);
  foreach tagname [array names gocli "attrib,*"] {
    regTag $w [string range $tagname 7 end] $gocli($tagname);
  }
}

proc gocli_load {{fname ""}} {
  if {![string compare "" $fname]} {global dotdir;set fname "$dotdir/gorc"}
  uplevel #0 "source $fname"
  return $fname;
}

#default attributes, customize in your rc file
array set gocli {
  attrib,normal ""
  attrib,error  "-foreground red"
  attrib,unknown "-foreground orange -background grey"
  attrib,message "-spacing1 2 -spacing3 2"
  attrib,login   "-foreground blue3"
  attrib,file    "-foreground green4"
  attrib,private "-spacing1 2 -spacing3 2 -relief groove -borderwidth 2"
  attrib,info    "-background white"
  attrib,play    "-background pink"
}

# load stuff (eventually)
if {[catch gocli_load err]} {
  puts stderr "GoCli: error loading optional config file : $err";
}

proc gocli_save {{fname ""}} {
  global gocli;
  if {![string compare "" $fname]} {global dotdir;set fname "$dotdir/gorc"}
  set f [open $fname w];
  foreach v {first name passwd host port} {
    puts $f "set gocli($v) [list $gocli($v)]";
  }
  foreach v [lsort [array names gocli "attrib,*"]] {
    puts $f "set gocli($v) [list $gocli($v)]";
  }
  close $f;
  puts "save in $fname";
  return $fname;
}

proc go_send {n what} {
  global gocli;
  set gocli($n,srv) "waiting...";
  update idletasks;
  Send $n "$what\n";
}

proc go_query_status {n gid} {
  global gocli;
  set gocli($n,board,gid) $gid;
  go_send $n "status $gid";
}

proc GoCliUserInput {n str} {
puts "called input '$str'";
  global gocli;
  defOut $n 0 "$str\n";
  if {[regexp -nocase {^status +([0-9]+)} $str all gid]} {
    catch {unset gocli($n,last,color)};
    go_query_status $n $gid;
#  X elseif {[regexp -nocase {^done$} $str]} X
#    catch {unset gocli($n,last,color)};
#    go_query_status $n $gid;
  } else {
    go_send $n $str;
  }
}

proc GoCliParse {n errflag str} {
  global gocli;
  puts "gocli parsing ($errflag) '$str'...";
  set doitnow $gocli($n,nfm);
  if {$errflag} {
    if {(![cequal "" $doitnow]) && ($errflag!=2)} {gocli_parse $n $doitnow}
    defOut $n $errflag $str;
    return;
  }
  regsub -all "\[\r\377\374\373\01\]" $str {} str;
  set lastlf [string last "\n" $str]
  if {$lastlf==-1} {
    set nfm [append gocli($n,nfm) $str];
  } else {
    set nfm [set gocli($n,nfm) [string range $str [expr $lastlf+1] end]];
    append doitnow [string range $str 0 [expr $lastlf-1]]
    foreach message [split $doitnow "\n"] {
       gocli_parse $n $message;
    }
  }
# special login handling
  set state $gocli($n,state);
  if {![cequal $state normal]} {
    if {[cequal $state login] && [cequal "Login: " $nfm]} {
      defOut $n 0 "$nfm$gocli($n,name)\n";
      go_send $n "$gocli($n,name)";
      set gocli($n,state) passwd;
      set gocli($n,nfm) "";
    } elseif {[cequal $state passwd] && [cequal "Password: " $nfm]} {
      defOut $n 0 "Password: <<<-not shown->>>";
      go_send $n "$gocli($n,passwd)";
      set gocli($n,state) confirm;
      set gocli($n,nfm) "";
    } elseif { ( [cequal $state confirm] || [cequal $state passwd] ) \
		&& [string match "*#>*" $nfm]} {
      defOut $n 0 "${nfm}toggle client 1\n";
      go_send $n "toggle client 1";
      set gocli($n,state) confirm;
      set gocli($n,nfm) "";
    }
  } 
}

proc gocli_parse {n str} {
  global gocli;
puts "state $n : $gocli($n,state), str=($str)";
  switch $gocli($n,state) {
    passwd {
      if {[cequal $str "1 1"]} {
	go_send $n "$gocli($n,passwd)";
	set gocli($n,state) confirm;
	defOut $n 0 "<<<-sent password->>>\n"
      } else {
	defOut $n 0 "X $str\n";
      }
    }
    confirm {
      if {[string match {[19] *} $str]} {
	set gocli($n,state) normal;
	return [gocli_parse $n $str];
      } else {
	defOut $n 0 "x $str\n";
      }
    }
    file {
      if {[string match "* File" $str]} {
	set gocli($n,state) normal
      } else {
	defOut $n 0 "$str\n" file;
      }
    }
    drawing {
      if {[regexp {^22 +([0-9]+): ([0-9]+)$} $str all line what]} {
	set gocli($n,board,[format %02d $line]) $what;