#############################################################################
#  ::Games::Sketch															#
#  ======================================================================== #
#	Original author: JeeBee <jonne_z REM0VEatTH1S users.sourceforge.net>	#
#	Contributors:															#
#   - Thanks to Bernd Breitenbach for letting me use his code that			#
#     implements the Hourglass (see bottom part of this file).				#
#############################################################################

# FIXME: support for automatically saving all drawings before
# clear canvas

# FIXME: Increase precision !!

# FIXME: Sketch: change statusbar into
# "Some player(s) have guessed the word correctly (displayed in green)."
# FIXME: When drawing while violate is clicked, drawing is still send when
# mouse is released later.

namespace eval ::Games::Sketch {

  variable HourGlass
  variable GameState
  variable Dict
  # Tolerance used for simplifying polylines
  variable eps 3
  variable eps2 9

  variable bkg_color "peach puff"
  variable err_bkg_color "firebrick3"
  variable eraser 0

  # Set round time (in seconds)
  set HourGlass(time_to_go)	180

  # Defaults for challenges
  variable __language "en"
  variable __languages
  variable __win_name

  ###########################################################################
  # config_array															#
  # ======================================================================= #
  # Return variables with default values that we want to store				#
  ###########################################################################
  proc config_array {} {
	return ""
  }

  ###########################################################################
  # build_config															#
  # ======================================================================= #
  # Pack configuration items into pane.										#
  # Return 0 if you don't want a pane for this game.						#
  ###########################################################################
  proc build_config { pane } {
	return 0
  }

  proc init_game { gameID host } {
	variable GameState
	set GameState($gameID,host) $host
	set challenge [game_configuration $gameID]
	return $challenge
  }

  proc set_init_game { gameID host game_init } {
	variable GameState

	set GameState($gameID,host) $host

	foreach rec [split $game_init ","] {
	  foreach {key value} [split $rec "="] {
		switch -exact $key {
		  "LANG" { set GameState($gameID,lang) $value }
		}
	  }
	}
  }

  proc quit {gameID} {
	variable GameState

	# Cancel possibly running hourglass
    if {$GameState($gameID,hg_animate) != ""} {
	  after cancel $GameState($gameID,hg_animate)
 	}

	::Games::SendQuit $gameID
	destroy .$GameState($gameID,win_name)
  }

  proc start_game { gameID } {
	variable GameState
	variable bkg_color

	set win_name [string map {"." "" ":" ""} $gameID]
	array set GameState [list \
	  "$gameID,round"			-1 \
	  "$gameID,scoredround"		[list] \
	  "$gameID,violations"		[list] \
	  "$gameID,old_x"			0 \
	  "$gameID,old_y"			0 \
	  "$gameID,sx"				0 \
	  "$gameID,sy"				0 \
	  "$gameID,current_color"	"sienna" \
	  "$gameID,current_pen"		4 \
	  "$gameID,drawing"			0 \
	  "$gameID,point_list"		{} \
	  "$gameID,spoint_list"		{} \
	  "$gameID,widget_list"		{} \
	  "$gameID,win_name"		$win_name ]

	toplevel .$win_name
    wm protocol .$win_name WM_DELETE_WINDOW "::Games::Sketch::quit $gameID"
    wm title .$win_name "[::Games::trans Sketch]"

	# The canvas
	canvas .$win_name.canvas -relief sunken -background $bkg_color \
	  -width 450 -height 400

	# Time
	labelframe .$win_name.time -text "[::Games::trans Time]"
	hourglass $gameID .$win_name.time.sandglass
	grid .$win_name.time.sandglass -in .$win_name.time

	# Wrong guesses of other players
	labelframe .$win_name.wrongguesses -text "[::Games::trans wrong_guesses]"
	for {set i 0} {$i < 10} {incr i} {
	  label .$win_name.wrongguesses.l$i -text ""
	  pack .$win_name.wrongguesses.l$i -in .$win_name.wrongguesses -anchor w
	}
	# Player list
	labelframe .$win_name.players -text "[::Games::trans players]"

	# Placekeeper to be filled with either draw options or guesses
	frame .$win_name.uc

	# Draw options
	labelframe .$win_name.uc.sk -text "[::Games::trans sketch_tools]"
	button .$win_name.uc.sk.selcolor -text "[::Games::trans Color]" \
	  -background $GameState($gameID,current_color) \
	  -command "::Games::Sketch::chooseColor $gameID .$win_name.uc.sk.selcolor"
	checkbutton .$win_name.uc.sk.eraser -text "[::Games::trans Eraser]" \
	  -variable ::Games::Sketch::eraser
	scale .$win_name.uc.sk.pensize -digit 1 -from 1 -to 41 -tickinterval 10 \
	  -orient h -variable ::Games::Sketch::GameState($gameID,current_pen)
	button .$win_name.uc.sk.clear -text "[::Games::trans Clear]" \
	  -command "::Games::Sketch::clearButton $gameID"
	button .$win_name.uc.sk.skip -text "[::Games::trans Skip]" \
	  -command "::Games::Sketch::skipButton $gameID"
	button .$win_name.uc.sk.btnsave1 -text "[::Games::trans Save]" \
	  -command "::Games::Sketch::save_canvas $gameID"
	pack .$win_name.uc.sk.selcolor .$win_name.uc.sk.eraser .$win_name.uc.sk.pensize \
	  .$win_name.uc.sk.clear .$win_name.uc.sk.skip \
	  .$win_name.uc.sk.btnsave1 -in .$win_name.uc.sk -side left -padx 20

	# Guesses
	labelframe .$win_name.uc.gr -text "[::Games::trans make_guesses]"
	entry .$win_name.uc.gr.guess
	bind .$win_name.uc.gr.guess <Return> ".$win_name.uc.gr.sendguess invoke"
	button .$win_name.uc.gr.sendguess -text "[::Games::trans Send]" \
	  -command "::Games::Sketch::sendGuess $gameID .$win_name.uc.gr.guess"
	button .$win_name.uc.gr.violates -text "[::Games::trans Violation]" \
	  -command "::Games::Sketch::violateButton $gameID"
	button .$win_name.uc.gr.btnsave2 -text "[::Games::trans Save]" \
	  -command "::Games::Sketch::save_canvas $gameID"
	pack .$win_name.uc.gr.guess .$win_name.uc.gr.sendguess .$win_name.uc.gr.violates \
	  .$win_name.uc.gr.btnsave2 -in .$win_name.uc.gr -side left -padx 20

	# Status
	labelframe .$win_name.status -text "[::Games::trans status]"
	label .$win_name.status.lbl -text "[::Games::trans wait_for_host]" -anchor w
	pack .$win_name.status.lbl -in .$win_name.status -fill both -expand 1
	# And a start button for the host only
	if {$GameState($gameID,host) == [::config::getKey login]} {
	  .$win_name.status.lbl configure -text "[::Games::trans wait_for_players]"
	  button .$win_name.start -text "[::Games::trans Start]" \
		-command "::Games::Sketch::start_now $gameID"
	  pack .$win_name.start -in .$win_name.status -side right
	}

	grid .$win_name.time -sticky news
	grid .$win_name.canvas -row 0 -column 1
	grid .$win_name.wrongguesses -row 0 -column 2 -sticky news
	grid ^ ^ .$win_name.players -sticky news
	grid .$win_name.uc - - -sticky news
	grid .$win_name.status - - -sticky news
	grid rowconfigure .$win_name {1 2 3} -weight 1
	grid columnconfigure .$win_name {0 2} -weight 1

	# Set initial width (wider for players list, higher for usercontrols)
	::Games::moveinscreen .$win_name

	# Check if players were already added before game start
	if {[info exists GameState($gameID,addplayers)]} {
	  foreach {player score} $GameState($gameID,addplayers) {
		update_scores $gameID $player $score
	  }
	}
  }

