#!/usr/local/bin/wish -f

set Port 9876
set Color(0) red
set Color(1) blue
set Opponent {}

proc buildMainWindow {} {
    global Name Opponent Color
    wm title . "Death of a Salesman"
    wm resizable . 0 0

    frame .t -bd 3 -relief ridge
    frame .t.c
    frame .cs
    foreach i {0 1} {
	frame .t.$i
	label .t.$i.name
	label .t.$i.score -textvariable Score($i) -fg $Color($i) -width 4
	pack .t.$i.name .t.$i.score -side left -padx 10
	
	frame .s$i
	frame .tf$i -bd 3 -relief ridge
	frame .t$i
	foreach j {0 1} {
	    frame .t$i.$j
	    label .t$i.$j.name
	    label .t$i.$j.score -textvariable Score($j.$i) \
		-fg $Color($j) -width 4
	    pack .t$i.$j.name .t$i.$j.score -side left -padx 10
	}
	.t$i.0.name config -text $Name
	.t$i.1.name config -text $Opponent
	pack .t$i.0 .t$i.1 -in .t$i -side left -padx 10
	pack .t$i -in .tf$i
	pack .tf$i -in .s$i -side top -fill x

	frame .cb$i -bd 3
	canvas .c$i -width 400 -height 400
	pack .c$i -in .cb$i -fill both -expand 1
	pack .cb$i -in .s$i -fill both -expand 1
	pack .s$i -in .cs -side left
	.c$i bind active <ButtonPress> "nodeSelected $i"
    }
    .t.0.name config -text $Name
    .t.1.name config -text $Opponent

    pack .t.0 .t.1 -in .t.c -side left -padx 10
    pack .t.c
    pack .t -side top -fill x
    pack .cs -fill both -expand 1
    wm deiconify .
}

proc changeScore {w player amount} {
    global Score Scoref
    set Scoref($player.$w) [expr $Scoref($player.$w) + $amount]
    set Score($player.$w) [expr int($Scoref($player.$w))]
    set Scoref($player) [expr $Scoref($player) + $amount]
    set Score($player) [expr int($Scoref($player))]
}

proc makeLine {player w n1 n2} {
    global Color
    set n1 [.c$w coords $n1]
    set x1 [lindex $n1 0]
    set y1 [lindex $n1 1]
    set n2 [.c$w coords $n2]
    set x2 [lindex $n2 0]
    set y2 [lindex $n2 1]
    set l [.c$w create line [expr $x1+4] [expr $y1+4] [expr $x2+4] \
	       [expr $y2+4] -fill $Color($player) -tags line -width 2]
    .c$w lower $l
    set dx [expr $x1 - $x2]
    set dy [expr $y1 - $y2]
    set dist [expr sqrt($dx * $dx + $dy * $dy)]
    changeScore $w $player $dist
}

###################################### INSURANCE ##############################
proc insuranceSelectNode {node w player} {
    global LastNode FirstNode
    .c$w itemconfig $node -fill yellow
    set last $LastNode($w)
    if {$last != 0} {
	if {$FirstNode($w) == $last} {
	    .c$w itemconfig last -fill white
	} else {
	    .c$w itemconfig last -fill black -outline {}
	}
	.c$w dtag last last
	makeLine $player $w $last $node
    } else {
	set FirstNode($w) $node
	.c$w dtag $node node
    }
    set LastNode($w) $node
    .c$w dtag $node active
    .c$w addtag last withtag $node
}

proc insuranceNextTurn node {
    global Win

    sendData $node

    lowerCanvas $Win
    set Win [expr 1 - $Win]
    update
    insuranceSelectNode [.c$Win find withtag [getData]] $Win 1
    bell
    raiseCanvas $Win

    if {[llength [.c$Win find withtag active]] == 1} {
	insuranceGameOver; return
    }
}

