proc version {} {
    return 0.31
}
proc boardParse { boardLine state } {
    global boardList db brd board
    switch $state {
	"all" {
	    set boardList [ split $boardLine : ]
	    parseGameInfo
	    parseBoard
	    paintBoard
	}
	"nomove" {
	    set boardList [ split $boardLine : ]
	    parseBoard
	}
	"move" {
	    set boardList [ split $boardLine : ]
	    parseBoard
	}
	"double" {
	    set boardList [ split $boardLine : ]
	    parseDouble
	}
	"undo" {
	    parseUndo
	}
	"none" {
	}
    }
}

proc parseGameInfo {} {
    global boardList db brd board
    set brd(pname) [ lindex $boardList 0 ]
    set brd(oname) [ lindex $boardList 1 ]
    set brd(totpnts) [ lindex $boardList 2 ]
    set brd(ppnts) [ lindex $boardList 3 ]
    set brd(opnts) [ lindex $boardList 4 ]
    set brd(cube) [ lindex $boardList 36 ]
    set brd(pmaydbl) [ lindex $boardList 37 ]
    set brd(omaydbl) [ lindex $boardList 38 ]
    set brd(color) [ lindex $boardList 40 ]
    set brd(dir) [ lindex $boardList 41 ]
    set brd(home) [ lindex $boardList 42 ]
    set brd(bar) [ lindex $boardList 43 ]
    set brd(forced) [ lindex $boardList 49 ]
    set brd(crawf) [ lindex $boardList 50 ]
    set brd(rdbls) [ lindex $boardList 51 ]
    setDouble $brd(cube)
}

proc parseBoard {} {
    global boardList db brd board
    set brd(board) [ lrange $boardList 5 30 ]
    set brd(turn) [ lindex $boardList 31 ]
    set brd(pdie1) [ lindex $boardList 32 ]
    set brd(pdie2) [ lindex $boardList 33 ]
    set brd(odie1) [ lindex $boardList 34 ]
    set brd(odie2) [ lindex $boardList 35 ]
    set brd(wasdbld) [ lindex $boardList 39 ]
    set brd(poff) [ lindex $boardList 44 ]
    set brd(ooff) [ lindex $boardList 45 ]
    set brd(pbar) [ lindex $boardList 46 ]
    set brd(obar) [ lindex $boardList 47 ]
    set brd(canmove) [ lindex $boardList 48 ]
    ooffSet $brd(ooff)
    poffSet $brd(poff)
    dice
    active $brd(turn) $brd(color)
    setMovesLeft
}

proc paintBoard {} {
    global boardList db brd board
    eval $board delete [ $board find withtag numbers ]
    for { set i 1 } { $i <= 24 } { incr i } {
	set coords [ $board coords point$i ]
	$board create text \
	    [ expr "([ lindex $coords 0 ] + [ lindex $coords 2 ])/2" ] \
	    [ expr "[ lindex $coords 1 ] [ if { $i < 13 } then { list + } else { list - } ] [ expr $db(VI)/2 ]" ] \
	    -anchor center \
	    -fill black \
	    -tags numbers \
	    -text [ if { $brd(color) == 1 } then { expr $i } else { expr 25-$i } ]
    }
    uplevel #0 {
	$youName configure -text $brd(pname)
	$oppName configure -text $brd(oname)
	$matchLength configure -text $brd(totpnts)
	$youGot configure -text $brd(ppnts)
	$oppGot configure -text $brd(opnts)
	ooffSet $brd(ooff)
	poffSet $brd(poff)
	setDouble $brd(cube)
	# dice
	if [ lindex $boardList 40 ]==1 {
	    $youChar configure -text O
	    $oppChar configure -text X
	} else {
	    $youChar configure -text X
	    $oppChar configure -text O
	}
	active $brd(turn) $brd(color)
    }
    for { 
	set i 25 ; set j $brd(bar) 
    } { 
	$i >= 0 
    } { 
	incr i -1 ; incr j $brd(dir) 
    } {
	set brd($i) [ lindex $brd(board) $j ]
	placeMen $i $brd($i)
    }
}

proc parseDouble {} {
    global boardList db brd board
    set boardList [ split $boardLine : ]
    set brd(cube) [ lindex $boardList 36 ]
    set brd(pmaydbl) [ lindex $boardList 37 ]
    set brd(omaydbl) [ lindex $boardList 38 ]
    set brd(wasdbld) [ lindex $boardList 39 ]
    set brd(canmove) [ lindex $boardList 48 ]
    uplevel #0 {
	setDouble $brd(cube)
	active $brd(turn) $brd(color)
    }
}

proc parseUndo {} {
    global boardList db brd board undoList 
    set brd(poff) [ lindex $boardList 44 ]
    set brd(ooff) [ lindex $boardList 45 ]
    set brd(pbar) [ lindex $boardList 46 ]
    set brd(obar) [ lindex $boardList 47 ]
    ooffSet $brd(ooff)
    poffSet $brd(poff)
    if $brd(color)==1 {
	foreach i $undoList {
	    placeMen $i [ set brd($i) [ lindex $brd(board) $i ] ]
	} 
    } else {
	foreach i $undoList {
	    placeMen $i [ set brd($i) [ lindex $brd(board) [ expr 25-$i ] ] ]
	}
    }
    setMovesLeft
}

proc setMovesLeft {} {
    global boardList db brd board undoList
    set undoList {}
    switch [ set db(movesLeft) $brd(canmove) ] {
	0 - 1 - 2 {
	    set db(movesLeftLeft)  [ expr "( $db(movesLeft) + 1 ) / 2" ]
	    set db(movesLeftRight) [ expr "( $db(movesLeft) + 1 ) / 2" ]
	}
	3 - 4 {
	    set db(movesLeftLeft) $db(movesLeft)
	    set db(mvoesLeftRight) $db(movesLeft)
	}
    }
}
proc lineSend {} {
    uplevel #0 {
	if $db(movesLeft)==0 {
	    exp_send "[ $line get ]\n"
	    $line delete 0 end
	    set parseState move
	} else {
	    popup "You must give $brd(canmove) moves."
	}
    }
}

proc undo {} {
    uplevel #0 {
	$line delete 0 end
	boardParse $boardList undo
    }
}

