/* Copyright (c) 1996--1999 Geoff Pike. */
/* All rights reserved. */

/* Floater 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. */

/* This software is provided "as is" and comes with absolutely no */
/* warranties.  Geoff Pike is not liable for damages under any */
/* circumstances.  Support is not provided.  Use at your own risk. */

/* Personal, non-commercial use is allowed.  Attempting to make money */
/* from Floater or products or code derived from Floater is not allowed */
/* without prior written consent from Geoff Pike.  Anything that remotely */
/* involves commercialism, including (but not limited to) systems that */
/* show advertisements while being used and systems that collect */
/* information on users that is later sold or traded require prior */
/* written consent from Geoff Pike. */
gset newstyle_matrix 1

global tinymat smallmat screenheight screenwidth
set tinymat [expr $screenheight <= 600]
set smallmat [expr !$tinymat && ($screenheight <= 800)]

if {$tinymat || $smallmat} {
#include "matrixsize.deq"
    if $tinymat {
	tryset fixedfont {Courier 8}
        tinymatrix
    } else {
	tryset fixedfont {Courier 10}
	smallmatrix 0 30
    }
} else {
    tryset fixedfont {Courier 12}
#include "matrixbig.deq"
}

if $tinymat {gset fixedfont {Courier 8}}



foreach p {lho rho pard self} {gset matrixcards($p) 0}

proc matrix_showcards {b who} {
    global matrixcards matrix_showing
    if {$b != $matrixcards($who)} {
	global canv
	set c $canv(c)
	if [set matrixcards($who) $b] {
	    $c coords $canv(frame,$who) $canv(exilex) $canv(exiley)
	} else {
	    $c coords $canv(frame,$who) $canv(mx,$who) \
		    [expr $canv(my,$who) + \
		    ($matrix_showing ? 0 : $canv(YMatrixHide))]
	}	
    }
}    

proc highlight_card {tag w x y} {
    global canv
    $w itemconfigure $tag -background #c0c0c0
    set canv(highlighted) [$w find withtag $tag]
}

proc unhighlight_card {tag w x y} {
    global canv
    $w itemconfigure $tag -background white
    catch {unset canv(highlighted)}
}

set last_click_card_time -1
proc click_card {tag w time x y} {
    global canv last_click_card_time last_click_card_x last_click_card_y

    // ignore second click of a double click (Floater uses single clicks)
    if {$last_click_card_time > 0
        && [expr $time - $last_click_card_time] < 750
        && [expr abs($last_click_card_x - $x)] < 5
        && [expr abs($last_click_card_y - $y)] < 5} return
    set last_click_card_time $time
    set last_click_card_x $x
    set last_click_card_y $y

    if [info exists canv(highlighted)] {
	if {$canv(highlighted) == [$w find withtag $tag]} {
	    command $canv(item_to_card,[$w find withtag $tag])
	}
    }
}

