# player-flags.tcl --
#
#

namespace eval NSPlayerFlags {

variable Priv

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

proc InitModule {} {

	global Windows
	variable Priv

	set Priv(slots) {
		INVEN_WIELD
		INVEN_BOW
		INVEN_LEFT
		INVEN_RIGHT
		INVEN_NECK
		INVEN_LITE
		INVEN_BODY
		INVEN_OUTER
		INVEN_ARM
		INVEN_HEAD
		INVEN_HANDS
		INVEN_FEET
	}

	set Priv(flags) {
		STR
		INT
		WIS
		DEX
		CON
		CHR
		SUST_STR
		SUST_INT
		SUST_WIS
		SUST_DEX
		SUST_CON
		SUST_CHR
		IM_ACID
		IM_ELEC
		IM_FIRE
		IM_COLD
		RES_ACID
		RES_ELEC
		RES_FIRE
		RES_COLD
		RES_POIS
		RES_FEAR
		RES_LITE
		RES_DARK
		RES_BLIND
		RES_CONF
		RES_SOUND
		RES_SHARDS
		RES_NEXUS
		RES_NETHER
		RES_CHAOS
		RES_DISEN
		SLOW_DIGEST
		FEATHER
		LITE
		REGEN
		TELEPATHY
		SEE_INVIS
		REFLECT
		FREE_ACT
		HOLD_LIFE
		STEALTH
		SEARCH
		INFRA
		TUNNEL
		SPEED
		BLOWS
		XTRA_SHOTS
		XTRA_MIGHT
		SLAY_ANIMAL
		SLAY_EVIL
		SLAY_UNDEAD
		SLAY_DEMON
		SLAY_ORC
		SLAY_TROLL
		SLAY_GIANT
		SLAY_DRAGON
		KILL_DRAGON
		BRAND_POIS
		BRAND_ACID
		BRAND_ELEC
		BRAND_FIRE
		BRAND_COLD
		SH_FIRE
		SH_ELEC
		VORPAL
		IMPACT
		CHAOTIC
		VAMPIRIC
		WRAITH
		NO_MAGIC
		TELEPORT
		NO_TELE
		AGGRAVATE
		DRAIN_EXP
		BLESSED
		CURSED
		HEAVY_CURSE
		PERMA_CURSE
		TY_CURSE
	}

	NSObject::New NSPlayerFlags
}

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

proc NSPlayerFlags oop {

	global Windows

	InitWindow $oop

	NSWindowManager::RegisterWindow playerflags [Info $oop win] \
		"NSPlayerFlags::GeometryCmd $oop" "" "NSPlayerFlags::DisplayCmd $oop"

	#
	# Global list of application windows
	#

	set Windows(playerflags,win) [Info $oop win]
	set Windows(playerflags,class) NSPlayerFlags
	set Windows(playerflags,oop) $oop
}

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

proc Info {oop info args} {

	global NSPlayerFlags

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

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

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

proc InitWindow oop {

	global Windows
	variable Priv

	set win .playerflags$oop
	toplevel $win
	wm title $win "Character Flags"
	wm resizable $win no no

	wm transient $win $Windows(main,win)

	# Start out withdrawn (hidden)
	wm withdraw $win

	# Do stuff when window closes
	wm protocol $win WM_DELETE_WINDOW "NSPlayerFlags::Close $oop"

	Info $oop win $win

	if {[winfo screenwidth .] > 800} {
		set font {{MS Sans Serif} 10}
	} else {
		set font {{MS Sans Serif} 8}
	}
	set lineHgt [font metrics $font -linespace]

	set canvas $win.header
	set width 100
	set height 40
	canvas $canvas \
		-scrollregion "0 0 $width $height" \
		-width $width -height $height \
		-relief flat -highlightthickness 0 -background gray40

	Info $oop header,canvas $canvas

	set canvas $win.canvas
	set width 100
	set height [expr $lineHgt * 22]
	canvas $canvas \
		-scrollregion "0 0 $width [expr ($lineHgt + 3) * 32]" \
		-width $width -height $height -yscrollincrement [expr $lineHgt + 3] \
		-highlightthickness 0 -background #000022 \
		-yscrollcommand "$win.yscroll set"
	scrollbar $win.yscroll \
		-orient vertical -command "$canvas yview"
	bind $win.yscroll <Map> "eval %W set \[$canvas yview]"
	Info $oop canvas $canvas

	#
	# Statusbar
	#

	frame $win.statusBar \
		-relief flat -borderwidth 0
	frame $win.statusBar.filler1 -borderwidth 1 -height 1
	label $win.statusBar.label \
		-anchor w -relief sunken -padx 2 -foreground #80FFFF -background Black
	pack $win.statusBar.filler1 \
		-side top -fill x
	pack $win.statusBar.label \
		-side left -expand yes -fill both

	grid rowconfigure $win 0 -weight 0
	grid rowconfigure $win 1 -weight 0
	grid rowconfigure $win 2 -weight 0
	grid columnconfigure $win 0 -weight 0
	grid columnconfigure $win 1 -weight 0

	grid $win.header -row 0 -column 0 -rowspan 1 -columnspan 2 -sticky ew
	grid $win.canvas -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid $win.yscroll -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky ns
	grid $win.statusBar -row 2 -column 0 -rowspan 1 -columnspan 2 -sticky ew

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

	InitLayout $oop

	bind $win <KeyPress-Escape> \
		"NSPlayerFlags::Close $oop"
}

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

proc DisplayCmd {oop message first} {

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

# NSPlayerFlags::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+$x+$y
}

# NSPlayerFlags::Close --
#
#	Do something when closing the window.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Close oop {

	angband_display playerflags hide
}

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

proc InitLayout oop {

	variable Priv

	set win [Info $oop win]
	set canvas [Info $oop header,canvas]

	set labels {
		"Strength"
		"Intelligence"
		"Wisdom"
		"Dexterity"
		"Constitution"
		"Charisma"
		"Sust. Strength"
		"Sust. Intelligence"
		"Sust. Wisdom"
		"Sust. Dexterity"
		"Sust. Constitution"
		"Sust. Charisma"
		"Immune Acid"
		"Immune Electricity"
		"Immune Fire"
		"Immune Cold"
		"Res. Acid"
		"Res. Electricity"
		"Res. Fire"
		"Res. Cold"
		"Res. Poison"
		"Res. Fear"
		"Res. Light"
		"Res. Dark"
		"Res. Blindness"
		"Res. Confusion"
		"Res. Sound"
		"Res. Shards"
		"Res. Nexus"
		"Res. Nether"
		"Res. Chaos"
		"Res. Disenchant"
		"Slow Digestion"
		"Feather Falling"
		"Permanent Light"
		"Regeneration"
		"Telepathy"
		"See Invisible"
		"Reflect Missile"
		"Free Action"
		"Hold Life"
		"Stealth"
		"Searching"
		"Infravision"
		"Tunnel"
		"Speed"
		"Num. Blows"
		"Num. Shots"
		"Extra Might"
		"Slay Animal"
		"Slay Evil"
		"Slay Undead"
		"Slay Demon"
		"Slay Orc"
		"Slay Troll"
		"Slay Giant"
		"Slay Dragon"
		"*Slay* Dragon"
		"Poison Brand"
		"Acid Brand"
		"Electricity Brand"
		"Fire Brand"
		"Frost Brand"
		"Fire Aura"
		"Electric Aura"
		"Vorpal Blade"
		"Shatterquake"
		"Chaotic"
		"Vampiric"
		"Wraith"
		"Anti-Magic"
		"Teleport"
		"Anit-Teleport"
		"Aggravate"
		"Drain Exp."
		"Blessed"
		"Cursed"
		"Heavily Cursed"
		"Permanently Cursed"
		"Ancient Foul Curse"
	}

	# Calculate the width of the row labels
	# Width = Text Width + 2 pixels + 2 * 2
	set labelWidth 100
	foreach label $labels {
		set width [expr [font measure $Priv(font,font) $label] + 2 + (2 * 2)]
		if {$width > $labelWidth} {
			set labelWidth $width
		}
	}

	# Calculate the width of the canvas
	set width [expr $labelWidth + (32 + 2) * ([llength $Priv(slots)] + 1)]
	$canvas configure -width [expr $width + 16]

	# One icon per equipment slot
	set x [expr $labelWidth + 16] ; set y 20
	foreach slot $Priv(slots) {
		$canvas create widget $x $y -anchor center -type default -index 0 \
			-tags $slot
		$canvas bind $slot <Enter> \
			"NSPlayerFlags::StatusBar_Slot $oop $slot"
		$canvas bind $slot <Leave> \
			"$win.statusBar.label configure -text {}"
		incr x [expr 32 + 2]
	}

	# Character icon
	$canvas create widget $x $y -anchor center -type default -index 0 -tags py
	$canvas bind py <Enter> \
		"$win.statusBar.label configure -text \"\[angband player name], the\
			\[angband player race] \[angband player class]\""
	$canvas bind py <Leave> \
		"$win.statusBar.label configure -text {}"

	set canvas [Info $oop canvas]
	$canvas configure -width $width

	set x 2 ; set y 0
	foreach label $labels flag $Priv(flags) {

		$canvas create rectangle $x $y [expr $labelWidth - 2] \
			[expr $y + $Priv(font,height) + 2] -fill gray40 -tags $flag
		$canvas create rectangle $labelWidth $y $width \
			[expr $y + $Priv(font,height) + 2] -fill "" -outline "" \
			-tags "rect $flag $flag,rect"
		$canvas create text [expr $labelWidth / 2] [expr $y + 1] -anchor n \
			-text $label -font $Priv(font,font) -fill White -tags $flag

		$canvas bind $flag <Enter> \
			"%W itemconfigure $flag,rect -fill #333366 -outline #333366"
		$canvas bind $flag <Leave> \
			"%W itemconfigure $flag,rect -fill {} -outline {}"

		# Dot for each slot
		set x2 [expr $labelWidth + 16]
		foreach slot $Priv(slots) {
			$canvas create oval [expr $x2 - 2] [expr $y + 9 - 2] \
				[expr $x2 + 2] [expr $y + 9 + 2] -fill "" -outline "" \
				-tags "$flag,$slot $flag $flag,dot"
			incr x2 34
		}

		# Dot for character
		$canvas create oval [expr $x2 - 2] [expr $y + 9 - 2] \
			[expr $x2 + 2] [expr $y + 9 + 2] -fill "" -outline "" \
			-tags "$flag,py $flag $flag,dot"
		
		incr y [expr $Priv(font,height) + 3]
	}
}

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

proc SetInfo oop {

	variable Priv

	set header [Info $oop header,canvas]
	set canvas [Info $oop canvas]

	foreach flag $Priv(flags) {
		set bbox [$canvas bbox $flag]
		$canvas move $flag 0 -[expr [lindex $bbox 1] + 40]
		$canvas itemconfigure $flag,dot -fill "" -outline ""
		set visible($flag) 0
	}

	foreach slot $Priv(slots) {
		angband equipment info $slot attrib
		if $attrib(k_idx) {
			scan $attrib(icon) "%s %d" type index
		} else {
			set type none
			set index 0
		}
		$header itemconfigure $slot -type $type -index $index

		foreach flag [angband equipment flags $slot] {
			$canvas itemconfigure $flag,$slot -fill White -outline White
			set visible($flag) 1
		}
	}

	scan [angband player char_attr] "%s %d" type index
	$header itemconfigure py -type $type -index $index
	foreach flag [angband player flags] {
		$canvas itemconfigure $flag,py -fill White -outline White
		set visible($flag) 1
	}

	
	set y 0
	foreach flag $Priv(flags) {
		if $visible($flag) {
			$canvas move $flag 0 [expr $y + 40]
			incr y [expr $Priv(font,height) + 3]
		}
	}

	$canvas configure -scrollregion [list 0 0 [winfo reqwidth $canvas] $y]
	$canvas yview moveto 0

	# Configure for no vertical scroll bar
	set win [Info $oop win]
	grid remove $win.yscroll
	grid configure $canvas -columnspan 2

	# Show the vertical scroll bar if needed
	if {[$canvas yview] != "0 1"} {
		grid $win.yscroll
		grid configure $canvas -columnspan 1
	}
}

# NSPlayerFlags::StatusBar_Slot --
#
#	Put the name of the item in the given slot in the status bar.
#	Also displays item recall.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc StatusBar_Slot {oop slot} {

	global Windows

	set win [Info $oop win]

	angband equipment info $slot attrib
	if $attrib(k_idx) {
		$win.statusBar.label configure -text $attrib(name)
	}

	# Get object info
	angband equipment info $slot attrib

	# Ignore non-objects in equipment
	if !$attrib(k_idx) {
		NSRecall::SetText $Windows(recall,oop) {none 0} White "" ""
		return
	}

	set icon $attrib(icon)
	set color [default_tval_to_attr $attrib(tval)]
	set desc $attrib(name):
	set memory [angband equipment memory $slot]
	NSRecall::SetText $Windows(recall,oop) $icon $color $desc $memory
}

# namespace eval NSPlayerFlag
}