proc insuranceGameOver {} {
    global LastNode FirstNode Win

    set w [expr 1 - $Win]
    set node [.c$w find withtag active]
    makeLine 1 $w $LastNode($w)	$node
    makeLine 0 $w $node $FirstNode($w)
    sendData [lindex [.c$w gettags $node] 0]
    sendData [lindex [.c$w gettags $FirstNode($w)] 0]

    update
    insuranceSelectNode [getData] $Win 0
    insuranceSelectNode [getData] $Win 1
    .c$Win itemconfig $FirstNode($Win) -fill white
    raiseCanvas $w
    .c0 itemconfig node -fill black -outline {}
    .c1 itemconfig node -fill black -outline {}
    
    gameOver
}

################################## ENCYCLOPEDIA ###############################
proc encycloSelectNode {node w player} {
    global LastNode FirstNode Color
    .c$w itemconfig $node -fill $Color($player)
    set last $LastNode($w.$player)
    if {$last != 0} {
	if {$FirstNode($w.$player) == $last} {
	    .c$w itemconfig last.$player -fill white
	} else {
	    .c$w itemconfig last.$player -fill black -outline {}
	}
	.c$w dtag last.$player last.$player
	makeLine $player $w $last $node
    } else {
	set FirstNode($w.$player) $node
	.c$w dtag $node node
    }
    set LastNode($w.$player) $node
    .c$w dtag $node active
    .c$w addtag last.$player withtag $node
}

proc encycloNextTurn node {
    global Win

    sendData $node
    if {[llength [.c$Win find withtag active]] == 1} {
	finishEncyclo $Win 1
    }

    lowerCanvas $Win
    set Win [expr 1 - $Win]
    update
    encycloSelectNode [.c$Win find withtag [getData]] $Win 1
    bell
    raiseCanvas $Win

    if {[llength [.c$Win find withtag active]] == 1} {
	encycloGameOver; return
    }
}

proc finishEncyclo {w player} {
    global LastNode FirstNode
    set node [.c$w find withtag active]
    makeLine $player $w $LastNode($w.$player) $node
    makeLine $player $w $node $FirstNode($w.$player)
    set player [expr 1 - $player]
    makeLine $player $w $LastNode($w.$player) $FirstNode($w.$player)
    .c$w itemconfig node -fill black -outline {}
}

proc encycloGameOver {} {
    global LastNode FirstNode Win

    finishEncyclo $Win 0
    raiseCanvas [expr 1 - $Win]
    
    gameOver
}

###############################################################################

proc nodeSelected w {
    global Game
    set node [.c$w find withtag current]
    if {$Game == "Insurance"} {
	insuranceSelectNode [.c$w find withtag current] $w 0
	insuranceNextTurn [lindex [.c$w gettags current] 0]
    } else {
	encycloSelectNode [.c$w find withtag current] $w 0
	encycloNextTurn [lindex [.c$w gettags current] 0]
    }
}

proc connectionBroke {} {
    global Opponent
    tk_dialog .foo {} "$Opponent took off.  Shutting down..." warning \
	0 "Fine, then"
    exit
}

proc getData {} {
    global Channel
    set msg [gets $Channel]
    while {[fblocked $Channel] && $msg == {}} {
	global DataReady
	set DataReady 0
	fileevent $Channel readable "set DataReady 1"
	vwait DataReady
	fileevent $Channel readable {}
	set msg [gets $Channel]
    }
    if [eof $Channel] connectionBroke
    if {$msg == ".exit"} connectionBroke
    return $msg
}

proc sendData msg {
    global Channel
    if [catch {puts $Channel $msg}] connectionBroke
    flush $Channel
}

proc niceExit {} {
    catch {sendData .exit}
    exit
}

proc winMessage {} {
    global Opponent Name
    set messes {
	"You crushed $Opponent!!"
	"Victory is yours!!"
	"You make this game look too easy!!"
	"A masterful game, $Name."
	"Do you give lessons?"
	"You have achieved glorious victory!!"
	"Try not to rub it in."
	"Jolly good show, old chap!"
	"Ho hum, another victory."
	"Ahh, one for the record books."
    }
    eval set msg \"[lindex $messes [expr int(rand() * [llength $messes])]]\"
    return $msg
}