  # 'player' says the drawer violates drawing rules
  proc addViolation {gameID player} {
	variable GameState

	if {$GameState($gameID,host) == [::config::getKey login]} {
	  # We are the host, player says drawer violated drawing rules
	  if {[lsearch -exact $GameState($gameID,violations) $player] == -1} {
	    lappend GameState($gameID,violations) $player
	    # Check whether this ends the current round
		set cnt_v [llength $GameState($gameID,violations)]
		set cnt_p [llength $GameState($gameID,players)]
		if {$cnt_v >= [expr {($cnt_p + 1)/2}]} {
		  # Majority of guessers clicked Violate button.
		  # Skipping round, no points for the drawer this round.
		  set GameState($gameID,scoredround) [list]
          skipButton $gameID
		}
	  }
	}
  }

  proc violateButton {gameID} {
	variable GameState
    addViolation $gameID [::config::getKey login]
	::Games::SendMove $gameID "VIOLATE=[::config::getKey login]"
  }

  proc save_canvas {gameID} {
	variable GameState
	set win_name $GameState($gameID,win_name)
	# Ask user where to save the photo
	set filename [chooseFileDialog "" "[::Games::trans save_drawing]" .$win_name "" save \
	  [list [list "EPS" [list *.eps *.EPS]] [list [trans allfiles] *]]]
	# Save Encapsulated Postscript
	if {"$filename" != ""} {
	  ::Games::log "Saving canvas to $filename for game $gameID"
	  catch { .$win_name.canvas postscript -file $filename }
	}
  }

  proc loadDictionary {langKey} {
	variable Dict
	
	# Check if global dictionary already read.
	if {![info exists Dict($langKey)] || \
        [llength $Dict($langKey)] == 0} {

	  # Save plugin's lang
	  array set plugin_lang [array get ::Games::lang]
	  array unset ::Games::lang

	  set Dict($langKey) [list]
	  set langDir [file join $::Games::dir "lang"]
	  ::Games::load_lang $langKey $langDir

	  foreach {name value} [array get ::Games::lang] {
		if {[string first "word_" $name] == 0 &&
            [string is digit [string range $name 5 end]]} {
		  lappend Dict($langKey) $value
		}
	  }

	  ::Games::log "Sketch dictionary for $langKey read, \
					contains [llength $Dict($langKey)] words."

	  # Restore plugin's lang
	  array unset ::Games::lang
	  array set ::Games::lang [array get plugin_lang]
	}

	return [llength $Dict($langKey)]
  }

  proc select_word {gameID} {
	variable GameState
	variable Dict

	set word_cnt [loadDictionary $GameState($gameID,lang)]
	if {$word_cnt > 0} {
	  # Select a word at random
	  set r [myRand 0 [expr {$word_cnt-1}]]
	  set GameState($gameID,word) [lindex $Dict($GameState($gameID,lang)) $r]
	} else {
	  ::Games::log "Update your language files for the Sketch dictionary! \
					(it is empty for the language that your are using in game ${gameID})"
	  set GameState($gameID,word) "error, my, dictionary, is, empty"
	}
  }

  # Next drawer is set to $r here. However, if that player left the game
  # we keep increasing
  proc select_next_drawer {gameID r} {
	variable GameState
	set win_name $GameState($gameID,win_name)
	set next [expr {$r % [llength $GameState($gameID,players)]}]
	set nextp [lindex $GameState($gameID,players) $next]
	set stop $next
	
	# Check whether player is still in players
	while {[lsearch -exact $GameState($gameID,players) $nextp] == -1} {
	  set next [expr {($next + 1) % [llength $GameState($gameID,players)]}]
	  set nextp [lindex $GameState($gameID,players) $next]
	  if {$stop == $next} {
		# Everybody left???
		break
	  }
	}

	# Give the drawer 10 points for drawing
	set nexts [lsearch -exact $GameState($gameID,scores) $nextp]
	set score [lindex $GameState($gameID,scores) [expr {$nexts+1}]]
	set new_score [expr {$score + 10}]
	::Games::SendMove $gameID "PLAYER=$nextp,SCORE=$new_score"
	update_scores $gameID $nextp $new_score

	# Clearing the canvas for the next round
	clearButton $gameID

	set GameState($gameID,draweridx) $next
	set GameState($gameID,drawer) $nextp
  }

