#
#	backgammon tclet
#
#	Backgammon
#	by Ignaz KOHLBECKER
#	ignaz@fujita3.iis.u-tokyo.ac.jp
#
#	Distribution and modifications of this program and its associated
#	files are possible under the conditions of the
#	GNU Public License (GPL).
#
#	History:
#
#	97/08/13	first edit.
#	97/08/25	V1.0 last edit version 1.0.
#	98/01/11	V1.1 jot and rand()
#	98/01/30	tclet version: no exec, toplevel, wm, tkwait, @;
#			instead vwait, bitmap->image, bitmap data inline
#	98/01/31	no puts, trash unnecessary stuff
#


#-------------------------------------------------------------------
#-------------------------------------------------------------------
#-------------------------------------------------------------------

#
#	Game Procedures
#


#-------------------------------------------------------------------
proc gameinit {} {
    global progname bp bop avmove diceexpr
    global c totturns dice1 dice2 undook
    set checkerinit {6 6 6 6 6 8 8 8 13 13 13 13 13 24 24}

    set progname "Phi's Backgammon Tclet V1.1"

    # The points on the board are numbered 1 to 24.
    # Player  1 moves from 24 downward to  1.
    # Player -1 moves from  1 upward   to 24.
    # Bar      for player 1 is 25, for player -1 is  0.
    # Bear-off for player 1 is  0, for player -1 is 25.

    set bp(1)  25 ;# bar position
    set bp(-1)  0 ;# bar position
    set bop(1)   0 ;# bear off position
    set bop(-1) 25 ;# bear off position

    # The average outcome of two dices with doubling in case of two equals:
    # 2 * 1/6 * Sum[i,{i,1,6}] + 1/36 * Sum[2i,{i,1,6}] = 8 1/6
    set avmove 8.167

    # The expression to throw a dice
    set diceexpr {expr {1 + int(6 * rand())}}

    for {set level 0} {$level <= 4} {incr level} {
	for {set p 0} {$p <= 25} {incr p} {
	    set c(1,$level,$p) 0
	    set c(-1,$level,$p) 0
	}
	
	foreach number $checkerinit {
	    incr c(1,$level,$number)
	    incr c(-1,$level,[expr 25 - $number])
	}
    }
    set totturns 0
    set dice1 0
    set dice2 0
    set undook 0
}

#-------------------------------------------------------------------
proc restart {} {
    global restartrequest dice1 dice2 turn noturn bar nobar undook
    global playerdone c bp totturns compwon playerwon
    global diceexpr

    # Put all checkers in start position
    gameinit
    showcheckers 0
    
    # Throw dices unil two different numbers
    while {[set dice1 [eval $diceexpr]] == [set dice2 [eval $diceexpr]]} {}
    # Decide who begins the game.
    if {$dice1 > $dice2} {
	# Computer begins
	set turn 1
	set noturn -1
    } else {
	# Player begins
	set turn -1
	set noturn 1
    }
    
    while {!$restartrequest && !$compwon && !$playerwon} {
	set bar [set bp($turn)]
	set nobar [set bp($noturn)]
	set dice1 [expr $turn * $dice1]
	set dice2 [expr $turn * $dice2]
	showdices
	
	incr totturns
	if {$turn == 1} {
	    # Computers move
	    compmove $dice1 $dice2
	    
	    if {[set c(1,0,$nobar)] == 15} {
		# The computer won.
		#puts "Backgammon: Computer won in $totturns turns."
		set compwon 1
	    }
	} else {
	    # Players move
	    thinker 0

	    # Store game in level 4 for Undo
	    copylevel 0 4 {}
	    # Enable the Undo-Button
	    set undook 1
	    
	    set playerdone 0
	    # Wait for the player to do his moves and
	    # return control by pressing "Go"
	    vwait playerdone
	    
	    if {[set c(-1,0,$nobar)] == 15} {
		# The player won.
		#puts "Backgammon: Player won in $totturns turns."
		set playerwon 1
	    }
	    # Disable the Undo-Button
	    set undook 0
	    
	    thinker -1
	}
	# Flip turn; get new dices
	set h $turn
	set turn $noturn
	set noturn $h
	set dice1 [eval $diceexpr]
	set dice2 [eval $diceexpr]
	
	update
    }
    # done|quit|won
}

#-------------------------------------------------------------------
proc compmove {d1 d2} {
    global allmoves maxmovelen

    set allmoves {}
    set maxmovelen 0
    thinker 1
    if {$d1 == $d2} {
	deep 0 $d1 $d1 $d1 $d1 {} 0
    } else {
	deep 0 $d1 $d2 0 0 {} 0
    }

    set pickmove [select 0]
    # puts "$pickmove"
    foreach m [lindex $pickmove 0] {copylevel 0 0 $m}
    
    showcheckers 0
    thinker -1
}

#-------------------------------------------------------------------
proc copylevel {fromlevel tolevel move} {
    global c turn noturn bar nobar allmoves

    if {$fromlevel != $tolevel} {
	for {set i 0} {$i <= 25} {incr i} {
	    foreach ii [list $turn $noturn] {
		set c($ii,$tolevel,$i)   [set c($ii,$fromlevel,$i)]	
	    }
	}
    }

    if {$move != {}} {
	set from [lindex $move 0]
	# Remove the checker from where it was
	incr c($turn,$tolevel,$from) -1

	set to [expr $from - [lindex $move 1]]
	
	if {($to > 0) && ($to < 25)} {
	    # blot might be possible
	    if {[set c($noturn,$tolevel,$to)] == 1} {
		# blot! remove the noturn's checker
		set c($noturn,$tolevel,$to) 0
		# kick the noturn's checker on the bar
		incr c($noturn,$tolevel,$nobar) 
	    }
	    # Put the checker at the new point
	    incr c($turn,$tolevel,$to)
	} else {
	    # Put the checker to bearoff
	    incr c($turn,$tolevel,$nobar)
	}
    }
}