proc canvsetup {c} {
    global canv cardwidth cardheight matrixcards cardrectvgap

    catch {destroy $c}
    canvas $c -height $canv(height)
    set canv(c) $c
    set x [set canv(exilex) -2000]
    set y [set canv(exiley) 0]
    set canv(fg,s) black
    set canv(fg,h) red
    set canv(fg,d) red
    set canv(fg,c) black
    set canv(bg,s) white
    set canv(bg,h) white
    set canv(bg,d) white
    set canv(bg,c) white
    foreach suit {s h d c} {
	foreach card {a k q j t 9 8 7 6 5 4 3 2} {
	    set n [$c create bitmap $x $y -tags livecard]
	    $c itemconfigure $n -bitmap c_$card$suit \
		    -background $canv(bg,$suit) -foreground $canv(fg,$suit)
	    set canv(fg_,$n) $canv(fg,$suit)
	    set canv(item_to_card,$n) $suit$card
	    set canv($card$suit) $n
	    set canv([string toupper $card]$suit) $n
	    set canv($card[string toupper $suit]) $n
	    set canv([string toupper $card$suit]) $n
	}
    }

// bindings
    $c bind livecard <Any-Enter> { highlight_card current %W %x %y }
    $c bind livecard <Any-Leave> { unhighlight_card current %W %x %y }
    $c bind livecard <ButtonRelease-1> { click_card current %W %t %x %y }

    set bbox [$c bbox $canv(as)]
    set cardwidth [expr [lindex $bbox 2] - [lindex $bbox 0]]
    set cardheight [expr [lindex $bbox 3] - [lindex $bbox 1]]

// names
    global namefont namewid namex namey
    foreach p {self pard} {
	set namewid($p) [
	$c create text $namex($p) $namey($p) -font $namefont -justify center
	]
    }
    foreach p {lho rho} {
	// Left edge of name aligns with left edge of leftmost card.
	set x [expr $namex($p) - $cardwidth / 2]
	set namewid($p) [
	$c create text $x $namey($p) -font $namefont -justify left -anchor w 
	]
    }

    global lhomaxx handx handy
    eval "$c create rect $canv(matrix)"
    set matrixleft [set lhomaxx [lindex $canv(matrix) 0]]
    set matrixright [lindex $canv(matrix) 2]
    set matrixtop [lindex $canv(matrix) 1]
    set matrixbot [lindex $canv(matrix) 3]
    set canv(YMatrixHide) [expr - ($matrixbot + 4)]
    set canv(matrixHiddenHeight) \
	    [expr $handy(self) - $matrixbot + $cardheight / 2 + 3]

// where in the matrix cards are displayed
    set canv(mx,lho) [expr $matrixleft + $cardwidth / 2 + 5]
    set canv(my,lho) [expr ($matrixtop + $matrixbot) / 2]
    set canv(mx,rho) [expr $matrixright - $cardwidth / 2 - 5]
    set canv(my,rho) [expr ($matrixtop + $matrixbot) / 2]
    set canv(mx,self) $handx(self)
    set canv(my,self) [expr $matrixbot - $cardheight / 2 - $cardrectvgap]
    set canv(mx,pard) $canv(mx,self)
    set canv(my,pard) [expr $matrixtop + $cardheight / 2 + $cardrectvgap]

    global suitfont cardfont
// text in the matrix (for question marks only)
    foreach p {lho self rho pard} {
	set canv(matrixtext,$p) [
	$c create text $canv(mx,$p) $canv(my,$p) -font $cardfont
	]
    }

// text in the matrix (for the auction)
    foreach p {lho self rho pard} {
	set path [frame $c.f$p]
	refont [label $path.card -font $cardfont -borderwidth 0] cardfont
	refont [label $path.suit -font $suitfont -borderwidth 0] suitfont
	pack $path.card $path.suit -side left
	set canv(frame,$p) \
		[$c create window $canv(mx,$p) $canv(my,$p) -window $path]
	set matrixcards($p) 0
    }

}

// Display a player's name above his cards
// player should be lho, rho, pard, or self
proc setname {player compassdir name} {
    global namefont playername position canv namewid

    set playername($player) $name
    set position($player) $compassdir
    set f $namewid($player)
    set w $canv(c)
    if {[string first "(" $name] == -1} {set name "$name  ($compassdir)"}
    catch {$w itemconfigure $f -text $name} c
    if {$c != ""} {}
}

proc eraseallcards {} {
    erasebidplay all
    foreach suit {s h d c} {
	foreach card {a k q j t 9 8 7 6 5 4 3 2} {
	    erasecard $suit $card
	}
    }
}

// Erase a card, and reset its color to its normal color.
proc erasecard {suit card} {
    global canv

    drawcard $suit $card $canv(exilex) $canv(exiley)
    $canv(c) itemconfigure $canv($card$suit) -foreground $canv(fg,$suit)
}

proc drawcard {suit card x y} {
    global canv

    set c $canv(c)
    showMatrix 1
    $c coords $canv($card$suit) $x $y
}

// Becoming a spectator and other violent reconfigurations of the screen may
// destroy the matrix.  This should restore any cards that were there.
proc redrawmatrixcards {} {
    global canv

    foreach p {lho rho self pard} {
	if [info exists canv(matrixcard,$p)] {
	    eval "showplay $p $canv(matrixcard,$p)"
	}
    }
}

