# player.tcl --
#
#	Character info window.
#

namespace eval NSPlayer {

variable Priv

# NSPlayer::InitModule --
#
#	One-time-only-ever initialization.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc InitModule {} {

	global Windows

	NSObject::New NSPlayer
}

# NSPlayer::NSPlayer --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc NSPlayer oop {

	global Windows

	InitWindow $oop

	NSWindowManager::RegisterWindow player [Info $oop win] \
		"NSPlayer::GeometryCmd $oop" "" "NSPlayer::DisplayCmd $oop"

	#
	# Global list of application windows
	#

	set Windows(player,win) [Info $oop win]
	set Windows(player,class) NSPlayer
	set Windows(player,oop) $oop
}

# NSPlayer::Info --
#
#	Query and modify info.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Info {oop info args} {

	global NSPlayer

	# Set info
	if {[llength $args]} {
		switch -- $info {
			default {
				set NSPlayer($oop,$info) [lindex $args 0]
			}
		}

	# Get info
	} else {
		switch -- $info {
			default {
				return $NSPlayer($oop,$info)
			}
		}
	}
}

# NSPlayer::InitWindow --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc InitWindow oop {

	global NSPlayer
	global Windows
	variable Priv

	set win .player$oop
	toplevel $win
	wm title $win "Character Info"
	wm resizable $win no no

	# Character creation
	if {[info exists Windows(main,win)]} {
		wm transient $win $Windows(main,win)
	}

	# Start out withdrawn (hidden)
	wm withdraw $win

	# Do stuff when window closes
	wm protocol $win WM_DELETE_WINDOW "angband keypress \033"

	set NSPlayer($oop,win) $win

	InitMenus $oop

	set font [Global font,fixed,normal]
	set charWid [font measure $font "W"]
	set lineHgt [font metrics $font -linespace]

	set c $win.canvas
	set width [expr $charWid * 80]
	set height [expr $lineHgt * 25]
	canvas $c \
		-scrollregion "0 0 $width $height" \
		-width $width -height $height \
		-relief flat -highlightthickness 0 -background #000022

	set NSPlayer($oop,canvas) $c

	pack $c \
		-expand no

	set Priv(font,font) $font
	set Priv(font,width) $charWid
	set Priv(font,height) $lineHgt

	InitLayout $oop

	#
	# Feed Term when keys pressed
	#

	bind $win <KeyPress> {
		angband keypress %A
	}

	bind $win <KeyPress-c> "NSPlayer::ChangeName $oop"
	bind $win <KeyPress-f> "FileCharacter $win"
	bind $win <KeyPress-h> {
		angband_display playerflags show
	}
}

# NSPlayer::InitMenus --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc InitMenus oop {
}

# NSPlayer::DisplayCmd --
#
#	Called by NSWindowManager::Display().
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc DisplayCmd {oop message first} {

	switch -- $message {
		preDisplay {
			SetInfo $oop
		}
		postDisplay {
		}
	}
}

# NSPlayer::GeometryCmd --
#
#	Called by NSWindowManager::Setup(). Returns the desired (default)
#	geometry for the window.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc GeometryCmd oop {

	global Windows

	set win [Info $oop win]
	set winMain $Windows(main,win)
	set x [winfo x $winMain]
	set y [winfo y $winMain]
	set width [winfo width $win]
	set height [winfo height $win]
	return ${width}x$height+[winfo x $winMain]+[winfo y $winMain]
}

# NSPlayer::InitLayout --
#
#	Create all the canvas items.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc InitLayoutAux {oop col row width align labelList} {

	foreach label $labelList {
		if {$label != "-"} {
			AddTextItem $oop $col $row $width White $label $align {}
		}
		incr row
	}
}

proc InitLayoutAux2 {oop col row width align tagList} {

	foreach tag $tagList {
		if {$tag != "-"} {
			AddTextItem $oop $col $row $width White "" $align $tag
		}
		incr row
	}
}

