# keymap.tcl --
#
#	The Keymap Window and related commands.
#

namespace eval NSKeymap {

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

proc InitModule {} {

	InitImageIfNeeded Image_Open open.gif
	InitImageIfNeeded Image_Save save.gif

	NSObject::New NSKeymap
}

# NSKeymap::NSKeymap --
#
#	Object constructor called by NSObject::New().
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc NSKeymap oop {

	global Windows

	InitWindow $oop

	# Which key is selected
	Info $oop current ""

	# Radiobutton (must match inital NSKeyboard setting)
	Info $oop mode shift

	set win [Info $oop win]

	NSWindowManager::RegisterWindow keymap $win \
		"NSKeymap::GeometryCmd $oop" "" "NSKeymap::DisplayCmd $oop"

	#
	# Global list of application windows
	#

	set Windows(keymap,win) [Info $oop win]
	set Windows(keymap,class) NSKeymap
	set Windows(keymap,oop) $oop
}

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

proc Info {oop info args} {

	global NSKeymap

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

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

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

proc InitWindow oop {

	global NSCanvist
	global NSKeymap
	global NSToolbar
	global Windows

	set win .keymap$oop
	toplevel $win
	wm title $win Keymap

	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 "NSKeymap::Close $oop"

	Info $oop win $win

	InitMenus $oop

	#
	# Toolbar
	#

	set toolId [NSObject::New NSToolbar 20 $win]
	NSToolbar::AddTool $toolId Image_Open "NSKeymap::KeymapLoad $oop"
	NSToolbar::AddTool $toolId Image_Save "NSKeymap::KeymapDump $oop"

	NSStatusText::StatusText [NSToolbar::GetTool $toolId 1] \
		$win.statusBar.label \
		"Read settings from an existing preferences file."
	NSStatusText::StatusText [NSToolbar::GetTool $toolId 2] \
		$win.statusBar.label \
		"Append keymaps to a new or existing preferences file."

	#
	# Divider
	#

	frame $win.divider2 \
		-borderwidth 1 -height 2 -relief groove

	#
	# Keymap
	#

	set keyboardId [NSObject::New NSKeyboard $win]
	NSKeyboard::Info $keyboardId command "NSKeymap::SelectionChanged $oop"
	set canvas [NSKeyboard::Info $keyboardId canvas]

	NSStatusText::StatusText $canvas \
		$win.statusBar.label \
		"Click to select a key."

	Info $oop keyboardId $keyboardId

	#
	# Action
	#

	set frame $win.frameFields
	frame $frame \
		-borderwidth 0
	label $frame.labelAction \
		-text "Action:"
	entry $frame.entryAction \
		-width 20
	pack $frame.labelAction \
		-side left -padx 2 -pady 5
	pack $frame.entryAction \
		-side left -fill x -padx 2 -pady 5

	Info $oop action,entry $frame.entryAction

	# Keymap action is updated on Return
	set entry $frame.entryAction
	bind $entry <KeyPress-Return> "NSKeymap::SetKeymapAction $oop"

	NSStatusText::StatusText $win.frameFields.entryAction $win.statusBar.label \
		"Enter an encoded action and hit Enter."

	#
	# Unmodified, Shift, Control
	#

	radiobutton $frame.unmodified \
		-text Normal -variable NSKeymap($oop,mode) -value unmodified \
		-command "NSKeyboard::SetMode $keyboardId unmodified"
	radiobutton $frame.shift \
		-text Shift -variable NSKeymap($oop,mode) -value shift \
		-command "NSKeyboard::SetMode $keyboardId shift"
	radiobutton $frame.control \
		-text Control -variable NSKeymap($oop,mode) -value control \
		-command "NSKeyboard::SetMode $keyboardId control"
	pack $frame.unmodified \
		-side left -padx 2 -pady 0
	pack $frame.shift \
		-side left -padx 2 -pady 0
	pack $frame.control \
		-side left -padx 2 -pady 0


	#
	# Statusbar
	#

	frame $win.statusBar -relief flat -borderwidth 0
	label $win.statusBar.label -anchor w -relief sunken -padx 2
	pack $win.statusBar.label -side left -expand yes -fill both

	#
	# Geometry
	#

	grid rowconfig $win 0 -weight 0 -minsize 0
	grid rowconfig $win 1 -weight 0 -minsize 0
	grid rowconfig $win 2 -weight 1 -minsize 0
	grid rowconfig $win 3 -weight 0 -minsize 0
	grid rowconfig $win 4 -weight 0 -minsize 0
	grid columnconfig $win 0 -weight 1 -minsize 0
 
	pack forget $NSToolbar($toolId,frame)
	grid $NSToolbar($toolId,frame) -in $win \
		-row 0 -column 0 -rowspan 1 -columnspan 1 -sticky ew
	grid $win.divider2 -in $win \
		-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky ew
	grid $canvas -in $win \
		-row 2 -column 0 -rowspan 1 -columnspan 1 -sticky {} -padx 2 -pady 2
	grid $win.frameFields -in $win \
		-row 3 -column 0 -rowspan 1 -columnspan 1 -sticky w
	grid $win.statusBar -in $win \
		-row 4 -column 0 -rowspan 1 -columnspan 1 -sticky ew

	#
	# KeyPress bindings
	#

	bind $win <KeyPress-Escape> "NSKeymap::Close $oop"
	bind $win <Control-KeyPress-w> "NSKeymap::Close $oop"
}

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

proc InitMenus oop {

	# Default accelerator modifier
	set mod "Ctrl"

	set win [Info $oop win]

	#
	# Menu bar
	#

	set menuDef "-tearoff 0 -postcommand \"NSKeymap::SetupMenus $oop\" -identifier MENUBAR"
	Info $oop mbar [NSObject::New NSMenu $win $menuDef]
	set mbar [Info $oop mbar]

	#
	# Keymap Menu
	#

	NSObject::New NSMenu $mbar {-tearoff 0 -identifier MENU_KEYMAP }
	NSMenu::MenuInsertEntry $mbar -end MENUBAR {-type cascade -menu MENU_KEYMAP -label "Keymap" -underline 0 -identifier M_KEYMAP}

	set entries {}
	lappend entries "-type command -label \"Dump Keymaps\" -command \"NSKeymap::KeymapDump $oop\" -underline 0 -identifier E_KEYMAP_DUMP"
	lappend entries "-type command -label \"Load Pref File\" -command \"NSKeymap::KeymapLoad $oop\" -underline 0 -identifier E_KEYMAP_LOAD"
	lappend entries "-type separator"
	lappend entries "-type command -label \"Close\" \
		-command \"NSKeymap::Close $oop\" -underline 0 \
		-accelerator $mod+W -identifier E_CLOSE"

	NSMenu::MenuInsertEntries $mbar -end MENU_KEYMAP $entries
}

# NSKeymap::SetupMenus --
#
#	Description
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetupMenus {oop mbarId} {

	lappend identList E_KEYMAP_DUMP E_KEYMAP_LOAD E_CLOSE

	NSMenu::MenuEnable $mbarId $identList
}

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

proc DisplayCmd {oop message first} {

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

# NSKeymap::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
}

# NSKeymap::Close --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Close oop {

	NSWindowManager::Undisplay keymap
}

# NSKeymap::SelectionChanged --
#
#	Called by NSKeyboard when a key is selected, or when a key becomes
#	unselected (and no new key is selected). Synchronizes the action
#	entry with the keymap action of the selected key, or clears the
#	action entry when no key is selected.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SelectionChanged {oop key} {

