#!/bin/sh
# the next line restarts using tclsh \
exec wish "$0" "$@"

# TkHangman v2.5.1a, 08/11/2007
# Author: Steven Atkinson (stevenaaus@netscape.net)
# Original Author: Andreas Kersche

### Colours
# bg_colour is also the background for title.gif
set bg_colour lightblue
set textcolor coral4
set buttonargs "-pady .8 -relief groove -fg $textcolor -activeforeground HotPink4 -activebackground RosyBrown3 -highlightbackground $bg_colour"

### Fonts
# font variables replaced with font widget, NOT - at 1024, y dim is too large ?
# font create guessfont -family helvetica -size 13 -weight normal
set guessfont 8x13
set buttonwidth 5
set guesswidth 16

### WindowManager
wm title . "TkHangman 2.5.1a"
wm resizable . 0 0
. configure -background $bg_colour

############
#Procedures#
############

proc random max_int {
	# returns a random integer less than max_int
	# return [expr (int(rand() * [clock seconds]) % $max_int)]
	return [expr int(rand() * $max_int)]
}

proc ChangeMessageLabel Text {
	.frame.message configure -text $Text
}

proc ChangePicture Picture {
	global picturedir

	# this seems to work fine, but *exactly* what it's doing, I'm not sure
	# previously, Image was constantly destroyed/created
	Image read $picturedir/$Picture
}


proc InitWord {} {
	# Set variables Word, WordLength, WordList, Points
	# Word={zulu} WordList={z u l u} Points={. . . .}

	global randseed dictionary_fd dictionary_size
	global Word WordList WordLength Points

	# seek randomly, read (incomplete) word and discard, read word
	seek $dictionary_fd [random $dictionary_size]
	gets $dictionary_fd Word
	gets $dictionary_fd Word
	if {"$Word" == ""} {
		# eof reached, grab the first word
		seek $dictionary_fd 0 start
		gets $dictionary_fd Word
	}

	set Word [string tolower $Word]
	set WordLength [string length $Word]
	set WordList [split $Word {}]
	set Points [split [string repeat {.} $WordLength] {}]
}

proc Restart {} {
	global gameslost

	incr gameslost
	.frame.guessbox delete 0 end
	
	StartGame
}

proc StartGame {} {

	global OldEntry piccount usedletters
        .frame.buttons.button1 configure -text "Restart" -command Restart
	set OldEntry ""

	foreach letter [split {thequickbrownfoxjumpsoveralazyblackdog} {}] {
		set usedletters($letter) 0
	}
	bind all <KeyRelease> {}
	ChangeMessageLabel "Enter a letter"
	set piccount 0
	ChangePicture "0.gif"
	
	InitWord
	ShowPoints

	focus .frame.guessbox
	bind .frame.guessbox <KeyRelease> {MainControl}
}

proc ExitGame {} {
	global dictionary_fd
	close $dictionary_fd
	exit 0
}

proc MainControl {} {

	global picturedir piccount WordList Points gameswon gameslost
	
	ProcessInput 
	
	if {$piccount == 11} {
		# Game Lost
		# 'gameslost' is incremented at restart
		ChangeMessageLabel $WordList
		bind .frame.guessbox <KeyRelease> {}
	} elseif {$WordList == $Points} {
		# Game Won
		incr gameswon
		ChangeMessageLabel "Correct !   $gameswon - $gameslost"

		# decreasing 'gameslost' here is the easiest way of handling
		# mid-game restarts, which count as a loss.
		incr gameslost -1

		bind .frame.guessbox <KeyRelease> {}		
	}
}

proc ShowPoints {} {
	global Points
	.frame.dots configure -text $Points
}

proc DeleteLastChar {} {
	global Entry
	bell
        .frame.guessbox delete [expr [.frame.guessbox index insert] -1]
}

proc ProcessInput {} {
	# delicate decision logic here
	global	Word Points WordList WordLength \
		Entry OldEntry piccount usedletters

	if {$OldEntry == $Entry} {return}

	# newchar is the one just before the insertion cursor
	set newchar [string index $Entry \
		[expr [.frame.guessbox index insert] -1]]

	# if not a regular character or is already used, reject
	if {[regexp \[a-z\] $newchar] == 0} {
		DeleteLastChar
		return
	}
	if {$usedletters($newchar)} {
		DeleteLastChar
		return
	} 
	set OldEntry $Entry
	set usedletters($newchar) 1

	set changed FALSE

	for {set i 0} {$i < $WordLength} {incr i} {
		if {[lindex $WordList $i] == $newchar } {
			set Points [lreplace $Points $i $i $newchar]
			set changed TRUE
		}
	}

	if {$changed} {ShowPoints} else {
		incr piccount
		ChangePicture "${piccount}.gif"
	}
}

######
#Main#
######

set installdir /usr/local/lib/tkhangman
if {[file isdirectory $installdir/pictures]==0} {
	if {[file isdirectory [pwd]/pictures]==0} {
		puts "Can't find working directory in '$installdir' or '[pwd]'"
		exit 1
	} else { set installdir [pwd] }
}

if {"$argv" != ""} {puts "Tkhangman accepts no args. Please see '$installdir/INSTALL'" ; exit 1}

set picturedir ${installdir}/pictures
set dictionary ${installdir}/words
set dictionary_fd [open $dictionary r]
set dictionary_size [file size $dictionary]

set piccount 0
set gameswon 0
set gameslost 0

###########
# Widgets #
###########

# guesses are entered in entry 'guessbox'
# letters are revealed in label 'dots'

image create photo Image -file $picturedir/start.gif
image create photo Title -file $picturedir/title.gif
label .picture -bd 0 -image Image
frame .frame -background $bg_colour
label .frame.title -image Title -bg $bg_colour
label .frame.message -text "Press a Key" -bg $bg_colour -fg $textcolor
entry .frame.guessbox -textvariable Entry -width $guesswidth \
	-font $guessfont -highlightthickness 0 
label .frame.dots -bg $bg_colour -fg $textcolor

frame .frame.buttons -bg $bg_colour

eval {button .frame.buttons.button1 -text "Start" -width $buttonwidth \
	-command StartGame} $buttonargs
eval {button .frame.buttons.button2 -text " Exit " -width $buttonwidth \
	-command ExitGame} $buttonargs

pack .picture -side left -fill y
pack .frame -side right 
pack .frame.title -side top
pack .frame.message -pady 4
pack .frame.guessbox -padx 3
pack .frame.dots -pady 2
pack .frame.buttons -side bottom -padx 5 -pady 2
pack .frame.buttons.button1 -side left -padx 5 -pady 2
pack .frame.buttons.button2 -side right -padx 5 -pady 2

# when the entry widget gets focus, place cursor at the end
bind .frame.guessbox <FocusIn> {.frame.guessbox selection range end end}

bind all <KeyRelease> {StartGame}