proc addChars string {
    global line
    $line icursor end
    $line insert insert $string
}
proc connectLoop {} {
    uplevel #0 {
	# Set this value to false in the menu.

	set continueToPlay 1

	# A toggle variable to trig the tkwait command below.

	set connectionFlag 0

	# At the beginning we are not connected.

	set connected 0

	login
	run

	while { $continueToPlay } {
	    tkwait variable connectionFlag
	    if $continueToPlay {
		connect
		login
		run
	    } else {
		break
	    }
	}
    }
}
proc communication {} {
    uplevel #0 {
	frame [ set comm .comm ] -bd 5 -bg black
	pack .comm -fill both -expand $true

	set commText $comm.text
	set commScroll $comm.vscroll 

	text $commText -width 80 -height 5 -state disabled \
	    -relief sunken -yscrollcommand "$commScroll set"
	scrollbar $commScroll \
	    -orient vertical \
	    -command "$commText yview" \
	    -relief sunken

	pack $commText -side left -fill both -expand $true
	pack $commScroll -side right -fill y

	set commEntryFrame .cef
	set commEntry $commEntryFrame.entry
	frame $commEntryFrame -bd 5 -bg black
	entry $commEntry
	pack $commEntry -fill x
	pack $commEntryFrame -fill x

	bind $commEntry <Key-Return> commSend
	bind $commEntry <Control-c> { $file.menu invoke Quit }
	bind $commEntry <M-r> { $tmenu invoke ready }
	bind $commEntry <M-u> { $amenu invoke Undo! }
	bind $commEntry <M-d> { $tmenu invoke double }
	bind $commEntry <M-i> { $amenu invoke Interpreter }
	bind $commEntry <M-e> { $amenu invoke EMERGENCY }
	# bind $commEntry <Control-r> { $tmenu invoke ready }
	bind $commEntry <Control-a> "$commEntry icursor 0"
	bind $commEntry <Control-b> commEntryBackwardChar
	bind $commEntry <Control-d> commEntryDelete
	bind $commEntry <Control-e> "$commEntry icursor end"
	bind $commEntry <Control-f> commEntryForwardChar
	bind $commEntry <Control-k> "$commEntry delete insert end"
	bind $commEntry <Control-n> commEntryNext
	bind $commEntry <Control-p> commEntryPrev
	bind $commEntry <Control-s> { $tmenu invoke AutoScroll }
	bind $commEntry <M-t> { $imenu invoke "Empty textwindow" }
	bind $commEntry <M-y> { $imenu invoke "Set delay" }
	bind $commEntry <2> paste

	bind $commText  <2> paste

	focus $commEntry
    }
}

proc showText msg {
    global commText autoScroll
    $commText configure -state normal
    $commText insert end $msg
    if $autoScroll {
	$commText yview -pickplace end
    }
    $commText configure -state disabled
}

proc toggleAutoScroll {} {
    global autoScroll autoScrollLabel
    set autoScroll [ expr 1-$autoScroll ]
    $autoScrollLabel configure -text [ if $autoScroll { list AutoScroll } { list Frozen } ]
}

proc paste {} {
    global commEntry
    if ![ catch { set sel [ selection get ] } ] {
	set selList [ split $sel \n ]
	foreach line $selList {
	    if { $line != "" } {
		$commEntry insert insert $line
		break
	    }
	}
    }
}

proc commSend {} {
    global commEntry commEntryIndex commEntryList commEntryListLength \
	commEntryMinLength commEntryMaxLength
    set line [ $commEntry get ]
    exp_send $line\n
    $commEntry delete 0 end
    if { $line != "" } {
	set commEntryList [ concat [ list $line ] $commEntryList ]
	set commEntryListLength [ llength $commEntryList ]
	if $commEntryListLength>$commEntryMaxLength {
	    set commEntryList [ lrange $commEntryList 0 $commEntryMinLength ]
	    set commEntryListLength [ llength $commEntryList ]
	}
	set commEntryIndex -1
    }
}

proc commEntryForwardChar {} {
    global commEntry
    set i [ $commEntry index insert ]
    if [ $commEntry index end ]>$i {
	$commEntry icursor [ incr i ]
    }
}

proc commEntryBackwardChar {} {
    global commEntry
    set i [ $commEntry index insert ]
    if $i>0 {
	$commEntry icursor [ incr i -1 ]
    }
}

proc commEntryDelete {} {
    global commEntry
    set i [ $commEntry index insert ]
    if [ $commEntry index end ]>$i {
	$commEntry delete $i
    }
}

proc emptyTextWindow {} {
    global commText commTextSize
    set index [ $commText index end ]
    set indexList [ split $index . ]
    set lineIndex [ lindex $indexList 0 ]
    set deleteRange [ expr "$lineIndex - $commTextSize" ]
    if $deleteRange>1 {
	$commText delete 1.0 $deleteRange.0
    }
}

proc commEntryPrev {} {
    global commEntry commEntryList commEntryIndex commEntryListLength
    if $commEntryIndex<[ expr $commEntryListLength-1 ] {
	$commEntry delete 0 end
	$commEntry insert 0 [ lindex $commEntryList [ incr commEntryIndex ] ]
    }
}

proc commEntryNext {} {
    global commEntry commEntryList commEntryIndex commEntryListLength
    if $commEntryIndex>0 {
	$commEntry delete 0 end
	$commEntry insert 0 [ lindex $commEntryList [incr commEntryIndex -1]]
    }
}