	# Clear the action entry
	set entry [Info $oop action,entry]
	$entry delete 0 end

	if {$key != ""} {
		$entry insert 0 [angband keymap action $key]
	}

	Info $oop current $key
}

# NSKeymap::SetKeymapAction --
#
#	Grabs the text from the Action entry and calls "angband keymap" to
#	set the keymap action.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetKeymapAction oop {

	set key [Info $oop current]
	if {$key == ""} return

	set entry [Info $oop action,entry]
	angband keymap action $key [$entry get]

	# Feedback on assigned/unassigned state
	UpdateKeymap $oop
}

# NSKeymap::UpdateKeymap --
#
#	Redisplay the keyboard. Needed because the keyset may change, and
#	because pref files may be read in.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc UpdateKeymap oop {

	set keyboardId [Info $oop keyboardId]
	NSKeyboard::Display $keyboardId
}

# NSKeymap::KeymapLoad --
#
#	Read a preferences file from lib/user.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc KeymapLoad oop {

	if {[ProcessPrefFile [Info $oop win]]} return
	UpdateKeymap $oop
}

# NSKeymap::KeymapDump --
#
#	Get a filename from the user then append current keymaps to the given
#	file (or create a new file). The file goes inside the lib/user
#	directory.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc KeymapDump oop {

	global Angband

	set parent [Info $oop win]

	set filename [tk_getSaveFile -initialfile [angband player base_name].prf \
		-initialdir [file join $Angband(dir) lib user] -parent $parent]
	if {![string compare $filename ""]} return

	if {![IsUserFile $filename]} {
		tk_messageBox -title "Pref File Error" -icon info -message \
			"Pref files must be saved in the lib/user directory."
		return
	}

	set filename [file tail $filename]
	if {[catch {angband game keymap_dump $filename} result]} {
		tk_messageBox -title "Pref File Error" -icon error -message $result
	}
}