proc InitLayout oop {

	global NSPlayer
	variable Priv

	# Prompt
	AddTextItem $oop 1 0 -1 White "" left prompt

	set labelList {
		"Name"
		"Sex"
		"Race"
		"Class"
		"Title"
		"Realm 1"
		"Realm 2"
		"Patron"
	}
	InitLayoutAux $oop 1 2 -1 left $labelList

	set labelList {
		Age
		Height
		Weight
		"Status"
		HP
		SP
		"Maximize"
		"Preserve"
	}
	InitLayoutAux $oop 26 2 -1 left $labelList

	set titles {
		{47 2 "  Self"}
		{54 2 " RB"}
		{58 2 " CB"}
		{62 2 " EB"}
		{66 2 "  Best"}
	}
	foreach title $titles {
		set col [lindex $title 0]
		set row [lindex $title 1]
		set text [lindex $title 2]
		AddTextItem $oop $col $row -1 White $text left {}
	}

	set labelList {
		STR:
		INT:
		WIS:
		DEX:
		CON:
		CHR:
	}
	InitLayoutAux $oop 42 3  -1 left $labelList

	set labelList {
		Level
		"Cur Exp"
		"Max Exp"
		"Adv Exp"
		-
		Gold
		-
		Burden
	}
	InitLayoutAux $oop 1 11  -1 left $labelList

	set labelList {
		"Armor"
		"Fight"
		"Melee"
		"Shoot"
		"Blows"
		"Shots"
		-
		"Infra"
	}
	InitLayoutAux $oop 26 11  -1 left $labelList

	set labelList {
		"Saving Throw"
		"Stealth"
		"Fighting"
		"Shooting"
		"Disarming"
		"Magic Device"
		"Perception"
		"Searching"
	}
	InitLayoutAux $oop 49 11  -1 left $labelList


	set labelList {
		name
		sex
		race
		class
		title
		realm1
		realm2
		patron
	}
	InitLayoutAux2 $oop 10 2 -1 left $labelList

	set labelList {
		age
		height
		weight
		social_class
		*hp
		*sp
		maximize
		preserve
	}
	InitLayoutAux2 $oop 34 2 4 right $labelList

	set labelList {
		strength.max
		intelligence.max
		wisdom.max
		dexterity.max
		constitution.max
		charisma.max
	}
	InitLayoutAux2 $oop 47 3 6 right $labelList

	set labelList {
		strength.race
		intelligence.race
		wisdom.race
		dexterity.race
		constitution.race
		charisma.race
	}
	InitLayoutAux2 $oop 54 3 3 right $labelList

	set labelList {
		strength.class
		intelligence.class
		wisdom.class
		dexterity.class
		constitution.class
		charisma.class
	}
	InitLayoutAux2 $oop 58 3 3 right $labelList

	set labelList {
		strength.equip
		intelligence.equip
		wisdom.equip
		dexterity.equip
		constitution.equip
		charisma.equip
	}
	InitLayoutAux2 $oop 62 3 3 right $labelList

	set labelList {
		strength.top
		intelligence.top
		wisdom.top
		dexterity.top
		constitution.top
		charisma.top
	}
	InitLayoutAux2 $oop 66 3 6 right $labelList

	set labelList {
		strength.use
		intelligence.use
		wisdom.use
		dexterity.use
		constitution.use
		charisma.use
	}
	InitLayoutAux2 $oop 73 3 6 right $labelList

	set labelList {
		level
		exp
		expmax
		expadv
		-
		gold
		-
		*burden
	}
	InitLayoutAux2 $oop 9 11 10 right $labelList

	set labelList {
		*armor
		*fight
		*melee
		*shoot
		*blows
		*shots
		-
		*infra
	}
	InitLayoutAux2 $oop 31 11 13 right $labelList

	set labelList {
		saving_throw
		stealth
		fighting
		bows_throw
		disarming
		magic_device
		perception
		searching
	}
	InitLayoutAux2 $oop 63 11 9 right $labelList

	# History
	set x [expr 5 * $Priv(font,width)]
	set y [expr 20 * $Priv(font,height)]
	$NSPlayer($oop,win).canvas create text $x $y -fill White -text "" \
		-font $Priv(font,font) -justify left -anchor nw -tags history
}

variable likert_color