proc connect {} {
    uplevel #0 {
	spawn -noecho telnet fraggel65.mdstud.chalmers.se 4321
    }
}
proc containers {} {
    global debug
    uplevel #0 {
	# ----- 1. Container for moves line, status labels and board

	set true [ expr 1==1 ]
	set false [ expr 1==0 ]


	set b .buttons
	frame $b \
	    -bd 5 \
	    -bg black

	pack append . \
	    $b { top fill }

	# ----- 1.2 Command line

	set line $b.line

	entry $line
	pack append $b \
	    $line { top fill }
    }
}
proc createboard {} {
    uplevel #0 {
	frame [ set canvases $b.canvases ] -bd 3

	frame [ set cframe1 $canvases.cframe1 ] -borderwidth 2 -bg black
	canvas [ set board $cframe1.board ] -width $db(TW) -height $db(TH)

	frame [ set cframe2 $canvases.cframe2 ] -bd 2 -bg black
	canvas [ set dblRect $cframe2.dblrect ] -width $db(RW) -height $db(TH)

	pack $canvases -anchor c
	pack $cframe1 -fill both -side left
	pack $board -side right
	pack $cframe2 -fill both -side right
	pack $dblRect -side left

	button [ set double $dblRect.double ] 
	button [ set tmpDouble $board.double ]
    }
}
proc database {} {
    uplevel #0 {
	# Initiate global variables. Ugly as h*ll...

	set nexttmp 0
	set commTextSize 500
	# delay in ms when no move is possible or automove
	set delay 500
	set semaphor 0
	set commEntryList {}
	set commEntryIndex -1
	set commEntryMinLength 20
	set commEntryMaxLength 50
	set db(die1) 0
	set db(die2) 0

	set autoScroll 1

	# ----- Board database. -----
	#
	# Defines looks of the board objects.

	# Horizontal indent
	set db(HI) 0

	# Vertical indent
	set db(VI) 20

	# Point width
	set db(PW) 35

	# Point spacing
	set db(PS) 0

	# Point height
	set db(PH) 150

	# Point vertical distance
	set db(PVD) 60

	# Bar width
	set db(BW) 50

	# Man diameter
	set db(MD) 30

	# Set width of rectangle to the right where the cube is.
	set db(RW) 50

	# White stipple
	set db(WS) ""

	# Black stipple
	set db(BS) gray50

	# ----- Calculate some useful constants. -----

	# Max number of men in a row
	set db(maxNumberInARow) [ expr "$db(PH)/$db(MD)" ]

	# Total height of widget
	set db(TH) [ expr "2 * ( $db(PH) + $db(VI) ) + $db(PVD)" ]

	# Total width of widget
	set db(TW) [ expr "12 * ( $db(PW) + $db(PS) ) + $db(BW) + 2 * $db(HI)" ]

	# Upper offset
	set db(UO) $db(VI)

	# Lower offset
	set db(LO) [ expr "$db(TH) - $db(VI)" ]

	set boardWidth $db(TW)
	set boardHeight $db(TH)

	# Base points for first man on point#n
	set db(starty0)  [ expr "$db(UO) + $db(MD) * ( $db(maxNumberInARow) - 0.5 )" ]
	set db(dir0) -1
	set db(starty25) [ expr "$db(LO) - $db(MD) * ( $db(maxNumberInARow) - 0.5 )" ]
	set db(dir25) 1

	for { set i 1 } { $i <= 12 } { incr i } {
	    set db(starty$i) [ expr "$db(LO) - $db(MD) / 2" ]
	    set db(dir$i) -1
	}

	for { set i 13 } { $i <= 24 } { incr i } {
	    set db(starty$i) [ expr "$db(UO) + $db(MD) / 2" ]
	    set db(dir$i) 1
	}

	# ----- Define White, Black and stipples -----

	set db(WHITE) white
	set db(BLACK) black
	set db(WHITESTIPPLE) gray25
	set db(BLACKSTIPPLE) gray50
	set db(FILL) $db(BLACK)
	set db(FILLtmp1) $db(BLACK)
	set db(FILLtmp2) $db(WHITE)
	set db(STIPPLE) $db(WHITESTIPPLE)
	set db(STIPPLEtmp1) $db(BLACKSTIPPLE)
	set db(STIPPLEtmp2) $db(WHITESTIPPLE)

	set db(BARFILL) $db(BLACK)
	set db(BARSTIPPLE) gray25

	# ----- Create points -----
	# Starting from four base points I draw six "points" in each quadrant.

	# Set base points for the four quadrants.

	set db(BPUL) $db(HI)
	set db(BPUR) [ expr "$boardWidth - $db(HI) - 5 * ( $db(PW) + $db(PS) ) - $db(PW)" ]
	set db(BPLL) [ expr "$db(HI) + 5 * ( $db(PW) + $db(PS) ) + $db(PW)" ]
	set db(BPLR) [ expr "$boardWidth - $db(HI)" ]
    }
}

set autoRoll 0
proc dice {} {
    global pdie1 pdie2 odie1 odie2 bitmapdir brd board db autoRoll
    $board delete withtag auto
    if $brd(pdie1)<$brd(pdie2) {
	set tmp $brd(pdie2)
	set brd(pdie2) $brd(pdie1)
	set brd(pdie1) $tmp
    }
    if $brd(odie1)<$brd(odie2) {
	set tmp $brd(odie2)
	set brd(odie2) $brd(odie1)
	set brd(odie1) $tmp
    }
    eval $board delete [ $board find withtag dice ]
    foreach die [ list pdie1 pdie2 ] {
	if $brd($die)>0 {
	    [ set $die ] configure \
		-bitmap @$bitmapdir/r$brd($die).bm \
		-command lineSend	    
	    $board create window \
		$db(X$die) \
		$db(HH) \
		-anchor center \
		-window [ set $die ] \
		-tags dice
	} else {
	    if { 
		$brd(pname) == "You" &&
		$brd(turn) == $brd(color)
	    } then {
		[ set $die ] configure \
		    -bitmap @$bitmapdir/[if {$die=="pdie1"} {list roll.bm} {list dice.bm} ] \
		    -command { deleteDice ; exp_send "r\n" } 
		$board create window \
		    $db(X$die) \
		    $db(HH) \
		    -anchor center \
		    -window [ set $die ] \
		    -tags dice
	    }
	}
    }
    foreach die [ list odie1 odie2 ] {
	if $brd($die)>0 {
	    [ set $die ] configure \
		-bitmap @$bitmapdir/r$brd($die).bm \
		-command toggleAutoRoll
	    $board create window \
		$db(X$die) \
		$db(HH) \
		-anchor center \
		-window [ set $die ] \
		-tags dice
	}
    }
}

proc deleteDice {} {
    global board
    eval $board delete [ $board find withtag dice ]
}

proc toggleAutoRoll {} {
    global autoRoll true false board db brd
    if { $brd(pname) == "You" && $brd(turn) != $brd(color) } {
	set autoRoll [ expr !$autoRoll ]
	if $autoRoll {
	    $board create text \
		[ expr $db(TW)/2 ] [ expr $db(TH)/2 ] \
		-anchor center -tags auto -text Autoroll
	} else {
	    $board delete withtag auto
	} 
    }
}
proc login {} {
    uplevel #0 {
	set newline \n
	set carreturn \r
	set noCarreturn \[^$carreturn\]
	set serverLine ($noCarreturn+)$carreturn$newline
	set timeout -1
	# update idletasks
	showText "Login as \"guest\" if you are new to this server.\n"
	set oldfg [ lindex [ $commEntry configure -fg ] 4 ]
	set bg    [ lindex [ $commEntry configure -bg ] 4 ]
	expect {
	    -re {^login: $} {
		$commEntry configure -fg $oldfg
		showText $expect_out(buffer)
		bind $commEntry <Key-Return> { getLogin 1 }
		continue -expect
	    }
	    -re ^password: {
		showText $expect_out(buffer)\n
		bind $commEntry <Key-Return> { getLogin 0 }
		$commEntry configure -fg $bg
		continue -expect
	    }
	    -re $serverLine {
		showText $expect_out(1,string)\n
		continue -expect
	    }
	    -re ^> {
		showText $expect_out(buffer)\n
		bind $commEntry <Key-Return> commSend
		$commEntry configure -fg $oldfg
	    }
	    default { 
		# $file.menu entryconfigure "Disconnect" -state disabled
		# $file.menu entryconfigure "Connect again" -state normal
		# set connected 
		puts stderr "xibc: Timeout." ; exit 2 
	    }
	}
	$file.menu entryconfigure "Disconnect" -state normal
	$file.menu entryconfigure "Connect again" -state disabled
	set connected 1

	set timeout -1
	# %%%%% Setup defaults %%%%%

	exp_send "set boardstyle 3\n"
    }
}