#-------------------------------------------------------------------
proc deep {level d1 d2 d3 d4 movelist kickout} {
    global c turn noturn bar nobar allmoves maxmovelen
    global white black

    # make a list of all possible start points
    if {[set c($turn,$level,$bar)] > 0} {
	# at least one checker is on the bar; try to get it in 
	# only bar is a possible start point
	set plist [list $bar]
    } else {
	# bar is empty
	# get all points with turn's checkers, 
	# from highest to lowest point (important!)
	set plist {}
	for {set p $bar} {$p != $nobar} {incr p [expr -$turn]} {
	    if {[set c($turn,$level,$p)] > 0} {
		# at least one checker is on the point
		lappend plist $p
	    }
	}
    }
    

    # bearoffok indicates that all ckeckers are in the homeboard
    set bearoffok 1

    # block indicates that no move at current level was found
    set block 1

    # firstinplist is 1 only for the highest point in plist.
    # That is the only point from where not exact bearing off is allowed.
    set firstinplist 1

    # loop over all points with turn's checkers,
    # descending from bar towards bear-off.
    foreach p $plist {

	# dicetry monitors the dice permutations
	#  1     - {d1 d2 d3 d4}
	#  2     - {d2 d1 d3 d4}
	#  other - end condition for while loop
	# try with d1 first:
	set dicetry 1
	while {$dicetry == 1 || $dicetry == 2} {
	    set to [expr $p - $d1]
	    set tohomeboard [expr abs($nobar - $to) <= 6]
	    set tobearoffexact [expr $turn * ($nobar - $to) == 0]
	    set tobearoff      [expr $turn * ($nobar - $to) >= 0]
	    if {($to -$nobar) *$turn < 0} {set to $nobar}
	    
	    if {abs($nobar - $p) > 6} {
		# The first point outside the homeboard
		# switches bearoffok off.
		# For this to work properly it was important to
		# have elements in plist descend from bar to bearoff.
		set bearoffok 0
	    }

	    if {($bearoffok && \
		    ($tobearoffexact || ($tobearoff && $firstinplist))) || \
		    (!$tobearoff && ([set c($noturn,$level,$to)] <= 1))} {
		# move from p with d1 ok.
		if {($to -$nobar) *$turn < 0} {
		    set move [list $p [expr $nobar -$p]]
		} else {
		    set move [list $p $d1]
		}
		# as at least this move is possible,
		# the situation is not blocked.
		set block 0

		# nextmovelist is movelist with the new move appended.
		# A seperate variable is necessary to preserve movelist
		# for the next p.
		set nextmovelist $movelist
		lappend nextmovelist $move

		set nextkickout [expr $kickout +($nobar +$turn *$p) *\
			([set c($noturn,$level,$to)] == 1)]

		# Create the potential situation which would be there
		# if move applied.
		set nextlevel [expr $level + 1]
		copylevel $level $nextlevel $move
		
		if {$d2 == 0} {
		    # All dices used. A valid move sequence has been found.

		    # Evaluate the potential final situation.
		    set evaluation [evalsituation $nextlevel $nextkickout]

		    # Add the move sequence to allmoves 
		    lappend allmoves [list $nextmovelist $evaluation]

		    # Check for new maximum length.
		    set nextmovelen [llength $nextmovelist]
		    if {$nextmovelen > $maxmovelen} {
			set maxmovelen $nextmovelen
		    }
		} else {
		    # more dices; try to use them, too.
		    deep $nextlevel $d2 $d3 $d4 0 $nextmovelist $nextkickout
		}
	    }
	    
	    # Permutation of the dices
	    # if d2 is different from d1 and not 0,
	    # and d1 and d2 had not been flipped before,
	    # flip d1 and d2 and try again.
	    if {$d2 != 0 && $d2 != $d1 && $dicetry == 1} {
		set h $d2
		set d2 $d1
		set d1 $h
		set dicetry 2
	    } else {
		# no more tries. get out of the while loop.
		set dicetry 0
	    }
	} 
	# while try dice permutations
	set firstinplist 0
	update
    } 
    # foreach p in plist

    if {$block} {
	# Neither move with d1 nor with d2 was possible.
	# If any move sequence so far, add it to allmoves 
	set movelen [llength $movelist]
	if {$movelen > 0} {

	    # Evaluate the situation.
	    set evaluation [evalsituation $level $kickout]

	    # Add the move sequence to allmoves 
	    lappend allmoves [list $movelist $evaluation]

	    # Check for new maximum length.
	    if {$movelen > $maxmovelen} {
		set maxmovelen $movelen
	    }
	}
    }
    update
    thinker 1
}