#
# Returns a "rating" of x depending on y
#
proc likert {x y} {

	variable likert_color

	# Paranoia
	if {$y <= 0} {
		set y 1
	}

	# Negative value
	if {$x < 0} {
		set likert_color Red
		return "Very Bad"
	}

	# Analyze the value
	switch [expr $x / $y] {

		0 -
		1 {
			set likert_color Red
			return "Bad"
		}
		2 {
			set likert_color Red
			return "Poor"
		}
		3 -
		4 {
			set likert_color Yellow
			return "Fair"
		}
		5 {
			set likert_color Yellow
			return "Good"
		}
		6 {
			set likert_color Yellow
			return "Very Good"
		}
		7 -
		8 {
			set likert_color LawnGreen
			return "Excellent"
		}
		9 -
		10 -
		11 -
		12 -
		13 {
			set likert_color LawnGreen
			return "Superb"
		}
		14 -
		15 -
		16 -
		17 {
			set likert_color turquoise2
			return "Chaos Rank"
		}
		default {
			set likert_color Violet
			return "Amber \[[expr int((((($x / $y) - 17) * 5) / 2))]\]"
		}
	}
}

# NSPlayer::SetInfo --
#
#	Set text of character-specific items.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetInfo oop {

	global NSPlayer
	variable Priv
	variable likert_color

	set canvas $NSPlayer($oop,win).canvas

	# Prompt
	$canvas itemconfigure prompt -text \
		"Type 'c' to change name, 'f' to file, 'h' for flags, or ESC"

	set attribs {name sex race class title}
	foreach attrib $attribs {
		$canvas itemconfigure $attrib -text [angband player $attrib] \
			-fill turquoise2
	}

	# Get hitpoint warning
	set hitpoint_warn [lindex [angband setting hitpoint_warn] 0]

	# Hit Points
	set info [angband player hitpoints]
	set cur [lindex $info 0]
	set max [lindex $info 1]
	if {$cur >= $max} {
		set fill turquoise2
	} elseif {$cur > ($max * $hitpoint_warn) / 10} {
		set fill Yellow
	} else {
		set fill Red
	}
	$canvas itemconfigure *hp -text "$cur/$max" -fill $fill

	# Spell Points
	set info [angband player mana]
	set cur [lindex $info 0]
	set max [lindex $info 1]
	if {$cur >= $max} {
		set fill turquoise2
	} elseif {$cur > ($max * $hitpoint_warn) / 10} {
		set fill Yellow
	} else {
		set fill Red
	}
	$canvas itemconfigure *sp -text "$cur/$max" -fill $fill

	set attribs {age height weight social_class patron}
	foreach attrib $attribs {
		$canvas itemconfigure $attrib -text [angband player $attrib] \
			-fill turquoise2
	}

	foreach attrib {realm1 realm2} {
		set text [angband player $attrib]
		if {![string compare $text "no magic"]} {
			set text "None"
		}
		$canvas itemconfigure $attrib -text $text -fill turquoise2
	}

	foreach attrib {maximize preserve} {
		set text [expr {[angband player $attrib] ? "Y" : "N"}]
		$canvas itemconfigure $attrib -text $text -fill turquoise2
	}

	set attribs {level gold}
	foreach attrib $attribs {
		$canvas itemconfigure $attrib -text [angband player $attrib] \
			-fill LawnGreen
	}

	# Burden
	set weight [angband player total_weight]
	set burden [format "%d.%d lbs" [expr $weight / 10] [expr $weight % 10]]
	$canvas itemconfigure *burden -text $burden -fill LawnGreen

	# Stats
	set attribs {strength intelligence wisdom dexterity constitution charisma}
	foreach attrib $attribs {
		angband player stat $attrib statInfo
		$canvas itemconfigure $attrib.max -text [cnv_stat_disp $statInfo(max)] \
			-fill LawnGreen
		foreach mod {race class equip} {
			if {$statInfo($mod) > 99} {
				$canvas itemconfigure $attrib.$mod \
					-text +++ -fill turquoise2
			} else {
				$canvas itemconfigure $attrib.$mod \
					-text [format "%+d" $statInfo($mod)] -fill turquoise2
			}
		}
		$canvas itemconfigure $attrib.top -text [cnv_stat_disp $statInfo(top)] \
			-fill LawnGreen
		if {$statInfo(use) < $statInfo(top)} {
			$canvas itemconfigure $attrib.use \
				-text [cnv_stat_disp $statInfo(use)] -fill Yellow
		} else {
			$canvas itemconfigure $attrib.use -text ""
		}
	}

	# Experience
	set info [angband player exp]
	set cur [lindex $info 0]
	set max [lindex $info 1]
	set adv [lindex $info 2]
	if {$cur >= $max} {
		set fill LawnGreen
	} else {
		set fill Yellow
	}
	if {$adv == 999999999} {
		set adv *****
	}
	$canvas itemconfigure exp -text $cur -fill $fill
	$canvas itemconfigure expmax -text $max -fill LawnGreen
	$canvas itemconfigure expadv -text $adv -fill LawnGreen

	# Armor
	set info [angband player armor_class]
	set base [lindex $info 0]
	set plus [format "%+d" [lindex $info 1]]
	$canvas itemconfigure *armor -text "\[$base,$plus]" -fill turquoise2

	# Fight
	set hit [format "%+d" [angband player to_hit]]
	set dam [format "%+d" [angband player to_dam]]
	$canvas itemconfigure *fight -text "($hit,$dam)" -fill turquoise2

	# Melee
	set hit [angband player to_hit]
	set dam [angband player to_dam]
	angband equipinfo INVEN_WIELD dump
	if $dump(known) {incr hit $dump(to_h)}
	if $dump(known) {incr dam $dump(to_d)}
	set hit [format "%+d" $hit]
	set dam [format "%+d" $dam]
	$canvas itemconfigure *melee -text "($hit,$dam)" -fill turquoise2

	# Shoot
	set hit [angband player to_hit]
	set dam 0
	angband equipinfo INVEN_BOW dump
	if $dump(known) {incr hit $dump(to_h)}
	if $dump(known) {incr dam $dump(to_d)}
	set hit [format "%+d" $hit]
	set dam [format "%+d" $dam]
	$canvas itemconfigure *shoot -text "($hit,$dam)" -fill turquoise2

	# Blows
	set blows [angband player blows_per_round]
	$canvas itemconfigure *blows -text "$blows/turn" -fill turquoise2

	# Shots
	set shots [angband player shots_per_round]
	$canvas itemconfigure *shots -text "$shots/turn" -fill turquoise2

	# Infravision
	set infra [angband player infravision]
	$canvas itemconfigure *infra -text "$infra ft" -fill turquoise2

	set attribs {fighting bows_throw saving_throw stealth}
	append attribs { perception searching disarming magic_device}
	foreach attrib $attribs {
		$canvas itemconfigure $attrib \
			-text [eval likert [angband player ability $attrib]] \
			-fill $likert_color
	}

	$canvas itemconfigure history -text [angband player history]
}