proc getLogin echo {
    global commEntry
    set foo [ $commEntry get ]
    exp_send $foo\n
    if $echo {
	showText $foo\n
    } else {
	showText \n
    }
    $commEntry delete 0 end
}
proc menubars {} {
    uplevel #0 {
	frame [ set menubar .menubar ] -bd 3 -relief raised
	pack append . $menubar { top fill }

	menubutton [ set file $menubar.file ] -text File -menu $menubar.file.menu
	menubutton [ set actions $menubar.actions ] -text Actions \
	    -menu $actions.menu
	menubutton [ set toggles $menubar.toggles ] -text Toggle \
	    -menu $toggles.menu
	menubutton [ set internals $menubar.internals ] \
	    -text Internals -menu $internals.menu

	tk_menuBar $menubar $file $actions $toggles $internals

	pack append $menubar \
	    $file { left fill } \
	    $actions { left fill } \
	    $toggles { left fill } \
	    $internals { left fill }

	menu $file.menu 
	$file.menu add command -label "Disconnect" \
	    -command Disconnect \
	    -state disabled
	$file.menu add command -label "Connect again" \
	    -command connectAgain \
	    -state disabled	
	$file.menu add separator
	$file.menu add command -label Quit \
	    -command quit \
	    -accelerator C-c

	menu [ set amenu $actions.menu  ]
	$actions.menu add command \
	    -label Roll \
	    -command {exp_send "roll\n"}
	$actions.menu add command \
	    -label Undo! \
	    -command undo \
	    -accelerator M-u
	$amenu add command -label Double \
	    -command { exp_send double\n }
	$amenu add separator
	$actions.menu add command \
	    -label Interpreter -command interpreter \
	    -accelerator M-i
	$actions.menu add command \
	    -label EMERGENCY \
	    -command { 
		set parseState all 
		$line delete 0 end 
		exp_send "b\n"
	    } \
	    -accelerator M-e
	
	menu [ set tmenu $toggles.menu ]
	$tmenu add command -label Toggle: -command {}
	$tmenu add separator 
	$tmenu add command -label ready \
	    -command { exp_send "toggle ready\n" } \
 	    -accelerator M-r
	$tmenu add command -label automove \
	    -command { exp_send "toggle automove\n" }
	$tmenu add command -label double \
	    -command { exp_send "toggle double\n" } \
	    -accelerator M-d
	$tmenu add command -label "AutoScroll" \
	    -command toggleAutoScroll \
	    -accelerator C-s

	menu [ set imenu $internals.menu ]
	$imenu add command -label "Empty textwindow" \
	    -command emptyTextWindow \
	    -accelerator M-t
	$imenu add command -label "Set delay" \
	    -command setDelay \
	    -accelerator M-y
    }
}
# ----- try -----
# Checks if a move is allowed and updates screen.

proc try { button position } {
    global db brd pdie1 pdie2
    if { $db(movesLeft) > 0 && $brd(color) == $brd(turn) } {
	if $button==1 {
	    if $db(movesLeftLeft)>0  {
		set die $brd(pdie1)
	    } else {
		set die $brd(pdie2)
	    }
	} else {
	    if $db(movesLeftRight)>0 {
		set die $brd(pdie2)
	    } else {
		set die $brd(pdie1)
	    }
	}
	if [ moveIfPossible $position $die ] {
	    incr db(movesLeft) -1
	    if $db(movesLeft)==0 {
		$pdie1 configure -command lineSend
		$pdie2 configure -command lineSend
	    } else {
		if $die==$brd(pdie1) {
		    incr db(movesLeftLeft) -1
		} else {
		    incr db(movesLeftRight) -1
		}
	    }
	}
    }
}



# ----- moveIfPossible -----
# Checks if a move is permittable due to the destination.

proc moveIfPossible { base die } {
    global db boardList brd undoList 
    set increment $brd(color)
    set decrement [ expr -$increment ]
    set dest [ expr "$base - $die" ]
    if $dest<=0 { 
	placeMen $base [ incr brd($base) $decrement ]
	poffSet [ incr brd(poff) ]
	addMove $base $dest $increment
	lappend undoList $base
    } else {
	if { $brd($dest) / $brd(color) >= 0 } {
	    placeMen $base [ incr brd($base) $decrement ]
	    lappend undoList $base
	    placeMen $dest [ incr brd($dest) $increment ]
	    lappend undoList $dest
	    addMove $base $dest $increment
	} else {
	    if { $brd($dest) / $brd(color) == -1 } {
		placeMen 0 [ incr brd(0) $decrement ]
		lappend undoList 0
		placeMen $dest [ set brd($dest) $increment ]
		lappend undoList $dest
		placeMen $base [ incr brd($base) $decrement ]
		lappend undoList $base
		addMove $base $dest $increment
	    } else {
		return 0
	    }
	}
    }
    return 1
}

# ----- addMove -----
# Calculates which characters to send to the server.

proc addMove { base dest increment } {
    if $increment==-1 {
	set base [ expr "25 - $base" ]
	set dest [ expr "25 - $dest" ]
    }
    if $base==25||$base==0 {
	addChars "b $dest "
    } else {
	if $dest<=0||$dest>24 {
	    addChars "$base o "
	} else {
	    addChars "$base $dest "
	}
    }
}

# ----- move -----

proc move { base dest } {
    global db brd
    set player [ expr $brd(turn)==$brd(color) ]
    set decrement [ expr -$brd(turn) ]
    if { $base == "bar" } {
	if $player {
	    set base 25
	} else {
	    set base 0
	}
    } else {
	if $brd(color)==-1 {
	    set base [ expr 25-$base ]
	}
    }
    placeMen $base [ incr brd($base) $decrement ]
    if { $dest == "off" } {
	if $player {
	    poffSet [ incr brd(poff) ]
	} else {
	    ooffSet [ incr brd(ooff) ]
	}
    } else {
	if $brd(color)==-1 {
	    set dest [ expr 25-$dest ]
	}
	if { $brd($dest) / $brd(turn) >= 0 } {
	    placeMen $dest [ incr brd($dest) $brd(turn) ]
	} else {
	    if { $brd($dest) / $brd(turn) == -1 } {
		placeMen $dest [ set brd($dest) $brd(turn) ]
		if $player {
		    set obar 0
		} else {
		    set obar 25
		}
		placeMen $obar [ incr brd($obar) $decrement ]
	    } else {
	    }
	}
    }
}