#-------------------------------------------------------------------
proc evalsituation {level kickout} {
    global turn noturn c bp bar nobar avmove

    set kickoutrisk 0
    set singlecnt   0

    # Overlap init
    set overlap 0
    # Upward moving player's checkers on the bar.
    # Pending until we know there are checkers from the
    # downward moving player higher than this point.
    set olpending [set c(-1,$level,0)]
    # The overlap starts only after the first checker of
    # the upward moving player was found.
    set olstart [expr $olpending > 0]

    foreach eturn [list $turn $noturn] {
	set single($eturn) 0
	set pvalue($eturn) [expr 25 * [set c($eturn,$level,[set bp($eturn)])]]
	set pnumber($eturn) 0
	set reenter($eturn) 0
	set outhome($eturn) [set pvalue($eturn)]
    }

    for {set pe 1} {$pe <= 24} {incr pe} {
	# overlap
	if {([set c(1,$level,$pe)] > 0) && $olstart} {
	    # Downward moving player's checker found.
	    # The pending overlaps become real ones.
	    # Also add the checkers of the downward moving player.
	    incr overlap [expr $olpending +[set c(1,$level,$pe)]]
	    set olpending 0
	}
	incr olpending [set c(-1,$level,$pe)]
	set olstart [expr $olstart || ([expr $olpending > 0])]

	# for current player and for counterpart player do
	foreach eturn [list $turn $noturn] {
	    set noeturn [expr -$eturn]
	    set minehere [set c($eturn,$level,$pe)]
	    set pvaluehere [expr [set bp($noeturn)] + $eturn *$pe]
	    incr pvalue($eturn) [expr $pvaluehere *$minehere]
	    incr pnumber($eturn) [expr $minehere > 0]
	    incr reenter($noeturn) [expr ($minehere > 1) && ($pvaluehere <= 6)]
	    if {$pvaluehere > 6} {
		incr outhome($eturn) [expr $pvaluehere *$minehere]
	    }

	    if {$minehere == 1} {
		# a single!
		incr singlecnt
		set h 0
		set limit [expr abs([set bp($noeturn)] -$pe)]
		for {set d1 1} {($d1 <= 6) && ($d1 < $limit)} {incr d1} {
		    set pos1 [expr $pe -$eturn *$d1]
		    if {[set c($noeturn,$level,$pos1)] > 0} {
			incr h 6
		    } elseif {[set c($eturn,$level,$pos1)] > 0} {
			for {set d2 1} {($d2 <= 6) && ($d1 +$d2 < $limit)} \
				{incr d1} {
			    set pos2 [expr $pos1 -$eturn *$d2]
			    incr h [expr [set c($noeturn,$level,$pos2)] > 0]
			}
		    }
		}
		set kickoutrisk \
			[expr $kickoutrisk +double($h)/36.0 *\
			([set bp($eturn)] -$eturn *$pe)]
	    }
	    # end if a single
	}
	# end each player
    }
    # for all points from 1 to 24

    # Complete the kickout risk calculation
    set kickoutrisk \
	    [expr $kickoutrisk +$singlecnt *\
	    double([set reenter($turn)])/6.0 *$avmove]

    # Kickout gain is the number of points the counterpart looses by kickout
    # plus the number of kicked out checkers
    # times the probability of not being able to get them in
    # times the average points per move.
    set kickoutgain [expr $kickout +[set c($noturn,$level,$nobar)] *\
	    double([set reenter($noturn)])/6.0 *$avmove]

    # return the evaluation:
    #  0: overlap
    #  1: kickout risk
    #  2: kickout gain
    #  3: self  reenter
    #  4: other reenter
    #  5: self  outside home
    #  6: other outside home
    #  7: self  bearoff
    #  8: other bearoff
    #  9: self  point value
    # 10: other point value
    # 11: self  point number
    # 12: other point number
    return [list $overlap\
	    $kickoutrisk\
	    $kickoutgain\
	    [set reenter($turn)]\
	    [set reenter($noturn)]\
	    [set outhome($turn)]\
	    [set outhome($noturn)]\
	    [set c($turn,$level,$nobar)]\
	    [set c($noturn,$level,$bar)]\
	    [set pvalue($turn)]\
	    [set pvalue($noturn)]\
	    [set pnumber($turn)]\
	    [set pnumber($noturn)]]
}