  proc reset_player_colors {gameID} {
	variable GameState
	set win_name $GameState($gameID,win_name)
	set i 0
	while {[winfo exists .$win_name.player$i]} {
	  set pcol [.$win_name.player$i cget -foreground]
	  if {$pcol != "gray"} {
		.$win_name.player$i configure -foreground black
	  }
	  incr i ; incr i
	}
  }

  proc start_now {gameID} {
	variable GameState

	incr GameState($gameID,round)
	set GameState($gameID,credit) 10
	set GameState($gameID,scoredround) [list]
	set GameState($gameID,violations) [list]

	set round $GameState($gameID,round)
	set win_name $GameState($gameID,win_name)

	if {![winfo exists .$win_name]} {
	  # We closed the window already, so bye bye
	  return
	}
	reset_player_colors $gameID

	if { $GameState($gameID,round) == 0 && \
		 $GameState($gameID,host) == [::config::getKey login] } {

	  set r [myRand 0 [expr {[llength $GameState($gameID,players)]-1}]]
	  select_next_drawer $gameID $r
	  ::Games::SendMove $gameID "DRAWER=$GameState($gameID,drawer)"
	  pack forget .$win_name.start
	} elseif {$GameState($gameID,host) == [::config::getKey login]} {
	  select_next_drawer $gameID [expr {$GameState($gameID,draweridx) + 1}]
	  ::Games::SendMove $gameID "DRAWER=$GameState($gameID,drawer)"
	}

	if {$GameState($gameID,drawer) == [::config::getKey login]} {
	  select_word $gameID
	  catch { pack forget .$win_name.uc.gr }
	  pack .$win_name.uc.sk -in .$win_name.uc -fill both -expand 1
	  bind .$win_name.canvas <ButtonPress>   "::Games::Sketch::ButtonPress   $gameID %x.0 %y.0"
	  bind .$win_name.canvas <ButtonRelease> "::Games::Sketch::ButtonRelease $gameID %x.0 %y.0"
	  bind .$win_name.canvas <Motion>        "::Games::Sketch::MouseMotion   $gameID %x.0 %y.0"
	  bind .$win_name.canvas <Leave>         "::Games::Sketch::MouseLeave    $gameID %x.0 %y.0"
	  .$win_name.status.lbl configure -text \
		"[::Games::trans Round] ${round}: [::Games::trans you_draw $GameState($gameID,word)]"
	} else {
	  catch { pack forget .$win_name.uc.sk }
	  pack .$win_name.uc.gr -in .$win_name.uc -fill both -expand 1
	  set GameState($gameID,drawing) 0
 	  bind .$win_name.canvas <ButtonPress>   ""
	  bind .$win_name.canvas <ButtonRelease> ""
	  bind .$win_name.canvas <Motion>        ""
	  bind .$win_name.canvas <Leave>         ""
	  .$win_name.status.lbl configure -text \
		"[::Games::trans Round] ${round}: [::Games::trans you_guess $GameState($gameID,lang)]"
	}
	# Hourglass will be restarted when drawer starts drawing
	stop_hour_glass $gameID .$win_name.time.sandglass
	set GameState($gameID,hg_running) 0
  }

  proc opponent_moves { gameID sender move } {
	variable GameState

	# Could be we left already, then our window does not exist anymore
	set win_name $GameState($gameID,win_name)
	if {![winfo exists .$win_name]} {
	  return
	}

	#::Games::log "Received from $sender : $move"
	foreach rec [split $move ","] {
	  foreach {key value} [split $rec "="] {
		switch -exact $key {
		  "PEN"		{set opponent_pen $value}
		  "COLOR"	{set opponent_color $value}
		  "COORDS"	{ if {$GameState($gameID,hg_running) == 0} {
						start_hour_glass $gameID .$win_name.time.sandglass
						set GameState($gameID,hg_running) 1
					  }
					  .$GameState($gameID,win_name).canvas create line $value \
					    -smooth bezier -fill $opponent_color -width $opponent_pen
					}
		  "CLEAR"	{clearCanvas $gameID}
		  "DRAWER"	{set GameState($gameID,drawer) $value
					 start_now $gameID}
		  "GUESS"	{processGuess $gameID $sender $value}
		  "PLAYER"	{set player $value ; set sol ""}
		  "SOL"		{set sol $value}
		  "SCORE"	{update_scores $gameID $player $value $sol}
		  "WRONG"	{add_wrong_guess $gameID $value}
		  "SKIPPED" {roundSkipped $gameID}
		  "VIOLATE" {addViolation $gameID $sender}
		}
	  }
	}
  }

  proc guessOK {gameID guess word} {
	set s1 [string map {" " ""} $guess]
	set s1 [string tolower $s1]

	set s2 [string map {" " ""} $word]
	set s2 [string tolower $s2]

	# FIXME: Does Tcl has something as sounds_like?
	# FIXME: Is it ok if 95% of the chars match?
	if {$s1 == $s2} {
	  return 1
	} else {
	  return 0
	}
  }

  proc add_wrong_guess {gameID wrong} {
	variable GameState

	set win_name $GameState($gameID,win_name)

	# Move all wrong guesses one up
	for {set i 0} {$i < 9} {incr i} {
	  set j [expr {$i+1}]
	  set jlbl [.$win_name.wrongguesses.l$j cget -text]
	  .$win_name.wrongguesses.l$i configure -text "$jlbl"
	}

	# Put current wrong guess at the bottom
	.$win_name.wrongguesses.l9 configure -text "$wrong"
  }