proc placeMen { point number } {
    global board db color boardList brd
    eval $board delete [$board find withtag man$point ]
    if $number!=0 {
	if { $number / $brd(color) < 0 } then {
	    set manColor $db(BLACK)
	    set digitColor $db(WHITE)
 	} else {
	    set manColor $db(WHITE)
	    set digitColor $db(BLACK)
	}
	if { $number < 0 } { 	
	    set number [ expr -$number ]
	}
	set rest 0
	if $number>$db(maxNumberInARow) {
	    set rest [ expr "$number - $db(maxNumberInARow)" ]
	    set number $db(maxNumberInARow)
	}
	set starty $db(starty$point)
	set startx $db(X$point)
	set x0 [ expr "$startx - $db(MD)/2" ]
	set x1 [ expr "$startx + $db(MD)/2" ]
	set y0 [ expr "$starty - $db(MD)/2" ]
	set y1 [ expr "$starty + $db(MD)/2" ]
	set direction $db(dir$point)
	for { set i 1 } { $i <= $number } { incr i } {
	    $board create oval $x0 $y0 $x1 $y1 -fill $manColor -tags man$point
	    if { 
		$manColor == $db(WHITE) &&
		[ lindex $boardList 0 ] == "You"
	    } {
		$board bind man$point <1> "try 1 $point"
		$board bind man$point <3> "try 3 $point"
	    }
	    set y0 [ expr "$y0 + $db(MD) * ($direction)" ]
	    set y1 [ expr "$y1 + $db(MD) * ($direction)" ]
	}
	if $rest>0 {
	    incr rest
	    $board create text $startx $starty -text $rest \
		-tags man$point -fill $digitColor
	}
    }
}

proc moveMany movesString {
    global brd parseState delay
    set DIGITS {[0-9]}
    set MOVE "(off|bar|$DIGITS+)-(off|bar|$DIGITS+)"
    if [ info exists brd ] {
	set movesList [ split $movesString " " ]
	foreach move $movesList {
	    regexp $MOVE $move tot from to
	    move $from $to
	    delay "moveMany $from $to"
	}
	set brd(pdie1) 0
	set brd(pdie2) 0
	set brd(odie1) 0
	set brd(odie2) 0
	if { $brd(pname) == "You" || $brd(turn) == $brd(color) } {
	    deleteDice
	} else {
	    dice
	}
	set parseState move
    }
}

# --- getNextCoords ---
# Gives the coordinates to the next empty spot on the point.

proc getNextCoordsY point {
    global brd db
    set direction $db(dir$point)
    set number $brd($point)
    if $number<0 { 
	set number [ expr -$number ]
    }
    set y [ getFirstCoordsY $point ]
    if $number>0&&$number<$db(maxNumberInARow) {
	set y [ expr "$y + $direction * $number * $db(MD)" ]
    }
    return $y
}

proc getNextCoordsX point {
    return [ getFirstCoordsX $point ]
}

# --- getFirstCoords[X|Y] ---
# Gives the coordinates to the first spot on the point, whether empty
# or not.

proc getFirstCoordsX point {
    global brd db
    set startx $db(X$point)
    set x [ expr "$startx - $db(MD)/2" ]
    return $x
}

proc getFirstCoordsY point {
    global brd db
    set starty $db(starty$point)
    set y [ expr "$starty + $db(MD)/2" ]
    return $y
}