proc loseMessage {} {
    global Opponent
    set messes {
	"You were, regrettably, annihilated."
	"It is a good day to lose."
	"Perhaps you should try not to lose so much."
	"Practice, practice..."
	"Would it help if you tried harder?"
	"Must be a bug in the scoring..."
	"Ouch.  I know how that feels."
	"All that effort and you still lost."
	"Maybe $Opponent could give you a few pointers."
	"I'm sure there are many other things you're good at..."
    }
    eval set msg \"[lindex $messes [expr int(rand() * [llength $messes])]]\"
    return $msg
}

proc gameOver {} {
    global Score Server
    if {$Score(0) < $Score(1) - 0.0001} {
	set msg [winMessage]
	set title "You Win"
    } elseif {$Score(0) > $Score(1) + 0.0001} {
	set msg [loseMessage]
	set title "You Lose"
    } else {
	set msg "It's a tie, how boring."
	set title "Tie Game"
    }

    if $Server {
	set code [tk_dialog .foo $title $msg {} 0 \
		      "New board" "Same board" "Back to work"]
	if {$code == 0} { 
	    newServerGame 0
	} elseif {$code == 1} {
	    newServerGame 1
	} else niceExit
    } else {
	set code [tk_dialog .foo $title $msg {} 0 \
		      "Play some more" "That's enough"]
	if {$code == 0} {
	    newClientGame
	} else niceExit
    }
}

###############################################################################

proc buildBoard win {
    global Points
    set i 0
    foreach p $Points {
	set x [lindex $p 0]
	set y [lindex $p 1]
	$win create oval $x $y [expr $x + 8] [expr $y + 8] -outline black \
	    -fill \#ddae200af0e4 -tags "n$i active node"
	incr i
    }
}

proc resetGame {} {
    global Score Scoref LastNode Win
    foreach i {0 1} {
	foreach var {Score Scoref LastNode} {
	    set ${var}($i) 0
	    set ${var}($i.0) 0
	    set ${var}($i.1) 0
	}
    }

    set Win 0
    showCanvas 0
}

proc clearCanvases {} {
    foreach i {0 1} {
      .c$i delete all
      lowerCanvas $i
    }
}

proc raiseCanvas n {
    .c$n configure -bg #d9d9d9
    .cb$n configure -relief raised
    .c$n bind active <ButtonPress> "nodeSelected $n"
}

proc lowerCanvas n {
    .c$n configure -bg grey60
    .cb$n configure -relief sunken
    .c$n bind active <ButtonPress> ""
}

proc showCanvas n {
    raiseCanvas $n
    lowerCanvas [expr 1 - $n]
}

proc positionWin w {
    set geo [split [wm geometry .] "x+"]
    set wgeo [split [wm geometry $w] "x+"]
    wm geometry $w "+[expr [lindex $geo 2] + ([lindex $geo 0] - [lindex $wgeo 0]) / 2]+[expr [lindex $geo 3] + ([lindex $geo 1] - [lindex $wgeo 0]) / 2]"
}

proc centerWin w {
    set width [winfo screenwidth .]
    set height [winfo screenheight .]
#    set wgeo [split [wm geometry $w] "x+"]
    set wgeo "200 100"
    wm geometry $w "+[expr ($width - [lindex $wgeo 0]) / 2]+[expr ($height - [lindex $wgeo 1]) / 2]"
}

proc selectGame {} {
    global NumPoints NP Game
    set NP $NumPoints
    toplevel .points
    wm title .points ""
    positionWin .points
    frame .points.g
    radiobutton .points.ins -text "Insurance" -variable Game -value Insurance
    radiobutton .points.enc -text "Encyclopedia" -variable Game \
	-value Encyclopedia
    pack .points.ins .points.enc -in .points.g -side left
    frame .points.t
    label .points.l -text "Number of Points:"
    entry .points.e -width 5 -textvariable NP
    pack .points.l .points.e -in .points.t -side left
    button .points.b -text Ok -command {destroy .points; set NumPoints $NP}
    pack .points.g
    pack .points.t .points.b -fill x -padx 5 -pady 5
    bind .points.e <Return> {.points.b invoke}
    .points.e selection range 0 end
    focus .points.e
#    grab set .points
    vwait NumPoints
    .c0 delete np
}