#-------------------------------------------------------------------
proc select {level} {
    global c turn noturn allmoves bp
   
    # This is the strategy part.

    # Allmoves contains all legal moves plus maybe some move that are
    # shorter than maximum possible in the current situation.
    # As a rule of the game, we must choose only from those moves of
    # maximum length. This is realized by making move length the
    # highest order selection criterion.

    # The strategy is based on a hierarchy of selection criteria.
    # It compares all moves, searching for maximum gain.
    # It selects all moves with maximum value at the highest order selection
    # criterion,
    # among them all with maximum value at the second to highest
    # selection criterion, and so on.
    # If no more criteria, it simply takes the first in the list of
    # selected moves.
    # If the list is empty, no legal move is possible in this situation
    # and the computer can't make any move.

    # Get the point values of the current situation.
    # This is needed for the aggressivity calculation.
    set pvalue($turn) 0
    set pvalue($noturn) 0
    foreach eturn [list $turn $noturn] {
	for {set pe 1} {$pe <= 24} {incr pe} {
	    set minehere [set c($eturn,$level,$pe)]
	    set pvaluehere [expr [set bp([expr -$eturn])] + $eturn *$pe]
	    incr pvalue($eturn) [expr $pvaluehere *$minehere]
	}
    }

    # The aggressivity:
    # Based on how much the player is behind or ahead of the counterpart,
    # set the behavior on a scale from defensive (-1) to aggressive (1).
    # Be more defensive when more ahead of the counterpart,
    # Be more aggressive when more behind of the counterpart.
    set a [set pvalue($turn)]
    set b [set pvalue($noturn)]
    if {$a *$b} {
	# Neither one is 0
	if {$a > $b} {
	    # Counterpart is ahead. Be more aggressive.
	    set agg [expr double($a -$b) / double($a)]
	} else {
	    # Player is ahead. Be more defensive.
	    set agg [expr double($a -$b) / double($b)]
	}
	# puts "Aggressivity: $agg"
    } else {
	puts "Backgammon: Program error: Game should be over."
    }

    # The selection criteria:
    set overlap 0
    set kickoutrisk 1
    set kickoutgain 2
    set selfreenter 3
    set otherreenter 4
    set selfoutsidehome 5
    set otheroutsidehome 6
    set selfbearoff 7
    set otherbearoff 8
    set selfpointvalue 9
    set otherpointvalue 10
    set selfpointnumber 11
    set otherpointnumber 12

    set criterion(1) {$candlen}
    set criterion(2) {[lindex $cand $overlap] > 0}
    set criterion(3) {([lindex $cand $overlap] > 0) *\
	    ([lindex $cand $kickoutgain] -[lindex $cand $kickoutrisk])}
    set criterion(4) {-[lindex $cand $selfoutsidehome]}
    set criterion(5) {[lindex $cand $selfbearoff]}
    set criterion(6) {-[lindex $cand $selfpointvalue]}
    set criterion(7) {[lindex $cand $selfpointnumber]}
    set criterion(8) {-[lindex $cand $otherreenter]}

    # The selection algorithm.
    set bestmove [lindex $allmoves 0]
    set besteval [lindex $bestmove 1]
    set bestlen  [llength [lindex $bestmove 0]]
    # puts "Initial best: $bestmove"
    foreach compmove $allmoves {
	set compeval [lindex $compmove 1]
	set complen  [llength [lindex $compmove 0]]
	set h 0
	set best 0
	set comp 0
	while {($best == $comp) && ($h < 8)} {
	    # Same value at this hierarchy. Try next hierarchy.
	    incr h

	    set cand $besteval
	    set candlen $bestlen
	    set best [expr [set criterion($h)]]

	    set cand $compeval
	    set candlen $complen
	    set comp [expr [set criterion($h)]]
	}
	if {$comp > $best} {
	    # found a new maximum
	    # puts "At criterion $h, comp=$comp > best=$best"
	    # puts "    New best: $compmove"

	    set bestmove $compmove
	    set besteval $compeval
	}
	thinker 1
    }

    # puts ""
    # Return the best move
    return $bestmove
}


#-------------------------------------------------------------------
#-------------------------------------------------------------------
#-------------------------------------------------------------------

#
#	GUI Procedures
#


#-------------------------------------------------------------------
proc undocmd {} {
    global undook
    
    if {$undook} {
	copylevel 4 0 {}
	showcheckers 0
    }
}


#-------------------------------------------------------------------
proc showboard {style} {
    global boardlist boardstyle
    global s s2 x0 x1 x2 x3 y0 y1 y2 fcol fbcol

    # style: -1 - plain, 0 - toggle style

    if {$style == 0} {
	set boardstyle [expr -$boardstyle]
    } else {
	set boardstyle $style
    }

    foreach boardelem $boardlist {.c delete $boardelem}
    set boardlist {}

    set xx1 [expr $x0 +$x1]
    set xx2 [expr $x0 +$x2]
    set xx3 [expr $x0 +$x3]
    set yy1 [expr $y0 +$y1]
    set yy2 [expr $y0 +$y2]
    set xm1 [expr $x0 -$x1]
    set xm2 [expr $x0 -$x2]
    set xm3 [expr $x0 -$x3]
    set ym1 [expr $y0 -$y1]
    set ym2 [expr $y0 -$y2]
    
    set rectfill grey
    set polyw 2

    lappend boardlist [.c create rect $xm3 $yy2 $xm2 $ym2 \
	    -width 4 -fill $rectfill]
    lappend boardlist [.c create rect $xm1 $yy2 $xx1 $ym2 \
	    -width 4 -fill $rectfill]
    lappend boardlist [.c create rect $xx3 $yy2 $xx2 $ym2 \
	    -width 4 -fill $rectfill]

    for {set i 0} {$i < 12} {incr i} {
	set pox1 [expr $xm2 + $s * ($i + $i / 6)]
	set pox2 [expr $pox1 + $s2]
	set pox3 [expr $pox1 + $s]

	set pox4 [expr $xx2 - $s * ($i + $i / 6)]
	set pox5 [expr $pox4 - $s2]
	set pox6 [expr $pox4 - $s]

	set imod [expr $i % 2]

	lappend boardlist [.c create polygon $pox1 $yy2 $pox2 $yy1 $pox3 $yy2 \
		-fill [set fcol($boardstyle,$imod)] \
		-outline [set fbcol($boardstyle,$imod)] -width $polyw]
	lappend boardlist [.c create polygon $pox4 $ym2 $pox5 $ym1 $pox6 $ym2 \
		-fill [set fcol($boardstyle,$imod)] \
		-outline [set fbcol($boardstyle,$imod)] -width $polyw]
    }   

    foreach boardelem $boardlist {.c lower $boardelem}
}
 

#-------------------------------------------------------------------
proc showcheckers {showlevel} {
    global c checkerlist white black posx posy boposx boposy 
    global s s2 bp col xori pcol x0 y0 checkertag

    foreach checker $checkerlist {.c delete $checker}
    set checkerlist {}

    for {set p 0} {$p <= 25} {incr p} {
	foreach player [list 1 -1] {
	    set pp [expr [set bp([expr -$player])] +$player * $p]
	    for {set ch 1} {$ch <= [set c($player,$showlevel,$pp)]} {incr ch} {
		set x [expr $x0 +$xori * [set posx($p,$ch)]]
		set y [expr $y0 -$player * [set posy($p,$ch)]]

		set item [.c create oval [expr $x -$s2] [expr $y -$s2] \
			[expr $x +$s2] [expr $y +$s2] \
			-fill [set col([expr $player * $pcol],1)] \
			-outline [set col([expr $player * $pcol],2)] -width 2]
		.c addtag [set checkertag($player)] withtag $item
		lappend checkerlist $item
	    }
	}
    }
    update
}