proc paint {} {
    uplevel #0 {
	for { set i 0 } { $i <= 5 }  { incr i 1 } {

	    # Calculate current horizontal offset.
	    set CO [ expr "$i * ( $db(PW) + $db(PS) )" ]
	    
	    set X [ expr "$db(BPUL) + $CO + $db(PW) / 2" ]
	    $board create polygon \
		[ expr "$db(BPUL) + $CO" ] $db(UO) \
		[ expr "$db(BPUL) + $CO + $db(PW)" ] $db(UO) \
		$X [ expr "$db(UO) + $db(PH)" ]\
		-fill $db(FILL) -stipple $db(STIPPLE) -tag point[ expr "13+$i"  ]
	    set db(X[ expr "13 + $i" ]) $X

	    set X [ expr "$db(BPUR) + $CO + $db(PW) / 2" ]
	    $board create polygon \
		[ expr "$db(BPUR) + $CO" ] $db(UO) \
		[ expr "$db(BPUR) + $CO + $db(PW)" ] $db(UO) \
		$X [ expr "$db(UO) + $db(PH)" ]\
		-fill $db(FILL) -stipple $db(STIPPLE) -tag point[ expr "19+$i" ]
	    set db(X[ expr "19+$i" ]) $X

	    set X [ expr "$db(BPLL) - $CO - $db(PW)/2" ]
	    $board create polygon \
		[ expr "$db(BPLL) - $CO" ] $db(LO) \
		[ expr "$db(BPLL) - $CO - $db(PW)" ] $db(LO) \
		$X [ expr "$db(LO) - $db(PH)" ] \
		-fill $db(FILL) -stipple $db(STIPPLE) -tag point[ expr "7+$i" ]
	    set db(X[ expr "7+$i" ]) $X

	    set X [ expr "$db(BPLR) - $CO - $db(PW)/2" ]
	    $board create polygon \
		[ expr "$db(BPLR) - $CO" ] $db(LO) \
		[ expr "$db(BPLR) - $CO - $db(PW)" ] $db(LO) \
		$X [ expr "$db(LO) - $db(PH)" ] \
		-fill $db(FILL) -stipple $db(STIPPLE) -tag point[ expr "1+$i" ]
	    set db(X[ expr "1+$i" ]) $X
	    #    set db(FILL) $db(FILLtmp1)
	    #    set db(FILLtmp1) $db(FILLtmp2)
	    #    set db(FILLtmp2) $db(FILL)

	    # Toggle black/white stipple but keep the same color.
	    # Not good on a color screen...
	    set db(STIPPLE) $db(STIPPLEtmp1)
	    set db(STIPPLEtmp1) $db(STIPPLEtmp2)
	    set db(STIPPLEtmp2) $db(STIPPLE)
	}

	# ----- Create bar -----
	# May use db($TW) and db($TH) to simplify calculations.

	set db(X0) [ expr "2 * $db(HI) + 5 * ( $db(PW) + $db(PS) ) + $db(PW) + $db(BW)/2" ]
	set db(X25) $db(X0)

	$board create rectangle \
	    [ expr "2 * $db(HI) + 5 * ( $db(PW) + $db(PS) ) + $db(PW)" ] $db(UO) \
	    [ expr "2 * $db(HI) + 5 * ( $db(PW) + $db(PS) ) + $db(PW) + $db(BW)" ] \
	    $db(LO) \
	    -fill $db(BARFILL) -stipple $db(BARSTIPPLE) -tags bar

	# ----- Create dice, one pair on each side -----

	button [ set pdie1 $board.pdie1 ] \
	    -bitmap gray50 

	bind $pdie1 <1> "$pdie1 invoke"
	bind $pdie1 <Any-ButtonRelease> ""
 
	button [ set pdie2 $board.pdie2 ] \
	    -bitmap gray50

	bind $pdie2 <1> "$pdie2 invoke"
	bind $pdie2 <Any-ButtonRelease> ""

	button [ set odie1 $board.odie1 ] \
	    -bitmap gray50
	button [ set odie2 $board.odie2 ] \
	    -bitmap gray50

	set db(HH) [ expr "$db(TH) / 2" ]

	set db(Xpdie1) [ expr "$db(TW) - $db(PW) * 4 - $db(HI)" ]
	set db(Xpdie2) [ expr "$db(TW) - $db(PW) * 2 - $db(HI)" ]
	set db(Xodie1) [ expr "$db(HI) + $db(PW) * 2" ]
	set db(Xodie2) [ expr "$db(HI) + $db(PW) * 4" ]

	bind $board <2> undo

    }
}
proc run {} {
    global user_spawn_id db boardList brd parseState autoRoll log_user debug \
	delay logFile file connected pdie1 pdie2
    # Initiate constants to use in regexp's
    set CHAR {[a-zA-Z_<>]}
    set DIGIT {[0-9]}
    set NAME $CHAR+
    set MOVE "(off|bar|$DIGIT+)-(off|bar|$DIGIT+)"
    #
    set newline \n
    set noNewline \[^$newline\]
    set textLine ($noNewline*)$newline
    #
    set carreturn \r
    set noCarreturn \[^$carreturn\]
    set serverLine ($noCarreturn+)$carreturn$newline
    #
    set parseState all
    set undoAll 0
    set prompt "> "
    set blockParse 0
    set onlyPossibleParse 0
    set watchTarget ""
    #
    set timeout -1
    expect {
	-re "^\a### ATTENTION ### The server will shut down in 1 minute\\.\r\n" {
	    popup "BING BING BING BING!!! *** ATTENTION ! The server will shut down in 1 minute!!!"
	    continue -expect
	}
	-re "^Starting a new game with $NAME\\.\r\n" {
	    set parseState all
	    continue -expect
	}
	-re "^(It's your turn\\. Please roll or double)\\.?\r\n" {
	    showText $expect_out(1,string).\n
	    if $autoRoll {
		set autoRoll 0
		exp_send "r\n"
	    }
	    continue -expect
	}
	-re "^It's your turn to move\\.\r\n" {
	    continue -expect
	}
	-re "^It's your turn to roll or double\\.\r\n" {
	    dice
	    continue -expect
	}
	-re "^$NAME makes the first move\\.\r\n" {
	    continue -expect
	}
	-re "^(You are now playing with $NAME\\.) " {
	    showText "$expect_out(1,string).\n"
	    continue -expect
	}
	-re "^($NAME has joined you\\.) " {
	    showText "$expect_out(1,string)\n"
	    continue -expect
	}
	-re "^(Your running match was loaded.)\r\n" { 
	    showText $expect_out(1,string)\n
	    set parseState all
	    set autoRoll 0
	    exp_send "b\n"
	    if [ info exists brd ] {
		unset brd
	    }
	    continue -expect
	}
	-re "^($NAME makes the first move.)\r\n" { 
	    showText $expect_out(1,string)
	    set parseState all
	    set autoRoll 0
	    if [ info exists brd ] {
		unset brd
	    }
	    continue -expect
	}
	-re "^(($NAME) and ($NAME) are resuming their $noCarreturn+)\r\n" {
	    showText $expect_out(1,string)\n
	    if { $expect_out(2,string) == $watchTarget ||
		$expect_out(3,string) == $watchTarget } {
		    set parseState all
		    if [ info exists brd ] {
			unset brd
		    }
		    exp_send "b\n"
		}
	    continue -expect
	}
	-re "^($NAME wins? the $DIGIT+ point match $DIGIT+-$DIGIT+ \\.)\r\n" {
	    if [ info exists brd ] {
		if { $brd(pname) == "You" && $logFile != "" } {
		    logToFile "$brd(pname) - $brd(oname) : $expect_out(1,string)"
		}
	    }
	    continue -expect
	}
	-re "^(\\*\\* Please don't give more than $noCarreturn+)\r\n" {
	    showText "$expect_out(1,string)\n"
	    undo
	    continue -expect
	}
	-re "(\\*\\* You must give $noCarreturn+)\r\n" {
	    showText "$expect_out(1,string)\n"
	    undo
	    continue -expect
	}
	-re "^(\\*\\* You have to remove pieces from the bar in your first move\\.)\r\n" {
	    showText "$expect_out(1,string)\n"
	    undo
	    continue -expect
	}
	-re "^(\\*\\* You can't move )( $noCarreturn+)\r\n" {
	    showText "$expect_out(1,string) $expect_out(2,string)\n"
	    delay "** You can't..."
	    undo
	    continue -expect
	}
	-re "^You're now watching ($NAME)." {
	    set parseState all
	    set watchTarget $expect_out(1,string)
	    if [ info exists brd ] {
		unset brd
	    }
	    exp_send "b\n"
	    continue -expect
	}
	-re "(^$NAME wants to resign\\. You will win $DIGIT+ points?\\. Type 'accept' or 'reject'\\.)\r\n" {
	    showText $expect_out(1,string)
	    request {exp_send accept\n} Accept {exp_send reject\n} Reject
	    continue -expect
	}
	-re "^(You reject\\. The game continues\\.)\r\n" {
	    showText $expect_out(1,string)
	    dice
	    continue -expect
	}
	-re "^Type 'join' if you want to play the next game, type 'leave' if you don't\\.\r\n" {
	    showText "^Type 'join' if you want to play the next game, type 'leave' if you don't."
	    request {exp_send join\n} join {exp_send leave\n} leave
	    # $pdie1 configure -text join -command {exp_send join\n}
	    # $pdie2 configure -text leave -command {exp_send leave\n}
	    continue -expect
	}
	-re "^($NAME) doubles?\\." {
	    set name $expect_out(1,string)
	    if { $name == "You" } {
		showText "You double.\n"
		set brd(cube) [ expr "2 * $brd(cube)" ]
		doubling $name
	    } else {
		showText "$name doubles.\n"
		if [ info exists brd ] {
		    set brd(cube) [ expr "2 * $brd(cube)" ]
		    if { $name == $brd(pname) } {
			set brd(pmaydbl) 0
			set brd(omaydbl) 1
		    } else {
			set brd(omaydbl) 0
			set brd(pmaydbl) 1
		    }
		    doubling $name
		}
	    }
	    continue -expect
	}
	-re "^(($NAME) accepts? the double.)" {
	    showText $expect_out(1,string)\n
	    set name $expect_out(2,string)
	    if { $name != $brd(pname) } {
		set brd(pmaydbl) 0
		set brd(omaydbl) 1
	    } else {
		set brd(omaydbl) 0
		set brd(pmaydbl) 1
	    }
	    setDouble $brd(cube)
	    continue -expect
	}
	-re "^ The cube shows ($DIGIT+)\\.\r\n" {
	    showText "The cube shows $expect_out(1,string).\n"
	    set brd(cube) $expect_out(1,string)	    
	    setDouble $brd(cube)
	    continue -expect
	}
	-re "^The only possible move is (\[^\n\]+) \\." {
	    showText "The only possible move is $expect_out(1,string).\n"
	    if { $brd(turn) == $brd(color) && $brd(pname) == "You" } {
		delay "only possible: You"
		moveMany $expect_out(1,string)
		toggleActive
	    } else {
		set onlyPossibleParse 1
	    }
	    delay "The only possible...finished"
	    continue -expect
	}
	-re "^($NAME) moves (\[^\\.\]+) \\.? ?\r\n" {
	    set name $expect_out(1,string)
	    showText "$expect_out(1,string) moves $expect_out(2,string).\n"
	    if [ info exists brd ] {
		moveMany $expect_out(2,string)
		if { ( $expect_out(1,string) == $brd(pname) )  != 
		    ( $brd(color) == $brd(turn) ) 
		} {
		}
		toggleActive
		if $onlyPossibleParse {
		    delay "The only possible...parse ok."
		    set onlyPossibleParse 0
		}
	    }
	    continue -expect
	}
	-re "^($NAME can't move.)\r\n" {
	    showText $expect_out(1,string)\n
	    if [ info exists brd ] {
		delay "Somebody can't move."
		toggleActive
		moveMany ""
	    }
	    continue -expect
	}
	-re "^board:(\[^(\r\n)\]*)\r\n" {
	    boardParse $expect_out(1,string) $parseState
	    set parseState none
	    continue -expect
	}
	-re "^You roll ($DIGIT) and ($DIGIT)\\.\r\n" {
	    showText "You roll $expect_out(1,string) and $expect_out(2,string).\n"
	    set brd(pdie1) $expect_out(1,string) 
	    set brd(pdie2) $expect_out(2,string)
	    set brd(odie1) 0
	    set brd(odie2) 0
	    dice
	    set parseState nomove
	    update idletasks
	    continue -expect
	}
	-re "^Please move ($DIGIT) pieces?\\.\r\n" {
	    showText "Please move $expect_out(1,string) pieces.\n"
	    switch [ set db(movesLeft) $expect_out(1,string) ] {
		1 - 2 {
		    set db(movesLeftLeft)  \
			[ expr "( $db(movesLeft) + 1 ) / 2" ]
		    set db(movesLeftRight) \
			[ expr "( $db(movesLeft) + 1 ) / 2" ]
		}
		3 - 4 {
		    set db(movesLeftLeft) $db(movesLeft)
		    set db(mvoesLeftRight) $db(movesLeft)
		}
		default { 
		}
	    }
	    set brd(canmove) $db(movesLeft)
	    set parseState nomove
	    continue -expect
	}
	-re "^($NAME) rolls ($DIGIT) and ($DIGIT)\\.\r\n" {
	    showText "$expect_out(1,string) rolls $expect_out(2,string) and $expect_out(3,string).\n"
	    if [info exists brd] {
		if { $brd(turn) == $brd(color) } {
		    set brd(pdie1) $expect_out(2,string) 
		    set brd(pdie2) $expect_out(3,string)
		} else {
		    set brd(odie1) $expect_out(2,string) 
		    set brd(odie2) $expect_out(3,string)
		}
		dice
		if { $expect_out(1,string) == $brd(pname) } {
		    set brd(turn) $brd(color)
		} else {
		    set brd(turn) [ expr -$brd(color) ]
		}
		set parseState nomove
	    }
	    continue -expect
	}
	-re {^> } {
	    showText $prompt
	    continue -expect
	}
	-re ^\r\n {
	    continue -expect
	}
	-re ^$serverLine { 
	    if $debug {
		showText "#$expect_out(1,string)#\n"
	    } else {
		showText "$expect_out(1,string)\n"
	    }
	    continue -expect
	}
	eof
    }
    $file.menu entryconfigure "Disconnect" -state disabled
    $file.menu entryconfigure "Connect again" -state normal
    set connected 0
}
proc statuslabels {} {
    uplevel #0 {
	frame [ set opp $b.opponent ] -bd 3 -bg black
	label [ set oppChar $opp.char ] -width 3 -fg white -bg black
	label [ set oppName $opp.name ] -width 10 -fg white -bg black
	label [ set oppActive $opp.active ] -width 6
	label [ set oppGotInfo $opp.gotinfo ] -text {Score: }
	label [ set oppGot $opp.got ] -width 4
	label [ set matchInfo $opp.mi ] -text {Match length: }
	label [ set matchLength $opp.ml ] -width 4

	pack append $opp \
	    $oppChar { left fill } \
	    $oppName { left fill } \
	    $oppActive { left fill } \
	    $oppGotInfo { left fill } \
	    $oppGot { left fill } \
	    $matchInfo { left fill } \
	    $matchLength { left fill }

	pack append $b $opp { top fill }

	frame [ set you $b.you ] -bd 3 -bg black
	label [ set youChar $you.char ] -width 3 -fg black -bg white
	label [ set youName $you.name ] -width 10 -fg black -bg white
	label [ set youActive $you.active ] -width 6
	label [ set youGotInfo $you.gotinfo ] -text {Score: }
	label [ set youGot $you.got ] -width 4
	label [ set status $you.status ] -width 7
	label [ set autoScrollLabel $you.asl ] -text AutoScroll

	pack append $you \
	    $youChar { left fill } \
	    $youName { left fill } \
	    $youActive { left fill } \
	    $youGotInfo { left fill } \
	    $youGot { left fill } \
	    $status { left fill } \
	    $autoScrollLabel { right fill }

	pack append $b \
	    $you { bottom fill }
    }
}