proc genPoints {} {
    global NumPoints
    set points {}
    for {set i 0} {$i < $NumPoints} {incr i} {
	set p "[expr rand() * 380 + 10] [expr rand() * 380 + 10]"
	lappend points $p
    }
    return $points
}

proc getReady {} {
    global Game NumPoints
    if {[tk_dialog .foo {} \
	     "Are you ready to play $Game with $NumPoints points?" \
	     questhead 0 "Let's Go!" "No, I'm Sick Of This"] == 0} {
	sendData go
    } else niceExit
}

proc openWaiting {} {
    global Opponent
    toplevel .wait
    wm title .wait ""
    label .wait.l -text "Waiting for $Opponent..."
    button .wait.abort -text "Forget It" -command niceExit
    pack .wait.l .wait.abort -padx 5 -pady 5 -fill x
    centerWin .wait
    grab set .wait
}

proc startGame {} {
    global Game
    buildBoard .c0
    buildBoard .c1
    resetGame
}

proc newServerGame same {
    global Points NumPoints Game
    clearCanvases
    if {!$same} {
	selectGame
	set Points [genPoints]
    }
    sendData $Game
    sendData $Points
    wm title . "$Game Salesman"
    openWaiting
    getData
    destroy .wait
    startGame
}

proc newClientGame {} {
    global Points NumPoints Game
    clearCanvases
    openWaiting
    set Game [getData]
    wm title . "$Game Salesman"
    set Points [getData]
    set NumPoints [llength $Points]
    destroy .wait
    getReady
    startGame
}

proc clientConnected {channel clientHost clientPort} {
    global ChatChannel Channel Name ServerChannel Opponent

    if {$ChatChannel == {}} {
	chatConnect $channel $clientHost $clientPort
    } else {
	set Channel $channel
	fconfigure $Channel -buffering none -blocking 0
	sendData $Name
	getOpponent
	#    puts "$Opponent connected from $clientHost"
	destroy .wait
	buildMainWindow
	close $ServerChannel
	newServerGame 0
    }
}

proc getOpponent {} {
    global Opponent
    set Opponent [getData]
}

set NumPoints 16
set Game Insurance

if {$argc >= 1} {set Name [lindex $argv 0]}
if {$argc >= 2} {set Host [lindex $argv 1]}
if {$argc >= 3} {set Port [lindex $argv 2]}

proc startServer {} {
    global Server Port ServerChannel
    set Server 1
    set ready 0
    toplevel .intro
    wm title .intro "Hosting Game"
    frame .intro.t
    label .intro.nl -text "Port:"
    entry .intro.ne -textvariable Port
    pack .intro.nl .intro.ne -in .intro.t -side left
    button .intro.start -text "Wait for Opponents" -command "set ready 1"
    pack .intro.t .intro.start -side top -pady 5 -padx 5 -fill x
    bind .intro.ne <Return> ".intro.start invoke"
    centerWin .intro
    vwait ready
    destroy .intro

    if [catch {set ServerChannel [socket -server clientConnected $Port]}] {
	tk_messageBox -message "Try choosing another port." -type ok \
	    -icon error
	return [startServer]
    }
    update
    toplevel .wait
    wm title .wait ""
    label .wait.l -text "Waiting for an opponent..."
    button .wait.abort -text "Forget It" -command exit
    pack .wait.l .wait.abort -padx 5 -pady 5 -fill x
    centerWin .wait
    grab set .wait
}