#-------------------------------------------------------------------
proc showdices {} {
    global dice1 dice2 dicelist x0 y0 dicex dicecol pcol
    
    if {$dice1 && $dice2} {
	foreach dicebmp $dicelist {.c delete $dicebmp}
	set dicelist {}
	set d1 [expr abs($dice1)]
	set d2 [expr abs($dice2)]
	set dsign [expr $dice1 / abs($dice1)]
	
	set item [.c create image [expr $x0 - $dsign * $dicex(1)] $y0 \
		-image dice($d1) \
		-anchor c]
	dice($d1) configure -background [set dicecol([expr $dsign * $pcol])]

	lappend dicelist $item
	set item [.c create image [expr $x0 - $dsign * $dicex(2)] $y0 \
		-image dice($d2) \
		-anchor c]
	dice($d2) configure -background [set dicecol([expr $dsign * $pcol])]

	lappend dicelist $item
	update
    }
}


#-------------------------------------------------------------------
proc thinker {mode} {
    global thinkerlist thinkercnt
    global thinknot think
    # modes: 0 "watch on", 1 "think", -1 "off"
    
    foreach thinkerbmp $thinkerlist {.c delete $thinkerbmp}
    set thinkerlist {}

    if {$mode == 0} {
	lappend thinkerlist [.c create image 80 14 \
		-image thinknot \
		-anchor nw]
    } elseif {$mode == 1} {
	set thinkercnt [expr ([incr thinkercnt]) % 8 + 1]
	lappend thinkerlist [.c create image 80 14 \
		-image think($thinkercnt) \
		-anchor nw]
    }
}


#-------------------------------------------------------------------
# grabchecker --
# This procedure is invoked when the mouse is pressed over one of the
# data points.  It sets up state to allow the point to be dragged.
#
# Arguments:
# w -		The canvas window.
# x, y -	The coordinates of the mouse press.

proc grabchecker {w x y} {
    global lastX lastY x0 x3 s2 s y0 y1 y2 mapxy2p mapp2x fromP toP xori
     
    $w dtag selected
    $w addtag selected withtag current
    $w raise current

    set snapx $x
    if {$snapx <= ($x0 -$x3)} {set snapx [expr $x0 -$x3 +1]}
    if {$snapx >= ($x0 +$x3)} {set snapx [expr $x0 +$x3 -1]}
    set gridx [expr ($snapx -$x0 +$s2) / $s]
    
    set snapy [expr abs($y0 -$y)]
    set yminus [expr $y0 < $y]
    if {$snapy < $y1 +$s2} {set snapy [expr $y1 +$s2]}
    if {$snapy > $y2 -$s2} {set snapy [expr $y2 -$s2]}
    set snapy [expr $y0 +($yminus *2 -1) *$snapy]

    set fromP [lindex [lindex $mapxy2p $yminus] [expr $xori *$gridx +7]]
    set toP $fromP
    set snapx [expr $x0 +$s * $xori *[lindex $mapp2x $fromP]]

    set lastX $snapx
    set lastY $snapy
}


#-------------------------------------------------------------------
# movechecker --
# This procedure is invoked during mouse motion events.  It drags the
# current item.
#
# Arguments:
# w -		The canvas window.
# x, y -	The coordinates of the mouse.

proc movechecker {w x y} {
    global lastX lastY x0 x3 s2 s y0 y1 y2 mapxy2p mapp2x xori toP

    set snapx $x
    if {$snapx <= ($x0 -$x3)} {set snapx [expr $x0 -$x3 +1]}
    if {$snapx >= ($x0 +$x3)} {set snapx [expr $x0 +$x3 -1]}
    set gridx [expr ($snapx -$x0 +$s2) / $s]
    
    set snapy [expr abs($y0 -$y)]
    set yminus [expr $y0 < $y]
    if {$snapy < $y1 +$s2} {set snapy [expr $y1 +$s2]}
    if {$snapy > $y2 -$s2} {set snapy [expr $y2 -$s2]}
    set snapy [expr $y0 +($yminus *2 -1) *$snapy]

    set toP [lindex [lindex $mapxy2p $yminus] [expr $xori *$gridx +7]]
    set snapx [expr $x0 +$s * $xori *[lindex $mapp2x $toP]]
    $w move selected [expr $snapx -$lastX] [expr $snapy -$lastY]

    set lastX $snapx
    set lastY $snapy
}


#-------------------------------------------------------------------
# releasechecker --
# This procedure is invoked when the mouse is relased.
#
# Arguments:
# w -		The canvas window.
# x, y -	The coordinates of the mouse.

proc releasechecker {w x y} {
    global fromP toP c

    $w dtag selected

    # 1: Computer, -1: Player
    if {[set c(1,0,$toP)] <= 1} {
	incr c(-1,0,$fromP) -1
	incr c(-1,0,$toP)

	if {([set c(1,0,$toP)] == 1) && ($toP < 25)} {
	    incr c(1,0,$toP) -1
	    incr c(1,0,25)
	}
    }
    showcheckers 0
}