proc poffSet nr {
    global dblRect db
    eval $dblRect delete [ $dblRect find withtag poff ]
    if $nr>0 {
	set x [ expr "$db(RW) / 2" ] 
	set y [ expr "$db(TH) * 7 / 8" ] 
	set d [ expr $db(MD)/2 ]
	$dblRect create oval \
	    [ expr $x-$d ] \
	    [ expr $y-$d ] \
	    [ expr $x+$d ] \
	    [ expr $y+$d ] \
	    -fill white \
	    -tags poff
	$dblRect create text \
	    $x $y \
	    -text $nr \
	    -tags poff \
	    -fill black
    }
}

proc ooffSet nr {
    global dblRect db
    eval $dblRect delete [ $dblRect find withtag ooff ]
    if $nr>0 {
	set x [ expr "$db(RW) / 2" ] 
	set y [ expr "$db(TH) / 8" ] 
	set d [ expr $db(MD)/2 ]
	$dblRect create oval \
	    [ expr $x-$d ] \
	    [ expr $y-$d ] \
	    [ expr $x+$d ] \
	    [ expr $y+$d ] \
	    -fill black \
	    -tags ooff
	$dblRect create text \
	    $x $y \
	    -text $nr \
	    -tags ooff \
	    -fill white
    }
}
proc toplevels {} {
    uplevel #0 {
	wm minsize . [ expr "$db(TW) + $db(RW) + 24" ] [ expr "$db(TH) + 250" ]
	wm title . "xibc [version]"
	wm geometry . +505+2
	if $debug {
	    wm geometry .debug +2-25
	}
	update idletasks
	set logFileTmp [ option get . xibcLogfile foo ] 
	if { $logFileTmp != "" } {
	    if [ catch { set logFile [ lindex [ glob $logFileTmp ] 0 ] } ] {
		showText "File $logFileTmp doesn't exist. No logging will be performed.\n"
		set logFile ""
	    } else {
	    }
	} else {
	    set logFile ""
	}
	set delay [ option get . xibcDelay foo ]
	if { $delay == "" } { set delay 500 }
    }
}
proc quit {} {
    global continueToPlay connected file
    if [ info exists connected ] {
	if $connected {
	    set continueToPlay 0
	    exp_send "quit\n"
	} else {
	    exit
	}
    } else {
	exit
    }
}

