#!/usr/bin/wish8.0

# konnekt4, tcl/tk gui for the konnekt4 game
#
# Copyright (C) 2000 Baris Mestanogullari <mest0002@tc.umn.edu>
#                    Dan Gohman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
########################################################################


# If you won't be running konnekt4 from the directory where k4banner.gif
# is at, put the path to it in the next set line. If k4banner.gif is at:
# /usr/local/konnekt4-1.0/k4banner.gif, then set gifdir to
# "/usr/local/konnekt4-1.0/"  Do not forget to add the trailing /
set gifdir ""

proc SetMode {} {global Mode
    NewGame
    toplevel .message
    frame .message.mode -borderwidth 2 -relief ridge
    set i 0
    foreach item {"Human vs. Human" "Human vs. Computer" } {
	radiobutton .message.mode.$i -variable Mode -text $item -value $i
	pack .message.mode.$i -side top -anchor w
	incr i
    }
    button .message.mode.ok -text "Ok" -command {wm withdraw .message; destroy .message}
    pack .message.mode.ok -side bottom
    pack .message.mode -side top -fill both
    wm title .message "Choose Players"
    wm resizable .message 0 0
    raise .message
    grab .message
}

proc Help {} {
    toplevel .message
    message .message.about -width 300 -text "\nThe object of the game is to connect four pieces of the same \
color in any possible direction: horizontally, vertically or diagonally.\n\nWhen playing against the computer, \
the human player is always red.\n"
    pack .message.about
    button .message.ok -text "Ok" -command {wm withdraw .message; destroy .message}
    pack .message.ok
    wm title .message "konnekt4 help"
    wm resizable .message 0 0
    raise .message
    grab .message
}

proc About {} {
    toplevel .message
    message .message.about -width 300 -justify center -text "\nkonnekt4 game engine by Baris Mestanogullari \
<mestanba@martin.luther.edu>\n<mest0002@tc.umn.edu>\n\nTk GUI by Dan Gohman and Baris Mestanogullari\n"
    pack .message.about
    button .message.ok -text "Ok" -command {wm withdraw .message; destroy .message}
    pack .message.ok -side bottom
    wm title .message "About konnekt4"
    wm resizable .message 0 0
    raise .message
    grab .message
}

proc GameOver {a b c d} {global Mode Turn .main Location
    toplevel .message
    if {$Turn!=0} {
	.main.board itemconfigure $Location($a) -fill purple
	.main.board itemconfigure $Location($b) -fill purple
	.main.board itemconfigure $Location($c) -fill purple
	.main.board itemconfigure $Location($d) -fill purple
    }
    if {$Mode==2 && $Turn==1 || $Mode==1 && $Turn==-1} {
	label .message.a -text "You Won"
    } elseif {$Mode==1 && $Turn==1 || $Mode==2 && $Turn==-1} {
	label .message.a -text "I Won"
    } elseif {$Turn==-1} {
	label .message.a -text "Red Won"
    } elseif {$Turn==1} {
	label .message.a -text "Blue Won"
    } else {
	label .message.a -text "Tie Game" -background grey
    }
    if {$Turn==1} {
	.message.a configure -background blue
    } elseif {$Turn==-1} {
	.message.a configure -background red
    }
    pack .message.a -side top -pady 10 -padx 10
    button .message.new -text "New Game" -command {wm withdraw .message; destroy .message; NewGame}
    pack .message.new -side left
    button .message.quit -text "Quit" -command exit
    pack .message.quit -side right
    wm title .message "Game Over"
    wm resizable .message 0 0
    raise .message
    grab .message
}

proc CheckBoard {} {global Board Turn
    for {set x 0} {$Turn != 0 && $x<=6} {incr x} {for {set y 0} {$Turn != 0 && $y<=14} {incr y 7} {if {$Turn==$Board([expr $x+$y]) && $Turn==$Board([expr 7+$x+$y]) && $Turn==$Board([expr 14+$x+$y]) && $Turn==$Board([expr 21+$x+$y])} {GameOver [expr $x+$y] [expr 7+$x+$y] [expr 14+$x+$y] [expr 21+$x+$y]; set Turn 0}}}
    for {set x 0} {$Turn != 0 && $x<=3} {incr x} {for {set y 0} {$Turn != 0 && $y<=35} {incr y 7} {if {$Turn==$Board([expr $x+$y]) && $Turn==$Board([expr 1+$x+$y]) && $Turn==$Board([expr 2+$x+$y]) && $Turn==$Board([expr 3+$x+$y])} {GameOver [expr $x+$y] [expr 1+$x+$y] [expr 2+$x+$y] [expr 3+$x+$y]; set Turn 0}}
	for {set y 0} {$Turn != 0 && $y<=14} {incr y 7} {if {$Turn==$Board([expr 6+$y-$x]) && $Turn==$Board([expr 12+$y-$x]) && $Turn==$Board([expr 18+$y-$x]) && $Turn==$Board([expr 24+$y-$x])} {GameOver [expr 6+$y-$x] [expr 12+$y-$x] [expr 18+$y-$x] [expr 24+$y-$x]; set Turn 0}
	    if {$Turn==$Board([expr $x+$y]) && $Turn==$Board([expr 8+$x+$y]) && $Turn==$Board([expr 16+$x+$y]) && $Turn==$Board([expr 24+$x+$y])} {GameOver [expr $x+$y] [expr 8+$x+$y] [expr 16+$x+$y] [expr 24+$x+$y]; set Turn 0}}}}