  proc processGuess {gameID sender guess} {
	variable GameState

	set state 0
	if {$GameState($gameID,drawer) == [::config::getKey login]} {

	  if {[lsearch -exact $GameState($gameID,scoredround) $sender] > -1} {
	    # sender already scored in this round, ignore its guesses
		return
	  }

	  foreach word [split $GameState($gameID,word) ","] {
		if {[guessOK $gameID $guess $word]} {
		  set state 1
		  break
		}
	  }
	  if {$state} {
		foreach {player score} $GameState($gameID,scores) {
		  if {$player == $sender} {
			set score [expr {$score + $GameState($gameID,credit)}]
			set GameState($gameID,credit) [expr \
			  {($GameState($gameID,credit) + 1) / 2}]
			set sol [string map {{,} {}} $GameState($gameID,word)]
			::Games::SendMove $gameID "PLAYER=$player,SOL=$sol,SCORE=$score"
			update_scores $gameID $sender $score $sol
			break;
		  }
		}
	  } else {
		# Wrong guess, notify everyone
		::Games::SendMove $gameID "WRONG=$guess"
		add_wrong_guess $gameID $guess
	  }
	}
  }

  proc add_player { gameID player } {
	variable GameState
	if {[info exists GameState($gameID,win_name)]} {
	  update_scores $gameID $player -1
	} elseif {[info exists GameState($gameID,addplayers)]} {
	  set GameState($gameID,addplayers) \
		[concat $GameState($gameID,addplayers) [list $player -1]]
	} else {
	  set GameState($gameID,addplayers) [list $player -1]
	}
  }

  proc update_scores { gameID player score {sol ""}} {
	variable GameState

	set win_name $GameState($gameID,win_name)
	set nick [::Games::getNick $player]

	set scores {}
	if {[info exists GameState($gameID,scores)]} {
	  set scores $GameState($gameID,scores)
      set players $GameState($gameID,players)
	}

	if { [::config::getKey login] == $player && "$sol" != "" } {
	  .$win_name.status.lbl configure -text \
		"[::Games::trans correct_guess $sol]"
	}

	if {"$sol" != ""} {
	  lappend GameState($gameID,scoredround) $player
	}

	set i 0
	set found 0
	foreach {p s} $scores {
	  if {$p == $player} {
		set found 1
		if {$score > -1} {
		  .$win_name.player$i configure -text "$nick ([::Games::trans points $score])."
		  .$win_name.player$i configure -foreground "dark green"
		  set scores [lreplace $scores $i [expr {$i+1}] $player $score]
		  break
		}
	  }
	  incr i ; incr i
	}
	if {!$found} {
	  if {$score == -1} {set score 0}
	  label .$win_name.player$i -text "$nick ([::Games::trans points $score])."
	  pack .$win_name.player$i -in .$win_name.players -anchor w
	  lappend scores $player $score
	  lappend players $player
	}

	# Sort players by decreasing score
	for { set i 0 } { $i < [llength $scores] } { incr i ; incr i } {
	  set chat_i [lindex $scores $i]
	  set score_i [lindex $scores [expr {$i+1}]]
	  for { set j [expr {$i+2}] } { $j < [llength $scores] } { incr j ; incr j } {
		set chat_j [lindex $scores $j]
		set score_j [lindex $scores [expr {$j+1}]]
		if {$score_j > $score_i} {
		  # Swap i and j in $scores
		  set scores [lreplace $scores $i [expr {$i+1}] $chat_j $score_j]
		  set scores [lreplace $scores $j [expr {$j+1}] $chat_i $score_i]
		  # Swap i and j in player list
		  set fg_i [.$win_name.player$i cget -foreground]
		  set fg_j [.$win_name.player$j cget -foreground]
		  .$win_name.player$i configure \
			-text "[::Games::getNick $chat_j] ([::Games::trans points $score_j])."
		  .$win_name.player$i configure -foreground $fg_j
		  .$win_name.player$j configure \
			-text "[::Games::getNick $chat_i] ([::Games::trans points $score_i])."
		  .$win_name.player$j configure -foreground $fg_i
		}
	  }
	}

	set GameState($gameID,scores) $scores
	set GameState($gameID,players) $players
  }

  proc opponent_quits { gameID chatid } {
	variable GameState

	set win_name $GameState($gameID,win_name)
	if {![winfo exists .$win_name]} {
	  # We quitted first, lalala
	  return;
	}

	# Gray out label of the player that left.
	set i 0
	foreach {p s} $GameState($gameID,scores) {
	  if {$p == $chatid} {
		.$win_name.player$i configure -foreground gray
		break
	  }
	  incr i ; incr i
	}
	# Remove this player from players
	set pi [lsearch -exact $GameState($gameID,players) $chatid]
	if {$pi != -1} {
	  set GameState($gameID,players) \
		[lreplace $GameState($gameID,players) $pi $pi]
	}
  }

  proc time_elapsed {gameID} {
	variable GameState
	
	if {$GameState($gameID,host) == [::config::getKey login]} {
	  roundSkipped $gameID
	}
  }

  proc sendGuess {gameID entry} {
	variable GameState

	set guess [$entry get]
	$entry delete 0 end

	if {$GameState($gameID,drawer) != [::config::getKey login]} {
	  # FIXME: Verify that we are not sending illegal characters that will
	  # not arrive. Must work for different languages as well! This tag is
	  # related to the one about protecting against injected code!
	  set guess [string map {{,} {} {[} {} {]} {} {$} {} {=} {}} $guess]
	  ::Games::SendMove $gameID "GUESS=$guess"
	}
  }

  proc chooseColor {gameID widget} {
	variable GameState
	set new_color [tk_chooseColor -title "[::Games::trans choose_bkgcol]" \
	  -parent .$GameState($gameID,win_name)]
	if {"$new_color" != ""} {
	  set GameState($gameID,current_color) $new_color
	}
	$widget configure -background $GameState($gameID,current_color)
  }

  proc clearButton {gameID} {
	::Games::SendMove $gameID "CLEAR=ALL"
	clearCanvas $gameID
  }