proc Disconnect {} {
    global file continueToPlay
    $file.menu entryconfigure Disconnect -state disabled
    set continueToPlay 1
    exp_send quit\n
}

proc connectAgain {} {
    global connectionFlag continueToPlay file
    $file.menu entryconfigure "Connect again" -state disabled
    set connectionFlag [ expr 1-$connectionFlag ]
}

proc active { char youChar } {
    global youActive oppActive db
    if { $char == $youChar } {
	$youActive configure -bg $db(BLACK) -fg $db(WHITE) -text Active
	$oppActive configure -bg $db(WHITE) -text ""
    } else {
	$oppActive configure -bg $db(BLACK) -fg $db(WHITE) -text Active
	$youActive configure -bg $db(WHITE) -text ""
    }
}	

proc toggleActive {} {
    global brd youActive oppActive db
    set brd(turn) [ expr -$brd(turn) ]
    if $brd(turn)==$brd(color) {
	$youActive configure -bg $db(BLACK) -fg $db(WHITE) -text Active
	$oppActive configure -bg $db(WHITE) -text ""
    } else {
	$oppActive configure -bg $db(BLACK) -fg $db(WHITE) -text Active
	$youActive configure -bg $db(WHITE) -text ""
    }
}	


proc setDouble nr {
    global double brd db bitmapdir dblRect board
    $dblRect delete double
    $board delete tmpDouble
    if $nr<=64 {
	$double configure -bitmap @$bitmapdir/d$nr.bm
    } else {
	$double configure -text " $nr "
    }
    if $brd(pmaydbl)&&$brd(omaydbl) {
	$dblRect create window \
	    [ expr "$db(RW) / 2" ] \
	    $db(HH) \
	    -anchor center \
	    -window $double \
	    -tags double
	$double configure -command { exp_send double\n }
    } else {
	if $brd(pmaydbl) {
	    $dblRect create window \
		[ expr "$db(RW) / 2" ] \
		[ expr "$db(TH) * 3 / 4" ] \
		-anchor center \
		-window $double \
		-tags double
	    $double configure -command { exp_send double\n }
	} else {
	    $dblRect create window \
		[ expr "$db(RW) / 2" ] \
		[ expr "$db(TH) / 4 " ] \
		-anchor c \
		-window $double \
		-tags double
	    $double configure -command ""
	}
    }
}

proc doubling name {
    global tmpDouble brd db bitmapdir dblRect board
    $dblRect delete double
    # The cube is doubled in "run".
    set nr $brd(cube)
    if $nr<=64 {
	$tmpDouble configure -bitmap @$bitmapdir/d$nr.bm
    } else {
	$tmpDouble configure -text " $nr "
    }
    $board create window \
	[ expr "$db(TW) / 2" ] \
	[ expr "$db(TH) / 2" ] \
	-window $tmpDouble \
	-tags tmpDouble
    if { $name == $brd(oname) && $brd(pname) == "You" } {
	request {exp_send accept\n} Accept {exp_send reject\n} Reject
    }
}

proc request {com1 msg1 com2 msg2} {
    global board pdie1 pdie2 db
    $pdie1 configure -text $msg1 -bitmap "" \
	-command $com1
    $pdie2 configure -text $msg2 -bitmap "" \
	-command $com2
    foreach die [ list pdie1 pdie2 ] {
	$board create window \
	    $db(X$die) \
	    $db(HH) \
	    -anchor center \
	    -window [ set $die ] \
	    -tags dice
    }
}

proc setDelay {} {
    global delay nexttmp
    set currPos [ wm geometry . ]
    set t .delay[incr nexttmp]
    toplevel $t
    wm title $t "Set delay"
    wm transient $t
    if ![regexp -- - $currPos] {
	set offset [ split $currPos + ]
	set size [ split [ lindex $offset 0 ] x ]
	set xoffset [ expr "[lindex $offset 1] + [lindex $size 0] / 2" ]
	set yoffset [ expr "[lindex $offset 2] + [lindex $size 1] / 2" ]
	wm geometry $t +$xoffset+$yoffset
    }
    scale [set s $t.s] -from 0 -to 3000 -label "Delay (ms)" -showvalue 1 \
	-tickinterval 1000 -command setDelay2
    $s set $delay
    button $t.b -text "Remove this window" -command "destroy $t"
    pack $s
    pack $t.b -fill both
}

proc setDelay2 int {
    global delay
    set delay $int
}

proc delay msg {
    global delay semaphor
    if { $semaphor } { tkwait variable semaphor }
    incr semaphor
    update idletasks
    after $delay { incr semaphor -1 }
    tkwait variable semaphor
}

proc logToFile args {
    global logFile
    if [ catch {
	set fileId [ open $logFile a ]
	puts $fileId [ eval concat [ exec date ] $args ]
	close $fileId 
    } ] {
	showText "Error in writing to file $logFile.\n"
    }
}

proc popup str {
    global nexttmp
    set currPos [ wm geometry . ]
    toplevel [ set t .tmp[ incr nexttmp ] ]
    wm transient $t
    if ![regexp -- - $currPos] {
	set offset [ split $currPos + ]
	set size [ split [ lindex $offset 0 ] x ]
	set xoffset [ expr "[lindex $offset 1] + [lindex $size 0] / 2" ]
	set yoffset [ expr "[lindex $offset 2] + [lindex $size 1] / 2" ]
	wm geometry $t +$xoffset+$yoffset
    }
    wm title $t "Notice:"
    message $t.m -text $str
    button $t.b -text Ok -command " destroy $t "
    pack $t.m -fill both
    pack $t.b -fill both
    update idletasks
    tkwait visibility $t
    grab $t
    set whoHasFocus [ focus ]
    focus $t
    bind $t <Return> " destroy $t "
    tkwait window $t
    focus $whoHasFocus
}


log_user 0
set debug 0

connect

menubars

containers

statuslabels

database

createboard

communication

paint

toplevels

connectLoop

exit