proc DoTurn {x} {global Board Mode Level Turn Top
    if {$Mode==1 && $Turn==-1 || $Mode==2 && $Turn==1 || $Mode==0} {
	for {set x [expr ($x-9)/34+35]} {$x>=0 && $Board($x)!=0} {incr x -7} {}
	if {$x>=0 && $x<42} {
	    SetLocation $x $Turn
	    incr Top
	    CheckBoard
	    if {$Top>41} {
		set Turn 0
		GameOver 0 0 0 0
	    }
	    set Turn [expr $Turn*-1]
	}
    }
    if {$Mode==1 && $Turn==1 || $Mode==2 && $Turn==-1 || $Mode==3} {
	set b [array get Board]
  	set input [open "|k4engine $Level $Turn $b" r]
   	set data [read $input]
   	close $input
   	set index [lindex $data 0]
   	if {$index>=0 && $index<42} {if {$Board($index)==0} {SetLocation $index $Turn}}
   	incr Top
   	CheckBoard 
   	if {$Top>=42} {
	    set Turn 0
	    GameOver 0 0 0 0
   	}
   	set Turn [expr $Turn*-1]
    }
}

proc NewGame {} {global Turn Board Top
    set Top 0
    set Turn -1
    for {set i 0} {$i<42} {incr i} {SetLocation $i 0}}

proc SetLocation {index player} {global .main Board Location Top
    set Board($index) $player
    if {$player==-1} {.main.board itemconfigure $Location($index) -fill Red} elseif {$player==1} {.main.board itemconfigure $Location($index) -fill Blue} else {.main.board itemconfigure $Location($index) -fill Grey}
    pack .main.board -fill both}

set Level 0
set Mode 1

wm title . "konnekt4"
wm resizable . 0 0

frame .main

canvas .main.banner -height 50 -width 244 -borderwidth 5 -relief ridge
image create photo banner -file "${gifdir}k4banner.gif" -format gif
.main.banner create image 127 30 -image banner
pack .main.banner

canvas .main.board -height 210 -width 244 -borderwidth 5 -relief ridge -background white
.main.board create polygon 5 5 254 5 254 220 5 220 -fill black
for {set i 0} {$i<42} {incr i} {
    set y [expr ($i/7)*34+9]
    set x [expr ($i%7)*34+9]
    .main.board create oval [expr $x+2] [expr $y+2] [expr $x+32] [expr $y+32] -fill yellow
    set Location($i) [.main.board create oval $x $y [expr $x+30] [expr $y+30] -fill gray]
    .main.board bind $Location($i) <Button-1> {DoTurn %x}
}
pack .main -side right -fill y

frame .options -borderwidth 5 -relief ridge -background AntiqueWhite
pack .options -side left -fill y 
button .options.quit -text "Quit" -command exit
pack .options.quit -side top -fill x -pady 4 -padx 5
button .options.newGame -text "New Game" -command NewGame
pack .options.newGame -side top -fill x -pady 4 -padx 5
button .options.players -text "Players" -command SetMode
pack .options.players -side top -fill x -pady 4 -padx 5
button .options.about -text "About k4" -command About
pack .options.about -side bottom -fill x -pady 4 -padx 5
button .options.help -text "Help" -command Help
pack .options.help -side bottom -fill x -pady 4 -padx 5
frame .options.level -borderwidth 2 -relief sunken
radiobutton .options.level.0 -variable Level -text "Easy" -value 0 -selectcolor Yellow
pack .options.level.0 -side top -anchor w
radiobutton .options.level.1 -variable Level -text "Medium" -value 1 -selectcolor Orange
pack .options.level.1 -side top -anchor w
radiobutton .options.level.2 -variable Level -text "Difficult" -value 2 -selectcolor Red
pack .options.level.2 -side top -anchor w
pack .options.level -side top -fill x -pady 5 -padx 5

NewGame