proc startClient {} {
    global Server Host Port Name Channel
    set Server 0
    set ready 0
    toplevel .intro
    wm title .intro "Joining Game"
    frame .intro.t1
    label .intro.sl -text "Host:"
    entry .intro.se -textvariable Host
    pack .intro.se .intro.sl -in .intro.t1 -side right
    focus .intro.se
    frame .intro.t2
    label .intro.nl -text "Port:"
    entry .intro.ne -textvariable Port
    pack .intro.ne .intro.nl -in .intro.t2 -side right
    button .intro.start -text "Start Game" -command "set ready 1"
    pack .intro.t1 .intro.t2 .intro.start -side top -pady 5 -padx 5 -fill x
    bind .intro.se <Return> ".intro.start invoke"
    bind .intro.ne <Return> ".intro.start invoke"
    centerWin .intro
    vwait ready
    destroy .intro

    if [catch {chatStartClient $Host $Port}] {
	tk_messageBox -message "Failed to connect to the server." -type ok \
	    -icon error
	return [startClient]
    }

    if [catch {set Channel [socket $Host $Port]}] {
	tk_messageBox -message "Failed to connect to the server." -type ok \
	    -icon error
	return [startClient]
    }
    fconfigure $Channel -buffering none -blocking 0
    sendData $Name
    getOpponent
    buildMainWindow
#    chatStartClient $Host $Port
    newClientGame
}

proc start server {
    global Name
    if {$Name == {}} {
	tk_messageBox -message "You must enter a player name." -type ok \
	    -icon error
	return
    }
    destroy .intro
    if {$server} startServer \
    else startClient
}

proc startUp {} {
    wm withdraw .
    toplevel .intro
    wm title .intro "Salesman"
    frame .intro.t
    label .intro.nl -text "Player Name:"
    entry .intro.ne -textvariable Name
    pack .intro.nl .intro.ne -in .intro.t -side left
    frame .intro.b
    button .intro.host -text "Host Game" -command "start 1"
    button .intro.join -text "Join Game" -command "start 0"
    pack .intro.host .intro.join -in .intro.b -side left -fill x -expand 1
    pack .intro.t .intro.b -side top -pady 5 -padx 5 -fill x
    centerWin .intro
}

###################################### CHAT ###################################

set ChatChannel {}
set ChatEmpty 1

proc chatBuildWindow {} {
    toplevel .chat
    wm title .chat "Chat"
    frame .chat.t -bd 2 -relief raised
    text .chat.text -width 80 -height 5 \
	-yscrollcommand ".chat.s set" -highlightthick 0 -state disabled
    scrollbar .chat.s -orient vert -command ".chat.text yview" \
	-highlightthick 0
    pack .chat.s -in .chat.t -side right -fill y
    pack .chat.text -in .chat.t -fill both -expand 1
    frame .chat.b -bd 2 -relief raised
    entry .chat.e -highlightthick 0 -textvariable ChatMessage
    pack .chat.e -in .chat.b -fill x
    pack .chat.b -side bottom -fill x
    pack .chat.t -fill both -expand 1
    bind .chat.e <Return> "chatSend"
    .chat.text tag configure other -foreground blue
    focus .chat.e
    raise .chat
}

proc chatInsert {message tag} {
    global ChatEmpty
    .chat.text config -state normal
    if {!$ChatEmpty} {
	.chat.text insert end "\n"
    } else {set ChatEmpty 0}
    .chat.text insert end $message $tag
    .chat.text yview end
    .chat.text config -state disabled
}

proc chatSend {} {
    global ChatChannel ChatMessage
    puts $ChatChannel $ChatMessage
    chatInsert $ChatMessage mine
    .chat.e delete 0 end
}

proc chatReceive {} {
    global ChatChannel
    while {[gets $ChatChannel message] != -1} {
	chatInsert $message other
    }
    if [eof $ChatChannel] stopChat
}

proc stopChat {} {
    global ChatChannel
    close $ChatChannel
    destroy .chat
}

proc chatConnect {channel clientHost clientPort} {
    global ChatChannel ChatServerChannel
    chatBuildWindow
#    if {$clientHost != {}} {close $ChatServerChannel}
    set ChatChannel $channel
    fconfigure $channel -blocking 0 -buffering line
    fileevent $channel readable chatReceive
}

#proc chatStartServer port {
#    global ChatServerChannel
#    chatBuildWindow
#    set ChatServerChannel [socket -server chatConnect $port]
#}

proc chatStartClient {host port} {
#    chatBuildWindow
    if [catch {set channel [socket $host $port]}] {
	return -code error
    }
    chatConnect $channel {} {}
}

###############################################################################

startUp