#define erasecardifnotinmatrix erasecard

//proc erasecardifnotinmatrix {suit card} {
//    global canv
//    
//    set x [string toupper "$suit $card"]
//    foreach p {lho rho self pard} {
//	if [info exists canv(matrixcard,$p)] {
//	    if ![string compare $x [string toupper $canv(matrixcard,$p)]] return
//	}
//    }
//    erasecard $suit $card
//}

// redraw who's hand after removing the indicated card
proc redohand {who suit card} {
    global curhandx curhandy hands handsx handsy

    regsub -nocase $card [set o $hands($who,$suit)] {} n
    // catch {talkmsg "redohand $who $suit $card ($o => $n)"}
    if [string compare $n $o] {
	erasecardifnotinmatrix $suit $card
	if {$who == "lho" || $who == "rho"} {
	    // only redraw the suit affected if lho or rho
	    set curhandx $handsx($who,$suit)
	    set curhandy $handsy($who,$suit)
	    suit $who $n $suit
	} else {
	    set hands($who,$suit) $n
	    hand $who \
		    $hands($who,s) $hands($who,h) $hands($who,d) $hands($who,c)
	}
    }
}

// Restore any and all purple cards to their normal color.
proc tprestore {} {
    global canv purple
    set c $canv(c)
    foreach t [array names purple] {
	unset purple($t)
	catch {talkmsg "Restoring color to $t"}
	$c itemconfig $t -foreground $canv(fg_,$t)
    }
}

proc tpcard {what} {
    global canv purple
    set c $canv(c)
    set t $canv($what)
    if ![info exists purple($t)] {
	set purple($t) 1
	$c itemconfig $t -foreground purple
	lappend canv(maybepass) $t
	// talkmsg "tpcard: $what set to purple"
    } else {
	unset purple($t)
	$c itemconfig $t -foreground $canv(fg_,$t)
	// talkmsg "tpcard: $what set to $canv(fg_,$t)"
    }
}

proc suit {who cards suit} {
    global removecard togglepassedaction cardgap curhandx curhandy \
	    lhomaxx rhomaxx cardwidth hands handsx handsy canv

    // talkmsg "suit $who $cards $suit"
    set hands($who,$suit) $cards
    set handsx($who,$suit) $curhandx
    set handsy($who,$suit) $curhandy
    set l [string length $cards]
    set spacing $cardgap
    set xmin [expr $cardwidth / 2]
    if {$who == "lho" || $who == "rho"} {
	if {$l > 6} {incr spacing -2}
	if {$l > 7} {incr spacing -3}
	if {$l > 8} {incr spacing -2}
	if {$l > 9} {incr spacing -3}
	if {$spacing < 10} {set spacing 10}
	if {$who == "lho"} {set xmax $lhomaxx} {set xmax rhomaxx}
	while {[expr $curhandx + $cardwidth / 2 + ($l - 1) * $spacing + 3] \
		> $xmax} {
	    if {$curhandx > $xmin} {incr curhandx -3} {incr spacing -1}
	}
    }
    if {$curhandx < $xmin} {set curhandx xmin}
    for {set i 0} {$i < $l} {incr i} {
	set card [string index $cards $i]
	drawcard $suit $card $curhandx $curhandy
	set removecard([string toupper $suit$card]) "redohand $who $suit $card"
	set togglepassedaction([string toupper $suit$card]) "tpcard $card$suit"
	set canv(dealt,[string tolower $suit$card]) 1
	incr curhandx $spacing
    }
}