# namespace eval NSKeymap
}


namespace eval NSKeyboard {

# NSKeyboard::NSKeyboard --
#
#	Object constructor called by NSObject::New().
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc NSKeyboard {oop parent} {

	set canvas $parent.keyboard$oop
	canvas $canvas \
		-background White -width 368 -height 132 \
		-highlightthickness 0 -borderwidth 1 -relief sunken \
		-takefocus 1

	bind $canvas <ButtonPress-1> \
		"NSKeyboard::Button1 $oop %x %y"
	bind $canvas <Button1-Motion> \
		"NSKeyboard::Motion1 $oop %x %y"

	Info $oop canvas $canvas
	Info $oop keys {}
	Info $oop command {}

	set x 0
	set y 0
	set width 24
	set height 28

	set offset $width

	foreach {key1 show1 key2 show2} [list ~ 1  ` 1  ! 1  1 1  @ 1  2 1  # 1  3 1  $ 1  4 1  % 1  5 1  ^ 1  6 1  & 1  7 1  * 1  8 2  ( 1  9 1  ) 1  0 1  _ 1  - 1  + 1 = 1] { 
		AddKey $oop $width $height $key1 $show1 $key2 $show2
		$canvas move temp $x $y
		$canvas dtag temp
		incr x $width
	}

	set x [incr offset [expr $width / 2]]
	incr y $height
	foreach {key1 show1 key2 show2} [list Q 1 q 0 W 1 w 0 E 1 e 0 R 1 r 0 T 1 t 0 Y 1 y 0 U 1 u 0 I 1 i 0 O 1 o 0 P 1 p 0 \{ 1 \[ 1 \} 1 \] 1 | 1 \\ 1] { 
		AddKey $oop $width $height $key1 $show1 $key2 $show2
		$canvas move temp $x $y
		$canvas dtag temp
		incr x $width
	}

	set x [incr offset [expr $width / 2]]
	incr y $height
	foreach {key1 show1 key2 show2} [list A 1 a 0 S 1 s 0 D 1 d 0 F 1 f 0 G 1 g 0 H 1 h 0 J 1 j 0 K 1 k 0 L 1 l 0 : 1 \; 1 \" 1 ' 1] { 
		AddKey $oop $width $height $key1 $show1 $key2 $show2
		$canvas move temp $x $y
		$canvas dtag temp
		incr x $width
	}

	set x [incr offset [expr $width / 2]]
	incr y $height
	foreach {key1 show1 key2 show2} [list Z 1 z 0 X 1 x 0 C 1 c 0 V 1 v 0 B 1 b 0 N 1 n 0 M 1 m 0 < 1 , 1 > 1 . 1 ? 1 / 1] { 
		AddKey $oop $width $height $key1 $show1 $key2 $show2
		$canvas move temp $x $y
		$canvas dtag temp
		incr x $width
	}

	$canvas move all 10 10

	$canvas create line 0 132 368 132 368 0 -fill gray90

	# We can display "shifted" keys or "unshifted" keys. Any key that
	# has two symbols displayed (such as @/2) will have the other key
	# grayed out. Keys with only one symbol (such as Q) will have that
	# symbol changed depending on the "shifted" state.

	# Click a key to select it
	Info $oop current ""
#	$canvas bind all <ButtonPress-1> \
#		"NSKeyboard::ClickKey $oop %x %y"

	# Start out in "shift" state
	Info $oop mode shift
	Display $oop
}

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

proc Info {oop info args} {

	global NSKeyboard

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

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

# NSKeyboard::AddKey --
#
#	Create canvas items for a key.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc AddKey {oop width height char1 show1 char2 show2} {

	set canvas [Info $oop canvas]

	$canvas create rectangle 0 0 $width $height -fill White \
		-tags [list key_$char1 rect_$char1 temp]
	$canvas create text 8 7 -text $char1 -font {Courier 9} \
		-tags [list key_$char1 text_$char1 temp] 
	if $show2 {
		$canvas create text 8 19 -text $char2 -font {Courier 9}\
			-tags [list key_$char1 text_$char2 temp]
	}

	Info $oop key,$char1,show $show2
	Info $oop key,$char1,key2 $char2
	set keys [Info $oop keys]
	lappend keys $char1
	Info $oop keys $keys
}

# NSKeyboard::PointToKey --
#
#	Returns the key containing the given point, or an empty string if
#	no key overlaps the point.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc PointToKey {oop x y} {

	set canvas [Info $oop canvas]

	set itemIdList [$canvas find overlapping $x $y [incr x] [incr y]]
	if {![llength $itemIdList]} {
		return ""
	}
	set itemId [lindex $itemIdList 0]
	
	set key ""
	foreach tag [$canvas gettags $itemId] {
		switch -glob -- $tag {
			key_* {
				return [string range $tag 4 end]
			}
		}
	}

	# Error...
	return ""
}

# NSKeyboard::SelectKey --
#
#	Removes highlighting from the current selected key, adds highlighting
#	to the given key. Calls the client's command if given.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SelectKey {oop key} {

	set canvas [Info $oop canvas]
	set mode [Info $oop mode]
	
	set current [Info $oop current]
	if {$current != ""} {
		if {$key == $current} return
		$canvas itemconfigure rect_$current -width 1.0
	}
	Info $oop current $key
	
	if {$key != ""} {
	
		$canvas itemconfigure rect_$key -width 2.0
		$canvas raise key_$key
	
		if {$mode == "control"} {
			set key ^$key
		} elseif {$mode == "unmodified"} {
			set key [Info $oop key,$key,key2]
		}
	}

	set command [Info $oop command]
	if {[string length $command]} {
		uplevel #0 $command [list $key]
	}
}

# NSKeyboard::SetMode --
#
#	Redisplay the keyboard in the "unmodified", "shift"  or "control" state.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetMode {oop mode} {

	switch -- $mode {
		unmodified -
		shift -
		control {
		}
		default {
			error "unknown mode \"$mode\""
		}
	}

	SelectKey $oop ""
	Info $oop mode $mode
	Display $oop
}

# NSKeyboard::Display --
#
#	Configures the display.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Display oop {

	set canvas [Info $oop canvas]
	set mode [Info $oop mode]
	
	if {$mode == "control"} {

		foreach key [Info $oop keys] {
			set key2 [Info $oop key,$key,key2]
			set color Black
			if {[string length [angband keymap action ^$key]]} {set color Green}
			if {![string match \[A-Z\] $key]} {set color gray80}
			if {[Info $oop key,$key,show]} {
				$canvas itemconfigure text_$key -fill $color
				$canvas itemconfigure text_$key2 -fill gray80
			} else {
				$canvas itemconfigure text_$key -text $key -fill $color
			}
		}

	} elseif {$mode == "shift"} {

		foreach key [Info $oop keys] {
			set key2 [Info $oop key,$key,key2]
			set color Black
			if {[string length [angband keymap action $key]]} {set color Green}
			if {[Info $oop key,$key,show]} {
				$canvas itemconfigure text_$key -fill $color
				$canvas itemconfigure text_$key2 -fill gray80
			} else {
				$canvas itemconfigure text_$key -text $key -fill $color
			}
		}
		
	} elseif {$mode == "unmodified"} {

		foreach key [Info $oop keys] {
			set key2 [Info $oop key,$key,key2]
			set color Black
			if {[string length [angband keymap action $key2]]} {set color Green}
			if {[Info $oop key,$key,show]} {
				$canvas itemconfigure text_$key -fill gray80
				$canvas itemconfigure text_$key2 -fill $color
			} else {
				$canvas itemconfigure text_$key -text $key2 -fill $color
			}
		}
	}
	
	# Call client command
	set key [Info $oop current]
	if {$key != ""} {
		if {$mode == "control"} {
			set key ^$key
		} elseif {$mode == "unmodified"} {
			set key [Info $oop key,$key,key2]
		}
		set command [Info $oop command]
		if {[string length $command]} {
			uplevel #0 $command [list $key]
		}
	}
}

# NSKeyboard::Button1 --
#
#	Called when the canvas is clicked. If a key is hit, then select it
#	(unless in "control" mode and key isn't A-Z). If no active key is
#	hit, then deselect the current key.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Button1 {oop x y} {

	focus [Info $oop canvas]
	
	set key [PointToKey $oop $x $y]
	if {$key == ""} {
		SelectKey $oop ""
		return
	}

	# Some keys are disabled in "control" mode
	if {([Info $oop mode] == "control") && ![string match \[A-Z\] $key]} {
		SelectKey $oop ""
		return
	}

	SelectKey $oop $key
}

# NSKeyboard::Motion1 --
#
#	If the given point is over a (valid) key, then select it.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Motion1 {oop x y} {

	set key [PointToKey $oop $x $y]
	if {$key == ""} {
		return
	}

	# Some keys are disabled in "control" mode
	if {([Info $oop mode] == "control") && ![string match \[A-Z\] $key]} {
		return
	}

	SelectKey $oop $key
}

# namespace eval NSKeyboard
}