  # Skip current round
  proc roundSkipped {gameID} {
	variable GameState

	if {$GameState($gameID,host) == [::config::getKey login]} {
	  # We are the host
	  if {[llength $GameState($gameID,scoredround)] == 0} {
		# Nobody guessed correctly this round
		# Subtract 10 points from the drawer!
		set idx [lsearch -exact $GameState($gameID,scores) $GameState($gameID,drawer)]
		set score [lindex $GameState($gameID,scores) [expr {$idx+1}]]
		set new_score [expr {$score - 10}]
		set player $GameState($gameID,drawer)
	    update_scores $gameID $player $new_score
	    ::Games::SendMove $gameID "PLAYER=$player,SCORE=$new_score"
	  }
	  start_now $gameID
	}
  }

  # Drawer pressed the Skip button
  # Also invoked due to violation
  proc skipButton {gameID} {
	variable GameState

	if {$GameState($gameID,host) == [::config::getKey login]} {
	  roundSkipped $gameID
	} else {
	  ::Games::SendMove $gameID "SKIPPED=1"
	}
  }

  proc clearCanvas {gameID} {
	variable GameState
    .$GameState($gameID,win_name).canvas delete all
  }

  proc MouseMotion {gameID x y} {
	variable GameState
	variable eps2
	variable eraser

	if {$eraser} {
	  set the_color $::Games::Sketch::bkg_color
	} else {
	  set the_color $GameState($gameID,current_color)
	}

	if {$GameState($gameID,drawing) && $GameState($gameID,old_x) != -1} {
	  lappend GameState($gameID,widget_list) \
    	[.$GameState($gameID,win_name).canvas create line \
		  $GameState($gameID,old_x) $GameState($gameID,old_y) $x $y \
		  -fill $the_color -width $GameState($gameID,current_pen)]

	  # Vertex reduction: 
	  # only add point_list if it's $eps away from sx,sy
	  if {[expr {($GameState($gameID,sx)-$x)*($GameState($gameID,sx)-$x) + \
                ($GameState($gameID,sy)-$y)*($GameState($gameID,sy)-$y) >= $eps2}]} {

		lappend GameState($gameID,point_list) $x $y
		set GameState($gameID,sx) $x
		set GameState($gameID,sy) $y
	  }
 	}
	set GameState($gameID,old_x) $x
	set GameState($gameID,old_y) $y
  }

  proc MouseLeave {gameID x y} {
	# Stop drawing by pretending a ButtonRelease
	ButtonRelease $gameID $x $y
  }

  proc ButtonPress {gameID x y} {
	variable GameState

	array set GameState [list \
	  "$gameID,drawing"			1 \
	  "$gameID,old_x"			$x \
	  "$gameID,old_y"			$y \
	  "$gameID,sx"				$x \
	  "$gameID,sy"				$y \
	  "$gameID,point_list"		[list $x $y] \
	  "$gameID,widget_list"		{} ]
  }

  proc ButtonRelease {gameID x y} {
	variable GameState
	variable eraser

	if {$GameState($gameID,drawing)} {
	  set win_name $GameState($gameID,win_name)
	  set GameState($gameID,drawing) 0

	  lappend GameState($gameID,point_list) $x $y

	  # Simplify polyline
	  simplify_polyline $gameID
	  
	  # Fixing a small problem that single points don't seem to get drawn
	  if {[llength $GameState($gameID,spoint_list)] == 4 && \
		  [lindex $GameState($gameID,spoint_list) 0] == \
		  [lindex $GameState($gameID,spoint_list) 2] && \
		  [lindex $GameState($gameID,spoint_list) 1] == \
		  [lindex $GameState($gameID,spoint_list) 3] } {
		set GameState($gameID,spoint_list) \
		  [lreplace $GameState($gameID,spoint_list) 0 0 \
		  [expr {[lindex $GameState($gameID,spoint_list) 0] + 1}]]
	  }

	  # Remove current drawing in widget_list
	  foreach w $GameState($gameID,widget_list) {
		.$win_name.canvas delete $w
	  }

	  if {$eraser} {
		set the_color $::Games::Sketch::bkg_color
	  } else {
		set the_color $GameState($gameID,current_color)
	  }

	  if {[llength $GameState($gameID,point_list)] >= 4} {
		# Draw squared spline approximation after Vertex Reduction
		#.$win_name.canvas create line $GameState($gameID,point_list) \
		#  -smooth bezier -fill $the_color -width $GameState($gameID,current_pen)
		# Draw squared spline approximation after Douglas-Peucker algorithm
		.$win_name.canvas create line $GameState($gameID,spoint_list) \
		  -smooth bezier -fill $the_color -width $GameState($gameID,current_pen)
	  }

	  # Send to other players
	  set info "PEN=$GameState($gameID,current_pen)"
	  set info "${info},COLOR=$the_color"
	  if {$GameState($gameID,hg_running) == 0} {
		start_hour_glass $gameID .$win_name.time.sandglass
		set GameState($gameID,hg_running) 1
	  }
	  ::Games::SendMove $gameID "${info},COORDS=$GameState($gameID,spoint_list)"
	}
  }

  # Simplifies the polyline in list point_list
  proc simplify_polyline {gameID} {
	variable GameState
	set GameState($gameID,spoint_list) {}

	set N [llength $GameState($gameID,point_list)]
	set pstart_x [lindex $GameState($gameID,point_list) 0]
	set pstart_y [lindex $GameState($gameID,point_list) 1]
	set pend_x   [lindex $GameState($gameID,point_list) [expr {$N-2}]]
	set pend_y   [lindex $GameState($gameID,point_list) [expr {$N-1}]]

	if {$N >= 4} {
	  set spoint_list_dot0 [concat \
		[list $pstart_x $pstart_y] \
		[DPsimplify $gameID 0 [expr {$N-2}]] \
		[list $pend_x $pend_y]]
	}
	foreach c $spoint_list_dot0 {
	  # Strip useless .0 now
	  set c [string range $c 0 [expr {[string length $c] - 3}]]
	  lappend GameState($gameID,spoint_list) $c
	}
  }