#-------------------------------------------------------------------
# GUI Inits
proc guiinit {} {
    global checkerlist dicelist boardlist thinkerlist thinkercnt
    global boardstyle xori pcol totturn plot checkertag
    global s2 os x0 y0 brown col fcol fbcol dicecol
    global plotFont miniFont largeFont mapxy2p mapp2x
    global s x1 x2 x3 y1 y2 posx posy
    global px1 py1 cx1 cy1 px2 px3 dicex
    global data thinknot think dice

    set checkerlist {}
    set dicelist {}
    set boardlist {}
    set thinkerlist {}
    set thinkercnt 0

    set boardstyle -1 ;# plain style
    set xori 1
    set pcol 1
    set totturn -2
    set plot(lastX) 0
    set plot(lastY) 0
    set checkertag(1)  compckecker
    set checkertag(-1) playerchecker


    # Graphic parameters

    set s2 15		;# half size of a checker
    set os 4		;# displacement of piled up checkers
    set x0 [expr $s2 *15 +10]		;# center of the board
    set y0 [expr $s2 *11 +40]		;# center of the board

    set brown "brown"
    set col(1,1) white	;# white checkers
    set col(1,2) black	;# border of white checkers
    set col(1,3) grey	;# when mouse enters white checkers
    set col(-1,2) $brown	;# border of black checkers
    set col(-1,1) black	;# black checkers
    set col(-1,3) dimgrey	;# when mouse enters black checkers

    set fcol(1,0) ""
    set fcol(1,1) ""
    set fbcol(1,0) $brown
    set fbcol(1,1) white
    set fcol(-1,0) $brown
    set fcol(-1,1) white
    set fbcol(-1,0) black
    set fbcol(-1,1) black

    set dicecol(1)  white
    set dicecol(-1) $brown

    set plotFont {-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*}
    set miniFont {-*-Helvetica-Medium-R-Normal--*-80-*-*-*-*-*-*}
    set largeFont {-*-times-bold-r-normal-*-40-400-*-*-*-*-*-*}


    set mapxy2p {{1  1  2  3  4  5  6  0  7  8  9 10 11 12 12} \
	    {25 24 23 22 21 20 19 19 18 17 16 15 14 13 13}}
    set mapp2x {0 -6 -5 -4 -3 -2 -1 1 2 3 4 5 6 6 5 4 3 2 1\
	    -1 -2 -3 -4 -5 -6 -7}


    # Graphic variables

    set s [expr 2 * $s2]
    set x1 $s2
    set x2 [expr $s2 + 6 * $s]
    set x3 [expr $s2 + 7 * $s]
    set y1 $s2
    set y2 [expr $s2 + 5 * $s]

    # Bear off coordinates
    for {set py 1} {$py <= 15} {incr py} {
	set posx(0,$py) [expr -7 * $s]
	set posy(0,$py) [expr 5 * $s -$os * ($py - 1)]
    }

    # Bar coordinates
    for {set py 1} {$py <= 15} {incr py} {
	set posx(25,$py) 0
	set posy(25,$py) [expr -$s -$os * ($py - 1)]
    }

    # All other coordinates
    for {set px 0} {$px <= 5} {incr px} {
	for {set py 0} {$py <= 14} {incr py} {
	    # First board
	    set px1 [expr $px + 1]
	    set py1 [expr $py + 1]
	    set cx1 [expr ($px - 6) * $s + $os * ($py / 5)]
	    set cy1 [expr (5 - ($py % 5)) * $s - $os * ($py / 5)]
	    set posx($px1,$py1) $cx1
	    set posy($px1,$py1) $cy1

	    # Second board
	    set px2 [expr $px + 7]
	    set posx($px2,$py1) [expr $cx1 + 7 * $s]
	    set posy($px2,$py1) $cy1

	    # Third board
	    set px3 [expr $px + 13]
	    set posx($px3,$py1) [expr -$cx1]
	    set posy($px3,$py1) [expr -$cy1]

	    # Fourth board
	    set px3 [expr $px + 19]
	    set posx($px3,$py1) [expr -$cx1 - 7 * $s]
	    set posy($px3,$py1) [expr -$cy1]
	}
    }

    # Dice coordinates
    set dicex(1) [expr 3 * $s]
    set dicex(2) [expr 4 * $s]

    # Create the bitmap images
    image create bitmap thinknot -data $data(think.bmp)
    thinknot configure -background ""

    for {set thinkercnt 0} {$thinkercnt <= 8} {incr thinkercnt} {
	image create bitmap think($thinkercnt) \
		-data [set data(think${thinkercnt}.bmp)]
	think($thinkercnt) configure -background ""
    }

    for {set dicecnt 1} {$dicecnt <= 6} {incr dicecnt} {
	image create bitmap dice($dicecnt) \
		-data [set data(dice${dicecnt}.bmp)]
	# dice($dicecnt) configure -background ""
    }
}


#-------------------------------------------------------------------
# Buttons: Quit, Undo, Go, Restart, Board
proc makebuttons {} {
    frame .buttons
    pack .buttons -side bottom -fill x -pady 2m
    button .buttons.restart -text Start \
	    -command "set restartrequest 1; set playerdone 1"
    button .buttons.undo -text Undo -command "undocmd"
    button .buttons.go -text " Go " -command "set playerdone 1"
    button .buttons.side -text Side -command {set xori [expr -$xori]; \
	    showcheckers 0; showdices}
    button .buttons.color -text Color -command {set pcol [expr -$pcol]; \
	    showcheckers 0; showdices}
    pack .buttons.restart .buttons.undo .buttons.go \
	    .buttons.side .buttons.color -side left -expand 1 -fill x
}