# NSPlayer::WipeInfo --
#
#	Clear text of character-specific items.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc WipeInfo oop {

	global NSPlayer

	set canvas $NSPlayer($oop,win).canvas

	set tags {
		prompt
		name sex race class title realm1 realm2 patron
		age height weight social_class *hp *sp maximize preserve
		*armor *fight *melee *shoot *blows *shots *infra
		level exp expmax expadv gold *burden
		fighting bows_throw saving_throw stealth
		perception searching disarming magic_device
		history
	}

	foreach tag $tags {
		$canvas itemconfigure $tag -text {}
	}

	set tags {strength intelligence wisdom dexterity constitution charisma}
	foreach tag $tags {
		foreach mod {max race class equip top use} {
			$canvas itemconfigure $tag.$mod -text ""
		}
	}
}

# NSPlayer::AddTextItem --
#
#	Create a new canvas text item with given option values.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc AddTextItem {oop col row width fill text justify tags} {

	global NSPlayer
	variable Priv

	set canvas $NSPlayer($oop,win).canvas
	if {$justify == "right"} {
		incr col $width
		set anchor ne
	} else {
		set anchor nw
	}
	set x [expr $col * $Priv(font,width)]
	set y [expr $row * $Priv(font,height)]
	set width [expr $width * $Priv(font,width)]
	$canvas create text $x $y -fill $fill -text $text \
		-font $Priv(font,font) -justify $justify -anchor $anchor -tags $tags
}