  # Douglas-Peucker recursive simplification routine
  # Returns list of new points
  proc DPsimplify {gameID pstart pend} {
	variable GameState
	# eps2 is the tolerance eps squared
	variable eps2

	set pstart_x [lindex $GameState($gameID,point_list) $pstart]
	set pstart_y [lindex $GameState($gameID,point_list) [expr {$pstart+1}]]
	set pend_x   [lindex $GameState($gameID,point_list) $pend]
	set pend_y   [lindex $GameState($gameID,point_list) [expr {$pend+1}]]
	set u_x      [expr {$pend_x - $pstart_x}]
	set u_y      [expr {$pend_y - $pstart_y}]
	set cu       [expr {$u_x * $u_x + $u_y * $u_y}]

	# maxi is the point farthest from line pstart - pend
	set maxi [expr {$pstart+2}]
	# maxd2 is distance squared from maxi to line pstart - pend
	set maxd2 0

    for {set i $maxi} {$i < $pend} {incr i ; incr i} {
	  # Compute distance from i to line
	  set i_x [lindex $GameState($gameID,point_list) $i]
	  set i_y [lindex $GameState($gameID,point_list) [expr {$i+1}]]
	  set w_x [expr {$i_x - $pstart_x}]
	  set w_y [expr {$i_y - $pstart_y}]
	  set cw  [expr {$w_x * $u_x + $w_y * $u_y}]
	  if { $cw <= 0 } {
		set dv2 [expr {($i_x - $pstart_x) * ($i_x - $pstart_x) + \
                      ($i_y - $pstart_y) * ($i_y - $pstart_y)}]
	  } elseif { $cu <= $cw } {
		set dv2 [expr {($i_x - $pend_x) * ($i_x - $pend_x) + \
                      ($i_y - $pend_y) * ($i_y - $pend_y)}]
	  } else {
		set b [expr {$cw / $cu}]
		set pb_x [expr {$pstart_x + $b * $u_x}]
		set pb_y [expr {$pstart_y + $b * $u_y}]
		set dv2 [expr {($i_x - $pb_x) * ($i_x - $pb_x) + \
                       ($i_y - $pb_y) * ($i_y - $pb_y)}]
	  }
	  # Test if i is farthest from line pstart - pend
	  if {$dv2 > $maxd2} {
		set maxi $i
		set maxd2 $dv2
	  }
	}

	# Check whether error is worse than eps2
	if { $maxd2 > $eps2 } {
	  # Do recursion
	  set maxi_x [lindex $GameState($gameID,point_list) $maxi]
	  set maxi_y [lindex $GameState($gameID,point_list) [expr {$maxi+1}]]
	  set result [concat \
		[DPsimplify $gameID $pstart $maxi] \
		[list $maxi_x $maxi_y] \
		[DPsimplify $gameID $maxi $pend]]
	} else {
	  # Ignoring all points in between
	  set result {}
	}

	return $result
  }

  # =================================================
  # game_configuration
  # -------------------------------------------------
  # Specify game configuration
  # =================================================
  proc game_configuration { gameID } {
	variable GameState
	variable __language
	variable __languages
	variable __win_name

	set win_name [string map {"." "" ":" ""} $gameID]
	set __win_name $win_name

	# Load languages (do this first, don't want a window yet if sourceforge is slow)
	set languages [list]
	::lang::LoadOnlineVersions

    toplevel .${win_name}_gc
    wm title .${win_name}_gc "[::Games::trans select_language]"
    wm protocol .${win_name}_gc WM_DELETE_WINDOW ".${win_name}_gc.cancel invoke"

	# Process languages
    foreach langcode $::lang::Lang {
      set name [::lang::ReadLang $langcode name]
      lappend languages [list "$name" "$langcode"]
    }
    set languages [lsort -index 0 -dictionary $languages]
	set __languages $languages
	
	# Language listbox
	frame .${win_name}_gc.langfrm
	listbox .${win_name}_gc.langfrm.items -yscrollcommand ".${win_name}_gc.langfrm.ys set" \
	  -font splainf -background white -relief flat -highlightthickness 0 -width 60
    scrollbar .${win_name}_gc.langfrm.ys -command ".${win_name}_gc.langfrm.items yview" \
	  -highlightthickness 0 -borderwidth 1 -elementborderwidth 1
    pack .${win_name}_gc.langfrm.ys -in .${win_name}_gc.langfrm -side right -fill y
    pack .${win_name}_gc.langfrm.items -in .${win_name}_gc.langfrm -side left -expand true -fill both

	set default_lang -1
	for { set i 0 } { $i < [llength $languages] } { incr i } {
	  set item [lindex $languages $i]
      .${win_name}_gc.langfrm.items insert end [lindex $item 0]
	  if {[lindex $item 1] == $__language} {
		set default_lang $i
	  }
	}
	if {$default_lang >= 0} {
	  .${win_name}_gc.langfrm.items selection set $default_lang
	}

	# Challenge and cancel button
    frame .${win_name}_gc.buttons
    button .${win_name}_gc.ok -text "[::Games::trans challenge]" -command {
	  set sel [.${::Games::Sketch::__win_name}_gc.langfrm.items curselection]
	  set sel_item [lindex $::Games::Sketch::__languages $sel]
      set ::Games::Sketch::__language [lindex $sel_item 1]
    }
    button .${win_name}_gc.cancel -text "[::Games::trans cancel]" -command {
      set ::Games::Sketch::__language ""
    }

    pack .${win_name}_gc.cancel .${win_name}_gc.ok -in .${win_name}_gc.buttons -side right
	pack .${win_name}_gc.langfrm -fill both -expand true -padx 4 -pady 4
	pack .${win_name}_gc.buttons -padx 4 -pady 4
    ::Games::moveinscreen .${win_name}_gc

    update idletask
    grab set .${win_name}_gc
    tkwait variable ::Games::Sketch::__language
    destroy .${win_name}_gc

	set GameState($gameID,lang) $__language
	if {"$__language" == ""} {
	  return ""
	} else {
	  set word_cnt [loadDictionary $GameState($gameID,lang)]
	  if {$word_cnt == 0} {
		::amsn::infoMsg "[::Games::trans empty_dictionary]" warning
		return ""
	  } else {
        return "LANG=$GameState($gameID,lang)"
	  }
	}
  }

# =========================================================================
# Hourglass code
#
# Original author: Bernd Breitenbach
#
# The following code is used with permission from the original author
# and slightly modified to fit in this game. The original version can be
# obtained at http://www.five-o-clock.de/fragments/
# =========================================================================

set HourGlass(hglass_full) {R0lGODlhUADwAOcAAAoOFHZ+jLa2tEZGRJqalF5iZGpyfNLSzCoqLIqOlKqqpMbGxIZ+hFJWVGJq
[encoded data, 14553 characters]
2KZraqhsuqZr3I4C5pruEa7u3E7u7ebu7vbu7wbv8Bbv8Sbv8paMgAAAOw==}

set HourGlass(hglass_empty) {R0lGODlhUADwAOcAAGVod2ZpemdqeWdqe2hremhrfGlse2lsfWRndmptfmtuf2xvgGptfG1wgW5x
[encoded data, 10164 characters]
+k+AAsCk97NoSlW6Upa21KUvhWlMZTpTmq4pIAA7}

set HourGlass(hglass_1) {R0lGODlhUADwAMYAAFpebLKyvIaKjHJ2hJqepHqCjGZqdJKWlNra5HZ+jKaqrG5yfI6SlM7O1Hp6
[encoded data, 9086 characters]
vxevzHLLLr8Mc8wyz0xzzTbffHMgADs=}

set HourGlass(hglass_2) {R0lGODlhUADwAMYAAFpebLKytIaKjHJ2hJqenHqCjGZqdJKWlNra3HZ+jHJyfI6SlG5yfHp6hKqq
[encoded data, 9009 characters]
2oG5HfRLggjW5ptvqeiKIsq9Cv8h28IOPwxxxBJPTHHFFl+Mccb1BAIAOw==}

set HourGlass(hglass_3) {R0lGODlhUADwAMYAAFpebK6ytIaKjHJ2hJqenHqCjGZqdJKWnN7e3HZ+jG5yfMLGzJKSlKaqrIKC
[encoded data, 9009 characters]
km6/BrDmZb8CD0xwwQYfjHDCCi/McMOtBQIAOw==}

set HourGlass(hglass_4) {R0lGODlhUADwAMYAAFpebLKytIaKjG52hJqepHqCjGZqdNre5JKWnHp6hMLGzG5yfI6SlIaClHZ+
[encoded data, 9240 characters]
Tnjhhh8ueCAAOw==}

set HourGlass(hglass_5) {R0lGODlhUADwAMYAAFpebK6ytIaKjG52hJqenHqCjGZqdNra3JKWnHp6hKaqrMLGzG5yfI6SlHZ+
[encoded data, 9240 characters]
7bYTVxD+thhvD3OD26MC8cDgZwdeaA/3Uo555ppvznnnnn8OeuiiRxwIADs=}

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