#-------------------------------------------------------------------
# Canvas graphic elements
proc makecanvas {} {
    global x0 y2 plotFont brown x2 y2 y0 col pcol 

    canvas .c -relief raised -width [expr 2 * $x0] -height [expr 2 * $y2 + 40]
    pack .c -side top -fill x

    .c create text $x0 20 -text "Phi's Backgammon" \
	    -font $plotFont -fill $brown
    .c create rect [expr $x0 -$x2] [expr $y0 -$y2] \
	    [expr $x0 +$x2] [expr $y0 +$y2] -width 4

    .c bind compckecker <Any-Enter> {.c itemconfig current \
	    -fill [set col($pcol,3)]}
    .c bind playerchecker <Any-Enter> {.c itemconfig current \
	    -fill [set col([expr -$pcol],3)]}
    .c bind compckecker <Any-Leave> {.c itemconfig current \
	    -fill [set col($pcol,1)]}
    .c bind playerchecker <Any-Leave> {.c itemconfig current \
	    -fill [set col([expr -$pcol],1)]}
    .c bind playerchecker <1> "grabchecker .c %x %y"
    .c bind playerchecker <ButtonRelease-1> "releasechecker .c %x %y"
    .c bind playerchecker <B1-Motion> "movechecker .c %x %y"
}


#-------------------------------------------------------------------
# Init
proc init {} {
    global boardstyle

    gameinit
    bitmapdata
    guiinit
    makecanvas
    makebuttons

    # Create the board
    showboard $boardstyle
    showcheckers 0
}


#-------------------------------------------------------------------
# Main loop
proc main {} {
    global restartrequest compwon playerwon 
    global x0 y0 largeFont totturns

    set compwon 0
    set playerwon 0
    while 1 {
	# Wait for pressing "Start"
	set restartrequest 0
	vwait restartrequest

	# Start a new game
	if $playerwon {.c delete $won}
	if $compwon {.c delete $lost}
	set compwon 0
	set playerwon 0

	while {!$compwon && !$playerwon} {
	    set restartrequest 0
	    restart
	}

	if $playerwon {
	    set won [.c create text $x0 $y0 \
		    -text "You won in $totturns turns!" \
		    -font $largeFont -fill red -anchor center]
	}
	if $compwon {
	    set lost [.c create text $x0 $y0 \
		    -text "You lost in $totturns turns!" \
		    -font $largeFont -fill red -anchor center]
	}
    }
}

#-------------------------------------------------------------------
#-------------------------------------------------------------------
#-------------------------------------------------------------------

#
#	The picdata (machine generated)
#

