#!/bin/sh
# restart using wish: \
exec wish "$0" "$@"

proc nextrow {r c}  {
	if {$c == 7} {
		return [expr $r + 1]
	} else {
		return $r
	}
}

proc nextcolumn {r c}  {
	if {$c == 7} {
		return 0
	} else {
		return [expr $c + 1]
	}
}

proc clearmoveentry {} {
	.moveentry delete 0 end
}

proc appendmoveentry {str} {
	.moveentry insert end $str
	.moveentry icursor end
}

proc spacepush {num} {
	message "That is space #$num."
	set curmove [.moveentry get]
	if {[regexp "(\[0-9\]+-\[0-9\]+)" $curmove]} {
		clearmoveentry
		set curmove [.moveentry get]
	}
	appendmoveentry $num
	if {! [regexp "(\[0-9\]+-)" $curmove]} {
		appendmoveentry "-"
	}
}

proc makeplace {num} {
	global row
	global column
	set width "-width 45 -height 45 -borderwidth 1"

	eval "button .b$num $width -command {spacepush $num}"
	eval "label .s$num $width"

    if {$row % 2 == 0} { 
		eval "grid .s$num -row $row -column $column"
		set row [nextrow $row $column]
		set column [nextcolumn $row $column]
		eval "grid .b$num -row $row -column $column"
		set row [nextrow $row $column]
		set column [nextcolumn $row $column]
    } else {
		eval "grid .b$num -row $row -column $column"
		set row [nextrow $row $column]
		set column [nextcolumn $row $column]
		eval "grid .s$num -row $row -column $column"
		set row [nextrow $row $column]
		set column [nextcolumn $row $column]
    }
	eval ".s$num configure -image nothingImage"
}

proc checker {space type} {
    global spacelist
    set spacelist($space) $type
	switch -exact -- $type {
	  black { eval ".b$space configure -image blackImage" }
	  white { eval ".b$space configure -image whiteImage" }
	  none { eval ".b$space configure -image nothingImage" }
	  wking { eval ".b$space configure -image wkingImage" }
	  bking { eval ".b$space configure -image bkingImage" }
    }
}

proc restartboard {} {
	global moveno
	for {set x 1} {$x <= 12} {incr x}  { 
	  checker $x "black"
	}
	for {set x 13} {$x <= 20} {incr x}  { 
	  checker $x "none"
	}
	for {set x 21} {$x <= 32} {incr x}  { 
	  checker $x "white"
	}
    set moveno 0
	message "Board is reset."
}

proc message {msg} {
	.msg configure -text $msg
}

proc isadj {a b} {
	set adjlist(1) {5 6}
	set adjlist(2) {6 7}
	set adjlist(3) {7 8}
	set adjlist(4) {8}
	set adjlist(5) {1 9}
	set adjlist(6) {1 2 9 10}
	set adjlist(7) {2 3 10 11}
	set adjlist(8) {3 4 11 12}
	set adjlist(9) {5 6 13 14}
	set adjlist(10) {6 7 14 15}
	set adjlist(11) {7 8 15 16}
	set adjlist(12) {8 16}
	set adjlist(13) {9 17}
	set adjlist(14) {9 10 17 18}
	set adjlist(15) {10 11 18 19}
	set adjlist(16) {11 12 19 20}
	set adjlist(17) {13 14 21 22}
	set adjlist(18) {14 15 22 23}
	set adjlist(19) {15 16 23 24}
	set adjlist(20) {16 24}
	set adjlist(21) {17 25}
	set adjlist(22) {17 18 25 26}
	set adjlist(23) {18 19 26 27}
	set adjlist(24) {19 20 27 28}
	set adjlist(25) {21 22 29 30}
	set adjlist(26) {22 23 30 31}
	set adjlist(27) {23 24 31 32}
	set adjlist(28) {24 32}
	set adjlist(29) {25}
	set adjlist(30) {25 26}
	set adjlist(31) {26 27}
	set adjlist(32) {27 28}
	if {[lsearch -exact $adjlist($a) $b] < 0} {
		return 0
	} else {
		return 1
	}
}

proc jumpfixup {l jumpno r} {
	if {[isadj $l $jumpno] && [isadj $jumpno $r]} {
		return $jumpno
	}
	if {[isadj $l [expr $jumpno + 1]] && [isadj [expr $jumpno + 1] $r]} {
		return [expr $jumpno + 1]
	}
	if {[isadj $l [expr $jumpno - 1]] && [isadj [expr $jumpno - 1] $r]} {
		return [expr $jumpno - 1]
	}
}