  proc animate {gameID widget} {
	variable GameState
	variable HourGlass

	incr GameState($gameID,hg_wc)
	if { $GameState($gameID,hg_wc) > 5 } { set GameState($gameID,hg_wc) 1 }

	set time_gone [expr {[clock seconds] - $GameState($gameID,hg_tstart)}]
	if { $time_gone <= $GameState($gameID,hg_time_to_go) } {
	  $widget itemconfigure $GameState($gameID,hg_secs) \
		-text [expr {$GameState($gameID,hg_time_to_go) - $time_gone}]
	  set new_fallen [expr {int($time_gone * $HourGlass(quantity) / \
		double($GameState($gameID,hg_time_to_go)))}]
  
	  if { $new_fallen > $GameState($gameID,hg_sand_fallen) } {
		set GameState($gameID,hg_sand_fallen) $new_fallen
		if { $GameState($gameID,hg_sand_fallen) < $HourGlass(above_cone) } {
		  set upper_mark [expr {$HourGlass(cone_start) - $HourGlass(above_cone) + \
			$GameState($gameID,hg_sand_fallen)}]
		} else {
		  set h [expr {($GameState($gameID,hg_sand_fallen) - $HourGlass(above_cone))}]
		  set ch [expr {$HourGlass(cone_end) - $HourGlass(cone_start)}]
		  set hx [expr {( 9 * $h * $h ) / $ch} ]
		  set upper_mark [expr {$HourGlass(cone_start) + $hx}]
		}
		set GameState($gameID,hg_lower_mark) \
		  [expr {$HourGlass(bottom_mark) - $GameState($gameID,hg_sand_fallen)}]
		$GameState($gameID,hg_img_current) copy $HourGlass(img_empty) \
		  -from 0 0 $HourGlass(width) $upper_mark -to 0 0 
		$GameState($gameID,hg_img_current) copy $HourGlass(img_full) \
		  -from 0 $upper_mark $HourGlass(width) $HourGlass(half_mark) -to 0 $upper_mark
		$GameState($gameID,hg_img_current) copy $HourGlass(img,$GameState($gameID,hg_wc)) \
		  -from 0 $HourGlass(half_mark) $HourGlass(width) $GameState($gameID,hg_lower_mark) \
		  -to 0 $HourGlass(half_mark)
		$GameState($gameID,hg_img_current) copy $HourGlass(img_full) \
		  -from 0 $GameState($gameID,hg_lower_mark) $HourGlass(width) $HourGlass(height) \
		  -to 0 $GameState($gameID,hg_lower_mark)
	  } else {
		$GameState($gameID,hg_img_current) copy $HourGlass(img,$GameState($gameID,hg_wc)) \
		  -from 0 $HourGlass(half_mark) $HourGlass(width) $GameState($gameID,hg_lower_mark) \
		  -to 0 $HourGlass(half_mark)
	  }
	} elseif { [expr {$GameState($gameID,hg_ready) % 2 == 0}] } {
	  $GameState($gameID,hg_img_current) copy $HourGlass(img_empty) -from 0 0 $HourGlass(width) \
		$GameState($gameID,hg_lower_mark) -to 0 0 
	  $GameState($gameID,hg_img_current) copy $HourGlass(img_full) \
		-from 0 $GameState($gameID,hg_lower_mark) $HourGlass(width) $HourGlass(height) \
		-to 0 $GameState($gameID,hg_lower_mark)
	  incr GameState($gameID,hg_ready)
	} elseif { $GameState($gameID,hg_ready) == 1 } {
	  time_elapsed $gameID
	  $GameState($gameID,hg_img_current) blank
	  set GameState($gameID,hg_ready) 2
	} else {
	  $GameState($gameID,hg_img_current) blank
	  incr GameState($gameID,hg_ready)
	}
	if {[expr {$GameState($gameID,hg_ready) % 2 == 1}] || \
        $time_gone <= [expr {$GameState($gameID,hg_time_to_go) + $HourGlass(blink_time)}]} {
	  set GameState($gameID,hg_animate) \
	    [after $HourGlass(ani_delay) "::Games::Sketch::animate $gameID $widget"]
    } else {
	  set GameState($gameID,hg_ready) -1
	  set GameState($gameID,hg_animate) ""
    }
  }