proc bitmapdata {} {
    global data

set data(dice1.bmp) {
   #define dice1_width 27
   #define dice1_height 27
   static unsigned char dice1_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x70, 0x00, 0x06,
      0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06,
      0x03, 0x70, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(dice2.bmp) {
   #define dice2_width 27
   #define dice2_height 27
   static unsigned char dice2_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x00, 0x06,
      0xe3, 0x03, 0x00, 0x06, 0xe3, 0x03, 0x00, 0x06, 0xe3, 0x03, 0x00, 0x06,
      0xc3, 0x01, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x1c, 0x06,
      0x03, 0x00, 0x3e, 0x06, 0x03, 0x00, 0x3e, 0x06, 0x03, 0x00, 0x3e, 0x06,
      0x03, 0x00, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(dice3.bmp) {
   #define dice3_width 27
   #define dice3_height 27
   static unsigned char dice3_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x00, 0x06,
      0xe3, 0x03, 0x00, 0x06, 0xe3, 0x03, 0x00, 0x06, 0xe3, 0x03, 0x00, 0x06,
      0xc3, 0x01, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x70, 0x00, 0x06,
      0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06,
      0x03, 0x70, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x1c, 0x06,
      0x03, 0x00, 0x3e, 0x06, 0x03, 0x00, 0x3e, 0x06, 0x03, 0x00, 0x3e, 0x06,
      0x03, 0x00, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(dice4.bmp) {
   #define dice4_width 27
   #define dice4_height 27
   static unsigned char dice4_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(dice5.bmp) {
   #define dice5_width 27
   #define dice5_height 27
   static unsigned char dice5_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x70, 0x00, 0x06,
      0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06, 0x03, 0xf8, 0x00, 0x06,
      0x03, 0x70, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(dice6.bmp) {
   #define dice6_width 27
   #define dice6_height 27
   static unsigned char dice6_bits[] = {
      0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0xc3, 0x01, 0x1c, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06,
      0xc3, 0x01, 0x1c, 0x06, 0xe3, 0x03, 0x3e, 0x06, 0xe3, 0x03, 0x3e, 0x06,
      0xe3, 0x03, 0x3e, 0x06, 0xc3, 0x01, 0x1c, 0x06, 0x03, 0x00, 0x00, 0x06,
      0x03, 0x00, 0x00, 0x06, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0x07};
}
set data(think.bmp) {
   #define think_width 23
   #define think_height 15
   static unsigned char think_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
      0x00, 0x00, 0x00, 0x80, 0x0f, 0x00, 0x60, 0x30, 0x00, 0x10, 0x40, 0x00,
      0x08, 0x80, 0x00, 0x08, 0x80, 0x00, 0x08, 0x9b, 0x00, 0x04, 0x9b, 0x00,
      0x73, 0x40, 0x00, 0xde, 0x3f, 0x00, 0x00, 0x00, 0x00};
}
set data(think0.bmp) {
   #define think1_width 23
   #define think1_height 15
   static unsigned char think1_bits[] = {
      0x00, 0x00, 0x00, 0x80, 0x0f, 0x00, 0x60, 0x30, 0x00, 0x10, 0x40, 0x00,
      0x50, 0x60, 0x00, 0x88, 0x99, 0x00, 0x08, 0x89, 0x00, 0x08, 0x80, 0x00,
      0x08, 0x89, 0x00, 0x08, 0x80, 0x00, 0x08, 0x40, 0x00, 0x04, 0x40, 0x00,
      0x73, 0x30, 0x00, 0xde, 0x1f, 0x00, 0x00, 0x00, 0x00};
}
set data(think1.bmp) {
   #define think2_width 23
   #define think2_height 15
   static unsigned char think2_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1f, 0x00, 0xc0, 0x60, 0x00,
      0x20, 0x80, 0x00, 0x90, 0x40, 0x01, 0x10, 0x33, 0x01, 0x10, 0x12, 0x01,
      0x10, 0x00, 0x01, 0x10, 0x12, 0x01, 0x10, 0x80, 0x00, 0x08, 0x80, 0x00,
      0xe6, 0x60, 0x00, 0xbc, 0x3f, 0x00, 0x00, 0x00, 0x00};
}
set data(think2.bmp) {
   #define think3_width 23
   #define think3_height 15
   static unsigned char think3_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x7c, 0x00, 0x00, 0x83, 0x01, 0x80, 0x00, 0x02,
      0x80, 0x02, 0x03, 0x40, 0xcc, 0x04, 0x40, 0x48, 0x04, 0x40, 0x00, 0x04,
      0x40, 0x48, 0x04, 0x40, 0x00, 0x04, 0x40, 0x00, 0x02, 0x20, 0x00, 0x02,
      0x98, 0x83, 0x01, 0xf0, 0xfe, 0x00, 0x00, 0x00, 0x00};
}
set data(think3.bmp) {
   #define think4_width 23
   #define think4_height 15
   static unsigned char think4_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x06, 0x03,
      0x00, 0x01, 0x04, 0x80, 0x04, 0x0a, 0x80, 0x98, 0x09, 0x80, 0x90, 0x08,
      0x80, 0x00, 0x08, 0x80, 0x90, 0x08, 0x80, 0x00, 0x04, 0x40, 0x00, 0x04,
      0x30, 0x07, 0x03, 0xe0, 0xfd, 0x01, 0x00, 0x00, 0x00};
}
set data(think4.bmp) {
   #define think6_width 23
   #define think6_height 15
   static unsigned char think6_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x06, 0x03, 0x00, 0x01, 0x04,
      0x00, 0x03, 0x05, 0x80, 0xcc, 0x08, 0x80, 0x48, 0x08, 0x80, 0x00, 0x08,
      0x80, 0x48, 0x08, 0x80, 0x00, 0x08, 0x00, 0x01, 0x08, 0x00, 0x01, 0x10,
      0x00, 0x06, 0x67, 0x00, 0xfc, 0x3d, 0x00, 0x00, 0x00};
}
set data(think5.bmp) {
   #define think7_width 23
   #define think7_height 15
   static unsigned char think7_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0x00, 0x01, 0x01,
      0x80, 0x00, 0x02, 0x40, 0x81, 0x04, 0x40, 0x66, 0x04, 0x40, 0x24, 0x04,
      0x40, 0x00, 0x04, 0x40, 0x24, 0x04, 0x80, 0x00, 0x04, 0x80, 0x00, 0x08,
      0x00, 0x83, 0x33, 0x00, 0xfe, 0x1e, 0x00, 0x00, 0x00};
}
set data(think6.bmp) {
   #define think8_width 23
   #define think8_height 15
   static unsigned char think8_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x1f, 0x00, 0xc0, 0x60, 0x00, 0x20, 0x80, 0x00,
      0x60, 0xa0, 0x00, 0x90, 0x19, 0x01, 0x10, 0x09, 0x01, 0x10, 0x00, 0x01,
      0x10, 0x09, 0x01, 0x10, 0x00, 0x01, 0x20, 0x00, 0x01, 0x20, 0x00, 0x02,
      0xc0, 0xe0, 0x0c, 0x80, 0xbf, 0x07, 0x00, 0x00, 0x00};
}
set data(think7.bmp) {
   #define think9_width 23
   #define think9_height 15
   static unsigned char think9_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x20, 0x20, 0x00,
      0x10, 0x40, 0x00, 0x28, 0x90, 0x00, 0xc8, 0x8c, 0x00, 0x88, 0x84, 0x00,
      0x08, 0x80, 0x00, 0x88, 0x84, 0x00, 0x10, 0x80, 0x00, 0x10, 0x00, 0x01,
      0x60, 0x70, 0x06, 0xc0, 0xdf, 0x03, 0x00, 0x00, 0x00};
}
set data(think8.bmp) {
   #define think9_width 23
   #define think9_height 15
   static unsigned char think9_bits[] = {
      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x20, 0x20, 0x00,
      0x10, 0x40, 0x00, 0x28, 0x90, 0x00, 0xc8, 0x8c, 0x00, 0x88, 0x84, 0x00,
      0x08, 0x80, 0x00, 0x88, 0x84, 0x00, 0x10, 0x80, 0x00, 0x10, 0x00, 0x01,
      0x60, 0x70, 0x06, 0xc0, 0xdf, 0x03, 0x00, 0x00, 0x00};
}


}

#-------------------------------------------------------------------
#-------------------------------------------------------------------
#-------------------------------------------------------------------

#
#	Call init and main
#

init
main

#-------------------------------------------------------------------
#-------------------------------------------------------------------
#-------------------------------------------------------------------