proc nextmove {} {
	global movelist
	global moveno
	global spacelist

	if {$moveno > [expr [llength $movelist] - 1]} {
		message "No more moves."
		bell
		return
	}
	set move [lindex $movelist $moveno]
	message "Move $moveno: $move."
	set lr [split $move "-"]
	set l [lindex $lr 0]
	set r [lindex $lr 1]
	checker $r $spacelist($l)
	checker $l "none"
	if {[expr abs($r - $l)] >= 7} {
		set jumpno [expr $r + $l]
		set jumpno [expr $jumpno / 2]
		set jumpno [jumpfixup $l $jumpno $r]
		message "Move $moveno: jump($jumpno) $move."
		checker $jumpno "none"
	}
	if {$r <= 4 && [string compare $spacelist($r) "white"] == 0} {
		checker $r "wking"
	}
	if {$r >= 29 && [string compare $spacelist($r) "black"] == 0} {
		checker $r "bking"
	}
	incr moveno
}

proc addmove {} {
	global movelist
	global moveno
	if {$moveno <= [expr [llength $movelist] - 1]} {
		message "Finish game first."
		bell
		return
	}
	set curmove [.moveentry get]
	set prefix [.moveentry get]
	if {! [regexp "(\[0-9\]+-\[0-9\]+)" $curmove]} {
		message "Invalid format for move."
		bell
		return
	}
	lappend movelist [.moveentry get]
	nextmove
	clearmoveentry
}

proc askuserforfile {} {
	set file [tk_getOpenFile] 
	if {[string length $file] < 1} {
		return
	}
	readinput $file
}

proc internalclearmoves {} {
	global movelist
	global moveno
	set movelist [list]
	set moveno 0
}

proc clearmoves {} {
	internalclearmoves
	message "Stored moves cleared."
}

proc readinput {file} {
    global movelist
    global moveno
    global nmoves
    set move ""
	internalclearmoves
	set chan [open $file "r"]
	while {! [eof $chan]} { 
		gets $chan line
		if {[regexp "(\[0-9\]+-\[0-9\]+)" $line move]} {
          puts "Move: $move"
          lappend movelist $move
        }
	}
	close $chan
	set moveno 0
	set nmoves [llength $movelist]
	message "Loaded $nmoves moves."
	puts "Done."
}

proc about {} {
	tk_dialog .about "About" \
	 "board - checkerboard with instant replay, by Brian Gaeke" \
	 "@cathead.xbm" 0 "OK"
}

proc main {argc argv} {
	global row
	global column
    global movelist
    global moveno
    global nmoves
    global spacelist

	# set name of window
	wm title . "board"

	wm geometry . "+100+100"

	set windowFont [font create -family Helvetica -size 10]

	# set up menu
	menubutton .options -text "File" -menu .options.menu
	menu .options.menu -tearoff 0
	.options.menu add command  -label "Read file..." -command {askuserforfile}
	.options.menu add command  -label "Clear moves" -command {clearmoves}
	.options.menu add command  -label "Reset board" -command {restartboard}
	.options.menu add separator
	.options.menu add command  -label "About" -command {about}
	.options.menu add separator
	.options.menu add command  -label "Quit" -command {exit 0}
	grid .options -row 0 -column 0

	button .next -text "->" -command {nextmove} -font $windowFont
	grid .next -row 1 -column 0

	label .msg -font $windowFont
	grid .msg -row 1 -column 1 -columnspan 4

	entry .moveentry -width 6 -font $windowFont
	grid .moveentry -row 1 -column 5

	button .moveaccept -text "Go" -command {addmove} -font $windowFont
	grid .moveaccept -row 1 -column 6

	# set up checker images
	image create bitmap blackImage -file "black.xbm" -maskfile "checkermask.xbm" 
	image create bitmap whiteImage -file "white.xbm" -maskfile "checkermask.xbm" -background "white"
	image create bitmap nothingImage -file "nothing.xbm"
	image create bitmap bkingImage -file "bking.xbm" -maskfile "kingmask.xbm"
	image create bitmap wkingImage -file "wking.xbm" -maskfile "kingmask.xbm" -background "white"

	# set up board
	set row 2
	set column 0
	for {set x 1} {$x <= 32} {incr x}  { 
	  makeplace $x
	}

	restartboard
	internalclearmoves

	for {set x 0} {$x < $argc} {incr x} {
	  switch -exact -- [lindex $argv $x] {
		-input { readinput [lindex $argv [expr $x + 1]] 
				 incr x }
	  }
	}
}

main $argc $argv