  proc hourglass {gameID widget} {
	variable HourGlass
	variable GameState
	variable bkg_color

	set HourGlass(width)            79
	set HourGlass(height)           239

	set HourGlass(half_mark)        120
	#set HourGlass(upper_full_mark)  30
	set HourGlass(lower_full_mark)  160
	set HourGlass(cone_start)       90
	set HourGlass(cone_end)         115
	set HourGlass(bottom_mark)      230

	set HourGlass(ani_delay)        300
	set HourGlass(blink_time)		5

	set GameState($gameID,hg_img_current) \
	  [image create photo -width $HourGlass(width) -height $HourGlass(height)]
	#
	# quantity that filled the upper cone
	#
	set HourGlass(cone_fill)  [expr {($HourGlass(cone_end) - $HourGlass(cone_start)) / 3}]
	set HourGlass(quantity)   [expr {$HourGlass(bottom_mark) - $HourGlass(lower_full_mark)}]
	set HourGlass(above_cone) [expr {$HourGlass(quantity) - $HourGlass(cone_fill)}]

	set HourGlass(img_full)  [image create photo -data $HourGlass(hglass_full)]
	set HourGlass(img_empty) [image create photo -data $HourGlass(hglass_empty)]
	set HourGlass(img,1)     [image create photo -data $HourGlass(hglass_1)]
	set HourGlass(img,2)     [image create photo -data $HourGlass(hglass_2)]
	set HourGlass(img,3)     [image create photo -data $HourGlass(hglass_3)]
	set HourGlass(img,4)     [image create photo -data $HourGlass(hglass_4)]
	set HourGlass(img,5)     [image create photo -data $HourGlass(hglass_5)]

	init_hour_glass $gameID $widget
	set GameState($gameID,hg_ready) -1
    set GameState($gameID,hg_animate) ""

	canvas $widget -width $HourGlass(width) -height $HourGlass(height) -bg $bkg_color
	$widget create image 0 0 -image $GameState($gameID,hg_img_current) -anchor nw

	set balloon_msg "[::Games::trans hourglass_courtesy]"
	bind $widget <Enter> +[list balloon_enter %W %X %Y $balloon_msg]
    bind $widget <Leave> "+set Bulle(first) 0; kill_balloon"

	set GameState($gameID,hg_secs) [$widget create text 8 8 -font 12x24 \
	  -text "$GameState($gameID,hg_time_to_go)" -fill red -anchor nw]
  }

  proc init_hour_glass {gameID widget} {
	variable GameState
	variable HourGlass

    set GameState($gameID,hg_time_to_go)	$HourGlass(time_to_go)
	set GameState($gameID,hg_wc)			1
	set GameState($gameID,hg_ready)			0

	set GameState($gameID,hg_sand_fallen) 0

	$GameState($gameID,hg_img_current) blank

	set upper_mark [expr {$HourGlass(cone_start) - \
	  ( $HourGlass(quantity) - $HourGlass(cone_fill) ) + $GameState($gameID,hg_sand_fallen)}]
	set GameState($gameID,hg_lower_mark) \
	  [expr {$HourGlass(bottom_mark) - $GameState($gameID,hg_sand_fallen)}]

	$GameState($gameID,hg_img_current) copy $HourGlass(img_empty) \
	  -from 0 0 $HourGlass(width) $upper_mark -to 0 0 
	$GameState($gameID,hg_img_current) copy $HourGlass(img_full) \
	  -from 0 $upper_mark $HourGlass(width) $HourGlass(half_mark) -to 0 $upper_mark
	$GameState($gameID,hg_img_current) copy $HourGlass(img,$GameState($gameID,hg_wc)) \
	  -from 0 $HourGlass(half_mark) $HourGlass(width) $GameState($gameID,hg_lower_mark) \
	  -to 0 $HourGlass(half_mark)
	$GameState($gameID,hg_img_current) copy $HourGlass(img_full) \
	  -from 0 $GameState($gameID,hg_lower_mark) $HourGlass(width) $HourGlass(height) \
	  -to 0 $GameState($gameID,hg_lower_mark)
  }

  proc stop_hour_glass {gameID widget} {
	variable GameState
	variable bkg_color
	variable err_bkg_color

	# Cancel possibly running hourglass
    if {$GameState($gameID,hg_animate) != ""} {
	  after cancel $GameState($gameID,hg_animate)
 	}
	$widget configure -bg $err_bkg_color
  }

  proc start_hour_glass {gameID widget} {
	variable GameState
	variable bkg_color

	# Cancel possibly running hourglass
    if {$GameState($gameID,hg_animate) != ""} {
	  after cancel $GameState($gameID,hg_animate)
 	}

	$widget configure -bg $bkg_color
    init_hour_glass $gameID $widget
	set GameState($gameID,hg_tstart) [clock seconds]
    animate $gameID $widget
  }
}