# NSPlayer::ChangeName --
#
#	Allows the user to enter a new character name.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc ChangeName oop {

	global NSPlayer

	set name [GetName $oop [angband player name] 1]
	if {$name == ""} return
	angband player name $name

	$NSPlayer($oop,canvas) itemconfigure name -text $name
	angband_notice name
}

# NSPlayer::GetName --
#
#	Allows the user to enter a new character name.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc GetName_PutName {} {

	variable Priv

	set nameFrame $Priv(frame)
	set name $Priv(name)
	set fill White
	if $Priv(default) {set fill Yellow}

	for {set i 0} {$i < 15} {incr i} {
		set letter $nameFrame.letter$i.label
		set char [string index $name $i]
		if {$char != {}} {
			$letter configure -text $char -background $fill
		} else {
			$letter configure -text {} -background SystemButtonFace
		}
	}
}

proc GetName_KeyPress ascii {

	variable Priv

	if {![string match {[a-zA-Z0-9 ]} $ascii]} return

	if $Priv(default) {
		set Priv(name) ""
		set Priv(length) 0
		set Priv(default) 0
	}

	if {$Priv(length) == 15} return
	append Priv(name) $ascii
	incr Priv(length)
	GetName_PutName
}

proc GetName_Delete {} {

	variable Priv

	if $Priv(default) {
		set Priv(name) ""
		set Priv(length) 0
		set Priv(default) 0
		GetName_PutName
		return
	}

	if !$Priv(length) return
	incr Priv(length) -1
	set end [expr $Priv(length) - 1]
	set Priv(name) [string range $Priv(name) 0 $end]
	GetName_PutName
}

proc GetName {oop default allowAbort} {

	global NSPlayer
	global Windows
	variable Priv

	# Get the canvas
	set canvas $NSPlayer($oop,canvas)

	# Selection rectangle around canvas item
	set heightBy2 [expr $Priv(font,height) / 2]
	set width [expr $Priv(font,width) * 15 + 2]
	set bbox [$canvas bbox name]
	set bbox [lreplace $bbox 2 2 [expr [lindex $bbox 0] + $width]]
	eval $canvas create rectangle $bbox -outline Red -width 2.0 \
		-tags selectBox

	$canvas create line [lindex $bbox 2] [expr [lindex $bbox 1] + $heightBy2] \
		[expr [lindex $bbox 2] + 30] [expr [lindex $bbox 1] + $heightBy2] \
		-width 2.0 -fill Red -tags selectBox

	# Create a frame with 15 one-character label widgets
	set frame $canvas.nameFrame
	frame $frame \
		-borderwidth 2 -relief ridge
	for {set i 0} {$i < 15} {incr i} {
		set letterBox $frame.letter$i
		frame $letterBox \
			-borderwidth 1 -relief sunken
		label $letterBox.label \
			-font $Priv(font,font) -width 1
		pack $letterBox \
			-side left -padx 1 -expand no
		pack $letterBox.label
	}

	place $frame \
		-x [expr [lindex $bbox 2] + 30] \
		-y [expr [lindex $bbox 1] + $heightBy2] \
		-anchor w

	bindtags $frame $frame
	bind $frame <KeyPress> "NSPlayer::GetName_KeyPress %A"
	bind $frame <BackSpace> NSPlayer::GetName_Delete
	bind $frame <Return> "set NSPlayer::Priv(result) 1"
	if $allowAbort {
		bind $frame <Escape> "set NSPlayer::Priv(result) 0"
	}

	set Priv(frame) $frame

	# Set a grab and claim the focus too.
	NSUtils::GrabSave $frame
	focus $frame

	set Priv(result) -1
	set Priv(name) $default
	set Priv(length) [string length $Priv(name)]
	set Priv(default) $Priv(length)
	GetName_PutName

	# Wait for the user to accept or cancel
	vwait NSPlayer::Priv(result)

	# Release grab and focus
	NSUtils::GrabRelease $frame

	$canvas delete selectBox
	destroy $frame

	if $Priv(result) {
		return $Priv(name)
	}
	return {}
}

# namespace eval NSPlayer
}

proc RebootPlayer {} {

	global Angband
	global Windows

	destroy $Windows(player,win)
	uplevel #0 source [file join $Angband(dirTK) player.tcl]
	NSObject::New NSPlayer
}