proc hand {who s h d c} {
    global handx handy curhandx curhandy suitgap cardgap hands vgap \
	    ourcardgap theircardgap

    // catch {talkmsg "hand $who $s $h $d $c"}
    if {$who == "self" || $who == "pard"} {
	set cardgap $ourcardgap
	set width [expr ([string length $s] + [string length $h] + [string length $d] + [string length $c]) * $cardgap + (([string length $s] > 0) + ([string length $h] > 0) + ([string length $d] > 0)) * $suitgap]
	set curhandx [expr $handx($who) - round(0.5 * $width)]
	set curhandy $handy($who)

	suit $who $s s
	if {$s != ""} {incr curhandx $suitgap}
	suit $who $h h
	if {$h != ""} {incr curhandx $suitgap}
	suit $who $d d
	if {$d != ""} {incr curhandx $suitgap}
	suit $who $c c
    } else {
	set cardgap $theircardgap
	set curhandx $handx($who)
	set curhandy $handy($who)
	suit $who $s s
	incr curhandy $vgap
	set curhandx $handx($who)
	incr curhandx 10
	suit $who $h h
	incr curhandy $vgap
	set curhandx $handx($who)
	suit $who $d d
	incr curhandy $vgap
	set curhandx $handx($who)
	incr curhandx 10
	suit $who $c c
    }
}

proc fulldeal_erase_straglers {} {
    global canv
    foreach suit {s h d c} {
	foreach card {a k q j t 9 8 7 6 5 4 3 2} {
	    if !$canv(dealt,$suit$card) { erasecardifnotinmatrix $suit $card }
	}
    }
}

// draw the given cards and erase any others
proc fulldeal {s h d c LHOs LHOh LHOd LHOc \
		   Ps Ph Pd Pc RHOs RHOh RHOd RHOc} {
    global canv

    // catch {talkmsg "full $s $h $d $c . $LHOs $LHOh $LHOd $LHOc . $Ps $Ph $Pd $Pc . $RHOs $RHOh $RHOd $RHOc"}

    foreach suit {s h d c} {
	foreach card {a k q j t 9 8 7 6 5 4 3 2} {
	    set canv(dealt,$suit$card) 0
	}
    }

    tprestore


    if {"$Ps$Ph$Pd$Pc$LHOs$LHOh$LHOd$LHOc$RHOs$RHOh$RHOd$RHOc" != ""} {
	// common case
	hand self $s $h $d $c
	hand pard $Ps $Ph $Pd $Pc
	hand lho $LHOs $LHOh $LHOd $LHOc
	hand rho $RHOs $RHOh $RHOd $RHOc
	fulldeal_erase_straglers
    } else {
	// Special case: a fulldeal only showing my cards shouldn't
	// affect whether the matrix is showing.
	global matrix_showing
	set z $matrix_showing
	hand self $s $h $d $c
	hand pard $Ps $Ph $Pd $Pc
	hand lho $LHOs $LHOh $LHOd $LHOc
	hand rho $RHOs $RHOh $RHOd $RHOc
	fulldeal_erase_straglers
	showMatrix $z // restore state of matrix to what it was initially
    }
}

// for testing
proc sillynames {} {
    setname self S {hairy dude}
    setname lho W {skinny dude}
    setname pard N {goofball}
    setname rho E {elephant water}
}    

proc matrixtext {player s {options {}}} {
    global canv

    eval "$canv(c) itemconfigure $canv(matrixtext,$player) -text \{$s\} \
	    $options"
}

proc showplay {player suit card} {
    global canv

    if {$suit == "?"} {
	matrixtext $player "?"
    } else {
	removecardfromhand $suit $card
	erasebidplay $player
	matrix_showcards 1 $player
	drawcard $suit $card $canv(mx,$player) $canv(my,$player)
	set canv(matrixcard,$player) "$suit $card"
    }
}

proc showbid {player level strain} {
    global canv

    matrix_showcards 0 $player
    drawbid $canv(c).f$player $level $strain
}

// Erase a bid or play from the matrix
// who should be lho, rho, pard, self, or all
proc erasebidplay {who} {
    global tricktimeOK

    while {!$tricktimeOK} {
	update
	after 100
    }
    if {$who == "all"} {
	global needtoerase

	set needtoerase 0
	erasebidplay lho
	erasebidplay rho
	erasebidplay pard
	erasebidplay self
    } else {
	global canv
	matrixtext $who ""
	if [info exists canv(matrixcard,$who)] {
	    eval "erasecard $canv(matrixcard,$who)"
	    unset canv(matrixcard,$who)
	}
	matrix_showcards 1 $who
    }
}