# The tcl/tk interface to Xconq.
# Copyright (C) 1998-2000 Stanley T. Shebs.

# Xconq is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.  See the file COPYING.

# Lose the original main window, we don't have a use for it.

wm title . "Xconq Main Window"
wm withdraw .

# Asking for a specific color sometimes loses...

#set progress_bar_color black
set progress_bar_color "#010101"

set lineheight 5

#set list_icon_size 16
set list_icon_size 32

# This flag is 1 if map displays are to use double-buffering for drawing.

set dblbuffer 1

# This flag 1 if the user is doing game design.

set designer 0

set any_elev_variation 0
set any_temp_variation 0
set any_wind_variation 0
set any_clouds 0

set indepside_ai 0
set indepside_build 0
set indepside_research 0
set indepside_treasury 0

set indepside_entry 0
set firstside_entry 0

set num_avail_side_names 0

# This global is the id/number of the side using the display.

set dside 0

# This global is the remote program id used when networking.

set my_rid 0

# This is the rid of the master.

set master_rid 0

set see_all 0

set may_set_show_all 0

set handling_key 0

set curunit 0

set endofgame 0

set pathlist [ split [ xconq_library_paths ] ";" ]

# Set this to 1 to get some handy bits for debugging the tcl/tk code.

set debug 0

set vary_world_size 0

set new_width 0
set new_height 0
set new_circumference 0
set new_latitude 0
set new_longitude 0

set vary_real_time 0

set new_time_for_game 0
set new_time_per_side 0
set new_time_per_turn 0

if { $debug } {
    puts stdout "Font families are [ font families ]"
    puts stdout "Paths are $pathlist"
    # Double buffering makes it hard to see what is going on.
    set dblbuffer 0
}

set last_world_width 0
set last_world_power -1

set ai_may_resign 0

# Set a variable that controls enablement of options that only work
# in the Unix port.

if { "$tcl_platform(platform)" == "unix" } {
    set unix_feature active
} else {
    set unix_feature disabled
}

# This is the list of all the map view options that are available.

set view_option_list { \
	power \
	grid \
	coverage \
	elevations \
	lighting \
	people \
	control \
	temperature \
	winds \
	clouds \
	unit_names \
	feature_names \
	feature_boundaries \
	meridians \
	meridian_interval \
	ai \
    }

foreach opt $view_option_list {
    set prefs($opt) 0
}

# The array of displayable names for view options.

set view_option_names(power) "Power"
set view_option_names(grid) "Grid"
set view_option_names(coverage) "Coverage"
set view_option_names(elevations) "Elevations"
set view_option_names(lighting) "Day/Night"
set view_option_names(people) "People"
set view_option_names(control) "Control"
set view_option_names(temperature) "Temperature"
set view_option_names(winds) "Winds"
set view_option_names(clouds) "Clouds"
set view_option_names(unit_names) "Unit Names"
set view_option_names(feature_names) "Feature Names"
set view_option_names(feature_boundaries) "Feature Boundaries"
set view_option_names(meridians) "Meridians"
set view_option_names(meridian_interval) "Meridian Interval"
set view_option_names(ai) "AI Info"

# The array of map command options corresponding to view options.

set view_option_flags(power) -power
set view_option_flags(grid) -grid
set view_option_flags(coverage) -coverage
set view_option_flags(elevations) -elevations
set view_option_flags(lighting) -lighting
set view_option_flags(people) -people
set view_option_flags(control) -control
set view_option_flags(temperature) -temperature
set view_option_flags(winds) -winds
set view_option_flags(clouds) -clouds
set view_option_flags(unit_names) -unitnames
set view_option_flags(feature_names) -featurenames
set view_option_flags(feature_boundaries) -featureboundaries
set view_option_flags(meridians) -meridians
set view_option_flags(meridian_interval) -meridianinterval
set view_option_flags(ai) -ai

set imagery_option_list { \
	terrain_images \
	terrain_patterns \
	transitions \
    }

foreach opt $imagery_option_list {
    set prefs($opt) 0
}

set imagery_option_names(terrain_images) "Terrain Images"
set imagery_option_names(terrain_patterns) "Terrain Patterns"
set imagery_option_names(transitions) "Terrain Transitions"

# Set some defaults that should be nonzero if no preferences found.

set prefs(power) 5
set prefs(meridian_interval) 600

# (should handle case of non-availability)

set prefs(font_family) courier
set prefs(font_size) 12

set prefs(checkpoint_interval) 0

set prefs(terrain_images) 1

# The preceding code is all executed during initial_ui_init(), and
# thus goes before any customization done by the game design or user
# preferences.

# The initial splash screen.  This proc also sets up the framing and
# buttons that later screens will use.

proc popup_splash_screen {} {
    global debug

    set bigfont {-size 14 -weight bold -slant italic}

    toplevel .newgame
    wm title .newgame "Xconq Welcome"

    frame .newgame.top -width 400 -height 320
    if { $debug } {
	.newgame.top config -bg green
    }
    pack .newgame.top -side top -fill x
    # We're planning to reuse this frame, don't let its size bounce around.
    pack propagate .newgame.top false

    add_splash_screen_dialog_items

    frame .newgame.bottom 
    pack .newgame.bottom -side bottom -fill x

    button .newgame.bottom.b1 -width 9 -text "New Game" -font $bigfont \
	    -command { popup_game_dialog }
    button .newgame.bottom.b2 -width 9 -text "Open File" -font $bigfont \
	    -command { popup_open_dialog remove_splash_screen_dialog_items }
    button .newgame.bottom.connect -width 9 -text "Connect" -font $bigfont \
	    -command { popup_connect }
    pack .newgame.bottom.b1 .newgame.bottom.b2 .newgame.bottom.connect \
	    -side left -padx 4 -pady 4
    button .newgame.bottom.quit -text "Quit" \
	    -command { exit_xconq }
    pack .newgame.bottom.quit -side right -anchor se -padx 4 -pady 4
}

proc add_splash_screen_dialog_items {} {
    frame .newgame.top.frame
    pack .newgame.top.frame -side top -fill both
    canvas .newgame.top.frame.splash -width 400 -height 280
    pack .newgame.top.frame.splash -side top -anchor n
    set splashname [ find_image_filename "splash.gif" ]
    # Only try to create the image if we found the file.
    if { "$splashname" != "" } {
	image create photo splash -file $splashname -width 400 -height 280
	.newgame.top.frame.splash create image 0 0 -image splash -anchor nw
    }

    label .newgame.top.version -text "Version [ version_string ]"
    pack .newgame.top.version -side top -anchor ne
    label .newgame.top.copyright -text [ copyright_string ]
    pack .newgame.top.copyright -side top -anchor ne
}

proc remove_splash_screen_dialog_items {} {
    pack forget .newgame.top.frame
    pack forget .newgame.top.version
    pack forget .newgame.top.copyright
}

# The new game dialog.

set list_all_games 0

proc popup_game_dialog {} {
    wm title .newgame "Xconq New Game Setup"
    remove_splash_screen_dialog_items

    # For now...
    global my_rid master_rid
    if { $my_rid > 0 && $my_rid != $master_rid } {
	.newgame.bottom.b1 config -state disabled
	.newgame.bottom.b2 config -state disabled
	return
    }

    add_new_game_dialog_items
    .newgame.bottom.b1 config -text "New Game" -command { new_game }
    .newgame.bottom.b2 config \
	    -command { popup_open_dialog remove_new_game_dialog_items }
}

proc add_new_game_dialog_items {} {
    set bigfont {-size 14 -weight bold -slant italic}

    frame .newgame.top.left
    pack .newgame.top.left -side left -fill y

    frame .newgame.top.left.f
    pack .newgame.top.left.f -side top -expand true -fill both -padx 8 -pady 8

    listbox .newgame.top.left.f.games -selectmode browse -width 25 \
	    -yscrollcommand ".newgame.top.left.f.yscroll set"
    scrollbar .newgame.top.left.f.yscroll -orient vert \
	    -command ".newgame.top.left.f.games yview"
    pack .newgame.top.left.f.yscroll -side right -fill y
    pack .newgame.top.left.f.games -side left -expand true -fill y

    fill_new_game_list

    set numgames [ numgames ]

    if { $numgames == 0 } {
	.newgame.bottom.b1 config -state disabled
    }

    bind .newgame.top.left.f.games <ButtonRelease-1> { select_game }

    # The right side displays info about the selected game.

    frame .newgame.top.right
    pack .newgame.top.right -side right -fill y

    # (should have a cool gif here instead)
    label .newgame.top.right.banner -text Xconq -font $bigfont
    pack .newgame.top.right.banner -side top -fill x -padx 8 -pady 8

    canvas .newgame.top.right.preview -width 200 -height 100 \
	    -borderwidth 2 -relief sunken
    .newgame.top.right.preview create text 100 55 -tag label -anchor c
    pack .newgame.top.right.preview -side top -fill x -padx 8 -pady 8

    label .newgame.top.right.version -text "??version??"
    pack .newgame.top.right.version -side top -fill x -padx 8 -pady 8

    frame .newgame.top.right.blurb
    pack .newgame.top.right.blurb -side top -fill x -padx 8 -pady 8

    text .newgame.top.right.blurb.t -width 40 -height 6 -wrap word \
	    -yscrollcommand ".newgame.top.right.blurb.yscroll set"
    scrollbar .newgame.top.right.blurb.yscroll -orient vert \
	    -command ".newgame.top.right.blurb.t yview"
    pack .newgame.top.right.blurb.yscroll -side right -fill y
    pack .newgame.top.right.blurb.t -side left

    checkbutton .newgame.top.right.listall -text "List All Games" \
	    -variable list_all_games -command { fill_new_game_list }
    pack .newgame.top.right.listall -side top -fill x

    # Auto-pre-select the first game in the list.
    .newgame.top.left.f.games selection set 0
    select_game
}

proc fill_new_game_list {} {
    global list_all_games
    global game_title game_version game_base_name
    global game_index

    .newgame.top.left.f.games delete 0 end

    set numgames [ numgames ]

    set j 0
    for { set i 0 } { $i < $numgames } { incr i } {
	game_info $i
	if { !$list_all_games } {
	    if { ![ string match {[1-9]*} $game_version($i) ] } {
		continue
	    }
	}
	set entry "$game_base_name($i)$game_title($i)"
	.newgame.top.left.f.games insert end "$entry"
	set game_index($j) $i
	incr j
    }
}

proc remove_new_game_dialog_items {} {
    pack forget .newgame.top.left
    pack forget .newgame.top.right
}

# Adjust the right-side elements to reflect the currently-selected
# game.

# This global is used to title later startup dialogs.

set selected_game_title "?unknown?"

proc select_game {} {
    global selected_game_title
    global game_title game_version game_blurb
    global game_index

    set j [ .newgame.top.left.f.games curselection ]
    set i $game_index($j)
    .newgame.top.right.preview itemconfig label -text "(no picture available)"
    if { "$game_version($i)" == "" } {
	set version "(no version)"
    } else {
	set version "Version $game_version($i)"
    }
    .newgame.top.right.version config -text $version
    .newgame.top.right.blurb.t delete 1.0 end
    .newgame.top.right.blurb.t insert end $game_blurb($i)
    set selected_game_title $game_title($i)
}

proc new_game {} {
    global game_index

    set j [ .newgame.top.left.f.games curselection ]
    set i $game_index($j)
    start_new_game $i
    remove_new_game_dialog_items
    popup_variants_dialog
}

proc popup_open_dialog { remover } {
    set rslt [ tk_getOpenFile ]
    # Empty result cancels.
    if { "$rslt" == "" } {
	return
    }
    start_saved_game "$rslt"
    # The dialog items to remove vary depending on whether this is invoked
    # from the splash screen or new game dialog.
    $remover
    popup_variants_dialog
}

proc popup_variants_dialog {} {
    wm title .newgame "Xconq Variants Setup"
    add_variants_dialog_items
    .newgame.bottom.b1 config -text "OK" -command { set_variants }
    .newgame.bottom.b2 config -text "" -state disabled -borderwidth 0

    # For now, always go along with host's changes.
    global my_rid master_rid
    if { $my_rid > 0 && $my_rid != $master_rid } {
	.newgame.bottom.b1 config -state disabled
	.newgame.top.buttons.worldsize config -state disabled
	.newgame.top.buttons.realtime config -state disabled
    }
}

proc add_variants_dialog_items {} {
    global selected_game_title
    global varianttext variantstate
    global vary_world_size vary_real_time

    if { !"[ winfo exists .newgame.top.header ]" } {
	interpret_variants
	label .newgame.top.header -text "Variants for $selected_game_title"
    }
    pack .newgame.top.header -side top

    if { !"[ winfo exists .newgame.top.vhelp ]" } {
	frame .newgame.top.vhelp -height 50 -borderwidth 1 -relief solid
	pack propagate .newgame.top.vhelp false

	text .newgame.top.vhelp.text -borderwidth 0 -wrap word
	pack .newgame.top.vhelp.text -side top -fill both
    }
    pack .newgame.top.vhelp -side bottom -fill x -padx 10 -pady 10

    if { !"[ winfo exists .newgame.top.checks ]" } {
	frame .newgame.top.checks
	for { set row 0 } { $row < 8 } { incr row } {
	    set col1 $row
	    set col2 [ expr $row + 8 ]
	    checkbutton .newgame.top.checks.v$col1 -text $varianttext($col1) \
		    -state $variantstate($col1) -variable variantvalue($col1) \
		    -command [ list set_variant_value_cmd $col1 ]
	    checkbutton .newgame.top.checks.v$col2 -text $varianttext($col2) \
		    -state $variantstate($col2) -variable variantvalue($col2) \
		    -command [ list set_variant_value_cmd $col2 ]
	    grid .newgame.top.checks.v$col1 .newgame.top.checks.v$col2 \
		    -sticky w -padx 5 -pady 5
	}
	for { set v 0 } { $v < 16 } { incr v } {
	    if { "$variantstate($v)" == "active" } {
		bind .newgame.top.checks.v$v <Enter> \
			[ list show_variant_help $v ]
		bind .newgame.top.checks.v$v <Leave> \
			[ list clear_variant_help $v ]
	    }
	}
    }
    pack .newgame.top.checks -side left -fill y

    if { !"[ winfo exists .newgame.top.buttons ]" } {
	frame .newgame.top.buttons

	button .newgame.top.buttons.worldsize -text "World Size..." \
		-command { popup_world_size_dialog }
	pack .newgame.top.buttons.worldsize -side top -anchor c -padx 10 -pady 10
	button .newgame.top.buttons.realtime -text "Real Time..." \
		-command { popup_real_time_dialog }
	pack .newgame.top.buttons.realtime -side top -anchor c -padx 10 -pady 10
	if { !$vary_world_size } {
	    .newgame.top.buttons.worldsize config -state disabled
	}
	if { !$vary_real_time } {
	    .newgame.top.buttons.realtime config -state disabled
	}
    }
    pack .newgame.top.buttons -side right -fill y
}

proc show_variant_help { var } {
    global varianthelp

    set msg $varianthelp($var)
    .newgame.top.vhelp.text delete 1.0 end
    .newgame.top.vhelp.text insert end $msg
}

proc clear_variant_help { var } {
    .newgame.top.vhelp.text delete 1.0 end
}

proc set_variant_value_cmd { n } {
    global new_width new_height new_circumference
    global new_time_for_game new_time_per_side new_time_per_turn
    global variantstate variantvalue

    if { $n == -1 } {
	set_variant_value $n $new_width $new_height $new_circumference
    } elseif { $n == -2 } {
	set_variant_value $n $new_time_for_game $new_time_per_side \
		$new_time_per_turn
    } else {
	set_variant_value $n $variantvalue($n) 0 0
    }
}

proc remove_variants_dialog_items {} {
    pack forget .newgame.top.header
    pack forget .newgame.top.vhelp
    pack forget .newgame.top.checks
    pack forget .newgame.top.buttons
}

proc set_variants {} {
    remove_variants_dialog_items
    global my_rid master_rid
    if { $my_rid == 0 || ( $my_rid > 0 && $my_rid == $master_rid ) } {
	start_player_pre_setup_stage
	start_player_setup_stage
    }
    popup_player_dialog
}

proc popup_world_size_dialog {} {
    remove_variants_dialog_items
    add_world_size_dialog_items
    .newgame.bottom.b1 config -text "OK" \
	    -command { world_size_ok_cmd }
    .newgame.bottom.b2 config -text "Cancel" -state active -borderwidth 2 \
	    -command { world_size_cancel_cmd }
}

proc add_world_size_dialog_items {} {
    global new_width new_height new_circumference new_latitude new_longitude

    if { !"[ winfo exists .newgame.top.world ]" } {
	canvas .newgame.top.world -width 380 -height 240 -bg gray
	set wtop [ expr 120 - 60 ]
	set wbot [ expr 120 + 60 ]
	set wleft [ expr 190 - $new_circumference / 2 ]
	set wright [ expr 190 + $new_circumference / 2 ]
	.newgame.top.world create rect $wleft $wtop $wright $wbot -fill white
	.newgame.top.world create line $wleft 120 $wright 120
	set atop [ expr 120 - $new_height / 2 ]
	set abot [ expr 120 + $new_height / 2 ]
	set aleft [ expr 190 - $new_width / 2 ]
	set aright [ expr 190 + $new_width / 2 ]
	if { 1 } {
	    .newgame.top.world create rect $aleft $atop $aright $abot -fill blue
	} else {
	    # (should draw hexagon)
	}
    }
    pack .newgame.top.world -side top -padx 10 -pady 10

    if { !"[ winfo exists .newgame.top.sizes ]" } {
	frame .newgame.top.sizes
	set base .newgame.top.sizes
	label $base.lwidth -text "Area Width:"
	entry $base.fwidth -width 4
	$base.fwidth insert end $new_width
	label $base.lheight -text "x Height:"
	entry $base.fheight -width 4
	$base.fheight insert end $new_height
	label $base.lcircumf -text "Circumference:"
	entry $base.fcircumf -width 6
	$base.fcircumf insert end $new_circumference
	grid $base.lwidth $base.fwidth $base.lheight $base.fheight \
		$base.lcircumf $base.fcircumf -sticky news
# these not supported currently
#	label $base.llon -text "Longitude:"
#	entry $base.flon -width 6
#	$base.flon insert end $new_longitude
#	label $base.llat -text "Latitude:"
#	entry $base.flat -width 6
#	$base.flat insert end $new_latitude
#	grid $base.llon $base.flon $base.llat $base.flat -sticky news
    }
    pack .newgame.top.sizes -side bottom
}

proc remove_world_size_dialog_items {} {
    pack forget .newgame.top.world
    pack forget .newgame.top.sizes
}

proc world_size_ok_cmd {} {
    global new_width new_height new_circumference new_latitude new_longitude

    set base .newgame.top.sizes
    set new_width [ $base.fwidth get ]
    set new_height [ $base.fheight get ]
    set new_circumference [ $base.fcircumf get ]
#    set new_latitude [ $base.flat get ]
#    set new_longitude [ $base.flon get ]
    set_variant_value_cmd -1
    # Use the cancellation steps to finish here.
    world_size_cancel_cmd
}

proc world_size_cancel_cmd {} {
    remove_world_size_dialog_items
    popup_variants_dialog
}

proc popup_real_time_dialog {} {
    remove_variants_dialog_items
    add_real_time_dialog_items
    .newgame.bottom.b1 config -text "OK" \
	    -command { real_time_ok_cmd }
    .newgame.bottom.b2 config -text "Cancel" -state active -borderwidth 2 \
	    -command { real_time_cancel_cmd }
}

proc add_real_time_dialog_items {} {
    global new_time_for_game new_time_per_side new_time_per_turn

    if { !"[ winfo exists .newgame.top.times ]" } {
	frame .newgame.top.times
	set base .newgame.top.times
	label $base.lforgame -text "Total Time (mins:secs) "
	entry $base.fforgame_m -width 4
	label $base.lforgame2 -text " : "
	entry $base.fforgame_s -width 4
	$base.fforgame_m insert end [ expr $new_time_for_game / 60 ]
	$base.fforgame_s insert end [ expr $new_time_for_game % 60 ]
	label $base.lperside -text "Per Side (mins:secs) "
	entry $base.fperside_m -width 4
	label $base.lperside2 -text " : "
	entry $base.fperside_s -width 4
	$base.fperside_m insert end [ expr $new_time_per_side / 60 ]
	$base.fperside_s insert end [ expr $new_time_per_side % 60 ]
	label $base.lperturn -text "Per Turn (mins:secs) "
	entry $base.fperturn_m -width 4
	label $base.lperturn2 -text " : "
	entry $base.fperturn_s -width 4
	$base.fperturn_m insert end [ expr $new_time_per_turn / 60 ]
	$base.fperturn_s insert end [ expr $new_time_per_turn % 60 ]
	grid $base.lforgame $base.fforgame_m $base.lforgame2 $base.fforgame_s \
		-sticky news -pady 10
	grid $base.lperside $base.fperside_m $base.lperside2 $base.fperside_s \
		-sticky news -pady 10
	grid $base.lperturn $base.fperturn_m $base.lperturn2 $base.fperturn_s \
		-sticky news -pady 10
    }
    pack .newgame.top.times -side top -fill both -expand true
}

proc remove_real_time_dialog_items {} {
    pack forget .newgame.top.times
}

proc real_time_ok_cmd {} {
    global new_time_for_game new_time_per_side new_time_per_turn

    set base .newgame.top.times
    set new_time_for_game \
	    [ expr [ $base.fforgame_m get ] * 60 + [ $base.fforgame_s get ] ]
    set new_time_per_side \
	    [ expr [ $base.fperside_m get ] * 60 + [ $base.fperside_s get ] ]
    set new_time_per_turn \
	    [ expr [ $base.fperturn_m get ] * 60 + [ $base.fperturn_s get ] ]
    set_variant_value_cmd -2
    real_time_cancel_cmd
}

proc real_time_cancel_cmd {} {
    remove_real_time_dialog_items
    popup_variants_dialog
}

proc popup_player_dialog {} {
    wm title .newgame "Xconq Player Setup"
    add_player_dialog_items
    .newgame.bottom.b1 config -text "OK" -command { set_players }
    .newgame.bottom.b2 config -text "" -state disabled -borderwidth 0

    # For now...
    global my_rid master_rid
    if { $my_rid > 0 && $my_rid != $master_rid } {
	.newgame.bottom.b1 config -state disabled
    }
}

set selected_player -1

proc add_player_dialog_items {} {
    global num_avail_side_names
    global selected_player
    global indepside_ai indepside_entry firstside_entry

    set nums [ numsides ]
    set maxs [ maxsides ]

    canvas .newgame.top.listheadings -width 320 -height 20
    .newgame.top.listheadings create text  20 13 -text "Side" -anchor w
    .newgame.top.listheadings create text 130 13 -text "Player" -anchor w
    .newgame.top.listheadings create text 270 13 -text "Advantage" -anchor e
    pack .newgame.top.listheadings -side top -anchor nw

    set maxheight [ expr $maxs * (24 + 4 + 2 + 2) ]

    frame .newgame.top.f1
    pack .newgame.top.f1 -side left -fill y -anchor nw -expand true

    frame .newgame.top.f1.f11 -borderwidth 2 -relief sunken
    pack .newgame.top.f1.f11 -side left -fill both -expand true

    canvas .newgame.top.f1.f11.c -width 280 -height $maxheight \
	    -scrollregion [ list 0 0 280 $maxheight ] \
	    -yscrollcommand { .newgame.top.f1.yscroll set }
    pack .newgame.top.f1.f11.c -side left -fill both -expand true

    scrollbar .newgame.top.f1.yscroll -orient vert \
	    -command { .newgame.top.f1.f11.c yview }
    pack .newgame.top.f1.yscroll -side right -fill y

    frame .newgame.top.f1.f11.c.f2
    .newgame.top.f1.f11.c create window 0 0 -anchor nw \
	    -window .newgame.top.f1.f11.c.f2
	    
    # We make entries for all sides including the indepside, but we
    # choose whether to pack the indepside based on whether it is
    # active in the game or not.
    for { set i 0 } { $i <= $maxs } { incr i } {
	set sp_entry .newgame.top.f1.f11.c.f2.s$i
	canvas $sp_entry -width 270 -height 24 -borderwidth 0
	# Although indicating the current side/player by raising and
	# sinking relief seems good, it's visually confusing in practice;
	# so use a surrounding rect and make it thicker for selected side.
	$sp_entry create rect 2 2 270 24 -tag outline -outline gray
	$sp_entry create text 23 5 -tag side -anchor nw -text ""
	$sp_entry create text 130 5 -tag player -anchor nw -text ""
	$sp_entry create text 240 5 -tag advantage -anchor ne -text ""
	set bgcolor [ $sp_entry cget -background ]
	imfsample $sp_entry.emblem -width 16 -height 16 -iwidth 16 -iheight 16 -bg $bgcolor
	$sp_entry create window 5 5 -window $sp_entry.emblem -anchor nw
	if { $i <= $nums } {
	    $sp_entry itemconfig outline -width 1 -outline black
	    update_player_entry $i
	}
	if { $i > 0 } {
	    pack $sp_entry -side top -fill x -padx 1 -pady 1
	}
	if { $i == 0 } {
	    set indepside_entry $sp_entry
	}
	if { $i == 1 } {
	    set firstside_entry $sp_entry
	}
	bind $sp_entry <Button-1> "select_player $i"
    }

    frame .newgame.top.plbuttons
    pack .newgame.top.plbuttons -fill both -expand true

    button .newgame.top.plbuttons.aplus -text "A+" -state disabled \
	    -command { adjust_advantage_cmd 1 }
    button .newgame.top.plbuttons.aminus -text "A-" -state disabled \
	    -command { adjust_advantage_cmd -1 }
    grid .newgame.top.plbuttons.aplus .newgame.top.plbuttons.aminus -sticky ew -padx 2 -pady 2
    button .newgame.top.plbuttons.add -text "Add" \
	    -command { add_player_cmd } -width 8
    grid .newgame.top.plbuttons.add -columnspan 2 -sticky ew -padx 2 -pady 2
    button .newgame.top.plbuttons.remove -text "Remove" -width 8
    grid .newgame.top.plbuttons.remove -columnspan 2 -sticky ew -padx 2 -pady 2

    menubutton .newgame.top.plbuttons.sidelib -text "Side Name" \
	    -menu .newgame.top.plbuttons.sidelib.menu \
	    -borderwidth 2 -relief raised -width 8
    menu .newgame.top.plbuttons.sidelib.menu -tearoff 0
    grid .newgame.top.plbuttons.sidelib -columnspan 2 -sticky ew -padx 2 -pady 2

    button .newgame.top.plbuttons.rename -text "Random" \
	    -command { rename_side_for_player_cmd -1 } -width 8
    grid .newgame.top.plbuttons.rename -columnspan 2 -sticky ew -padx 2 -pady 2
    button .newgame.top.plbuttons.computer -text "Computer" \
	    -command { cycle_ai_cmd } -width 8
    grid .newgame.top.plbuttons.computer -columnspan 2 -sticky ew -padx 2 -pady 2
    button .newgame.top.plbuttons.exchange -text "Exchange" \
	    -command { exchange_players_cmd } -width 8
    grid .newgame.top.plbuttons.exchange -columnspan 2 -sticky ew -padx 2 -pady 2

    label .newgame.top.plbuttons.indeplabel -text "Indep Units"
    grid .newgame.top.plbuttons.indeplabel -columnspan 2 -sticky ew -padx 2 -pady 2
    button .newgame.top.plbuttons.indepside -text "Add AI" \
	    -command { set_indepside toggle } -width 6
    grid .newgame.top.plbuttons.indepside -columnspan 2 -padx 2 -pady 2
    button .newgame.top.plbuttons.indepconfig -text "Config" \
	    -command { popup_indepside_config } -width 6
    grid .newgame.top.plbuttons.indepconfig -columnspan 2 -padx 2 -pady 2

    # Add names to the side library menu, disabling already-used names.
    set numsidelib [ side_lib_size ]
    for { set i 0 } { $i < $numsidelib } { incr i } {
	set colbreak 0
	if { $i % 25 == 0 } {
	    set colbreak 1
	}
	set sstate active
	if { ![ side_lib_entry_available $i ] } {
	    set sstate disabled
	} else {
	    incr num_avail_side_names
	}
	.newgame.top.plbuttons.sidelib.menu add command \
		-label "[ side_lib_entry $i ]" -state $sstate \
		-command [ list rename_side_for_player_cmd $i ] \
		-columnbreak $colbreak
    }
    if { $num_avail_side_names == 0 } {
	.newgame.top.plbuttons.rename config -state disabled
	.newgame.top.plbuttons.sidelib config -state disabled
    }
    if { !"[ side_ingame 0 ]" } {
	.newgame.top.plbuttons.indepside config -state disabled
    }
    set_indepside initial

    select_player 1
    update_allplayer_buttons
}

proc adjust_advantage_cmd { amt } {
    global selected_player

    adjust_advantage $selected_player $amt
    # Re-select so buttons get updated.
    select_player $selected_player
    update_player_entry $selected_player
}

proc add_player_cmd {} {
    set newsel [ add_side_and_player ]
    if { $newsel < 0 } {
	return
    }
    update_player_entry $newsel
    select_player $newsel
    update_allplayer_buttons
}

proc rename_side_for_player_cmd { n } {
    global selected_player

    rename_side_for_player $selected_player $n
    update_player_entry $selected_player
}

proc cycle_ai_cmd {} {
    global selected_player

    set_ai_for_player $selected_player -cycle
    update_player_entry $selected_player
}

proc exchange_players_cmd {} {
    global selected_player

    set newsel [ exchange_players $selected_player -1 ]
    if { $newsel >= 0 } {
	update_player_entry $selected_player
	update_player_entry $newsel
	select_player $newsel
    }
}

proc select_player { newsel } {
    global num_avail_side_names
    global selected_player

    set nums [ numsides ]

    # De-highlight any previous selection.
    if { $selected_player != -1 } {
	set sp_entry .newgame.top.f1.f11.c.f2.s$selected_player
	$sp_entry itemconfig outline -width 1 -outline black
    }
    if { $newsel <= $nums } {
	set emptysel 0
	set selected_player $newsel
	set sp_entry .newgame.top.f1.f11.c.f2.s$selected_player
	$sp_entry itemconfig outline -width 4 -outline black
	set side [ assigned_side $selected_player ]
	set player [ assigned_player $selected_player ]
    } else {
	set emptysel 1
    }
    # Enable/disable advantage adjustment.
    if { !$emptysel && "[ player_advantage $player ]" < "[ max_advantage $side ]"} {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.aplus config -state $state
    if { !$emptysel && "[ player_advantage $player ]" > "[ min_advantage $side ]"} {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.aminus config -state $state
    if { !$emptysel && "[ can_rename $side ]" && $num_avail_side_names > 0 } {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.sidelib config -state $state
    .newgame.top.plbuttons.rename config -state $state
    # The other buttons are always active unless nothing selected.
    if { !$emptysel } {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.computer config -state $state
}

# Given the index of an assignment, update the side and player info at
# that index.

proc update_player_entry { i } {
    # Nothing to do if command-line setup.
    if { !"[ winfo exists .newgame ]" } {
	return
    }
    set sp_entry .newgame.top.f1.f11.c.f2.s$i
    set side [ assigned_side $i ]
    # Ersatz images don't exist yet, so skip if none found.
    set ename [ side_emblem $side ]
    if { "$ename" != "null" } {
	$sp_entry.emblem replace imf $ename
    }
    set ingame [ side_ingame $side ]
    if { $ingame } {
	set color black
    } else {
	set color gray
	$sp_entry itemconfig outline -outline gray
    }
    $sp_entry itemconfig side -text [ short_side_title $side ] -fill $color
    set player [ assigned_player $i ]
    $sp_entry itemconfig player -text [ long_player_title $player ]
    set advantage [ player_advantage $player ]
    if { $advantage > 0 } {
	$sp_entry itemconfig advantage -text $advantage
    }
    if { "[ winfo exists .newgame.top.plbuttons.sidelib.menu ]" } {
	set numsidelib [ side_lib_size ]
	for { set i 0 } { $i < $numsidelib } { incr i } {
	    set sstate active
	    if { ![ side_lib_entry_available $i ] } {
		set sstate disabled
	    }
	    .newgame.top.plbuttons.sidelib.menu entryconfig $i -state $sstate
	}
    }
}

# Set the state of buttons that affect the whole list of side/players.

proc update_allplayer_buttons {} {
    # Nothing to do if command-line setup.
    if { !"[ winfo exists .newgame ]" } {
	return
    }
    set nums [ numsides ]
    set maxs [ maxsides ]

    if { $nums < $maxs } {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.add config -state $state

    .newgame.top.plbuttons.remove config -state disabled

    # (should disable if no selection)
    if { $nums > 1 } {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.exchange config -state $state
}

# No removal needed for player dialog items, this is the last dialog
# in the sequence.

proc set_players {} {
    # Might have called during a command-line startup sequence...
    if { !"[ winfo exists .newgame ]" } {
	return
    }
    launch_game
    # Once the game is underway, we can make this dialog go away.
    wm withdraw .newgame
}

set indepside_up 0

proc set_indepside { mode } {
    global indepside_ai
    global indepside_entry firstside_entry
    global indepside_up

    # Skip all this for networked games, the host will dictate.
    global my_rid master_rid
    if { $my_rid > 0 && $my_rid != $master_rid } {
	return
    }
    # Decide whether indepside player entry should be "up" or "down".
    if { $mode == "initial" } {
	if { $indepside_ai } {
	    set indepside_up 1
	}
    } else {
	if { !$indepside_up } {
	    set indepside_up 1
	} else {
	    set indepside_up 0
	}
    }
    if { $indepside_up } {
	# Add the indepside entry, enable config button
	set_ai_for_player 0 iplayer
	update_player_entry 0
	pack $indepside_entry -before $firstside_entry \
		-side top -fill x -padx 1 -pady 1
	.newgame.top.plbuttons.indepside config -text "No AI"
	.newgame.top.plbuttons.indepconfig config -state active
    } else {
	# Take away the AI, make the entry disappear
	set_ai_for_player 0 ""
	update_player_entry 0
	pack forget $indepside_entry
	.newgame.top.plbuttons.indepside config -text "Add AI"
	.newgame.top.plbuttons.indepconfig config -state disabled
    }
}

proc popup_indepside_config {} {
    global indepside_build indepside_research indepside_treasury
    global new_indepside_build new_indepside_research new_indepside_treasury

    set new_indepside_build $indepside_build
    set new_indepside_research $indepside_research
    set new_indepside_treasury $indepside_treasury

    if { "[ winfo exists .indepside ]" } {
	wm deiconify .indepside
	return
    }

    toplevel .indepside
    wm title .indepside "Independent Units"

    label .indepside.lab0 -text "Independent unit setup"
    pack .indepside.lab0 -side top
    label .indepside.lab1 -text "Choose what independent units may do:"
    pack .indepside.lab1 -side top
    checkbutton .indepside.build -text "Build new units if possible" \
	    -variable new_indepside_build -offvalue 0 -onvalue 1
    pack .indepside.build -side top -anchor nw
    checkbutton .indepside.research -text "Research new advances (if any advances to research)" \
	    -variable new_indepside_research -offvalue 0 -onvalue 1
    pack .indepside.research -side top -anchor nw
    checkbutton .indepside.treasury -text "Add to and draw from a treasury (if sides have treasuries)" \
	    -variable new_indepside_treasury -offvalue 0 -onvalue 1
    pack .indepside.treasury -side top -anchor nw

    button .indepside.ok -text "OK" \
	    -command { ok_indepside }
    pack .indepside.ok -side right

    button .indepside.cancel -text "Cancel" \
	    -command { cancel_indepside }
    pack .indepside.cancel -side right
}

proc ok_indepside {} {
    global indepside_build indepside_research indepside_treasury
    global new_indepside_build new_indepside_research new_indepside_treasury

    set indepside_build $new_indepside_build
    set indepside_research $new_indepside_research
    set indepside_treasury $new_indepside_treasury

    set_indepside_options $indepside_build $indepside_research \
	    $indepside_treasury
    wm withdraw .indepside
}

proc cancel_indepside {} {
    wm withdraw .indepside
}

# Launch the periodically-executing procedures that will run during
# the game.

proc do_initial_setup {} {
    after 25 run_game_cmd
    after 50 animate_selection_cmd
    after 100 run_game_idle_cmd
}

# (should come from pref)
set joinhost localhost
set joinport 3075

proc popup_connect {} {
    popup_chat
}

proc join_game {} {
    global joinhost joinport

    set rslt [ try_join_game "$joinhost:$joinport" ]
    if { $rslt != 1 } {
	bell
	insert_chat_string 0 0 "failed to join game at $joinhost:$joinport\n"
    }
}

proc host_game {} {
    global joinhost joinport

    try_host_game "$joinhost:$joinport"
}

# The pregame chat window may actually last throughout a game - it
# provides an "out-of-band" communications channel for human players.

proc popup_chat {} {
    global persons
    global env
    global debug

    # No matter what setup screen we're on, as long as the chat window
    # is up, we don't need the connect button.
    if { "[ winfo exists .newgame.bottom.connect ]" } {
	.newgame.bottom.connect config -state disabled
    }

    if { "[ winfo exists .chat ]" } {
	wm deiconify .chat
	return
    }

    # Don't allow random button clicking until we're connected or closed.
    if { "[ winfo exists .newgame.button.b1 ]" } {
	.newgame.bottom.b1 config -state disabled
    }
    if { "[ winfo exists .newgame.button.b2 ]" } {
	.newgame.bottom.b2 config -state disabled
    }

    toplevel .chat
    wm title .chat "Xconq Chat"

    set bigfont {-size 14 -weight bold -slant italic}

    frame .chat.top
    pack .chat.top -side top -fill x

    label .chat.top.commtype -text "TCP/IP"
    pack .chat.top.commtype -side left

    frame .chat.top.parms
    pack .chat.top.parms -side left

    label .chat.top.parms.hostlabel -text Host:
    entry .chat.top.parms.hostentry -textvariable joinhost -relief sunken
    grid .chat.top.parms.hostlabel .chat.top.parms.hostentry -sticky news
    label .chat.top.parms.portlabel -text Port:
    entry .chat.top.parms.portentry -textvariable joinport -relief sunken
    grid .chat.top.parms.portlabel .chat.top.parms.portentry -sticky news

    frame .chat.top.buttons
    pack .chat.top.buttons -side left

    button .chat.top.buttons.host -text "Host a Game" -command { host_game }
    pack .chat.top.buttons.host -side top

    button .chat.top.buttons.join -text "Join a Game" -command { join_game }
    pack .chat.top.buttons.join -side top

    label .chat.top.status -text "Not Connected"
    pack .chat.top.status

    frame .chat.mid -width 500 -height 320
    if { $debug } {
	.chat.mid config -bg green
    }
    pack .chat.mid -side top -fill x
    pack propagate .chat.mid false

    frame .chat.mid.left -borderwidth 2 -relief sunken
    pack .chat.mid.left -side left -fill y

    listbox .chat.mid.left.persons -width 20
    pack .chat.mid.left.persons -side left -fill y -expand true

    frame .chat.mid.right -borderwidth 2 -relief sunken
    pack .chat.mid.right -side right -fill y

    text .chat.mid.right.t -width 100 -height 100 -wrap word \
	    -yscrollcommand ".chat.mid.right.yscroll set"
    scrollbar .chat.mid.right.yscroll -orient vert \
	    -command ".chat.mid.right.t yview"
    pack .chat.mid.right.yscroll -side right -fill y
    pack .chat.mid.right.t -side left -fill both -expand true

    frame .chat.bottom 
    pack .chat.bottom -side bottom -fill x

    button .chat.bottom.close -width 7 -text "Close" -font $bigfont \
	    -command { dismiss_chat }
    pack .chat.bottom.close -side left -padx 4 -pady 4

    entry .chat.bottom.input -width 50 -state disabled
    pack .chat.bottom.input -side left -padx 4 -pady 4

    # Handle the case of being popped up in midgame for the first time.
    global my_rid
    if { $my_rid > 0 } {
	enable_chat
    }
}

proc add_program { myrid rid str } {
    global persons
    global my_rid master_rid

    set my_rid $myrid

    set persons($rid,name) $str

    # -host/-join arg setup does not create chat window.
    if { !"[ winfo exists .chat ]" } {
	return
    }

    set cbuf .chat.mid.right.t

    # Once the program is accepting connections, or connected, the
    # Host/Join buttons are no longer needed for anything.
    .chat.top.buttons.host config -state disabled
    .chat.top.buttons.join config -state disabled
    # Ditto for the host and port.
    .chat.top.parms.hostentry config -state disabled
    .chat.top.parms.portentry config -state disabled
    if { $my_rid > 0 && $my_rid == $master_rid } {
	.chat.top.status config -text "Accepting Connections"
	# Revive the setup dialog buttons if they're still around.
	if { "[ winfo exists .newgame.bottom.b1 ]" } {
	    .newgame.bottom.b1 config -state active
	}
	if { "[ winfo exists .newgame.bottom.b2 ]" } {
	    .newgame.bottom.b2 config -state active
	}
    } else {
	.chat.top.status config -text "Connected"
    }
    .chat.mid.left.persons insert end "$persons($rid,name)(#$rid)"
    enable_chat
    if { $rid == 1 } {
	set joinstr "is hosting the game"
    } else {
	set joinstr "has joined the game"
    }
    insert_chat_string $myrid 0 "$persons($rid,name)(#$rid) $joinstr\n"
    # Connect button becomes a Chat button.
    if { "[ winfo exists .newgame.bottom.connect ]" } {
	.newgame.bottom.connect config -text "Chat"
    }
}

# This proc should be called when chatting becomes possible.

proc enable_chat {} {
    set cbuf .chat.bottom.input

    $cbuf config -state normal

    bind $cbuf <Return> { if {"%A" != "{}" } { send_chat_bdg ; break } }

    # This is now the main widget of interest in the window.
    focus $cbuf
}

proc send_chat_bdg {} {
    set cbuf .chat.bottom.input

    send_chat "[ $cbuf get ]\n"
    $cbuf delete 0 end
}

proc insert_chat_string { myrid rid str } {
    global persons
    global my_rid

    set cbuf .chat.mid.right.t

    if { !"[ winfo exists $cbuf ]" } {
	return
    }

    if { $rid == 0 } {
	# If the insertion is prior to the chat box's enablement, turn
	# it on temporarily.
	if { $my_rid == 0 } {
	    $cbuf config -state normal
	}
	$cbuf insert end "$str"
	if { $my_rid == 0 } {
	    $cbuf config -state disabled
	}
	return
    }

    $cbuf insert end "$persons($rid,name)(#$rid): "
    $cbuf insert end "$str"
}

proc dismiss_chat {} {
    wm withdraw .chat
    # Reactivate the Connect/Chat button so we can bring chat window back.
    if { "[ winfo exists .newgame.bottom.connect ]" } {
	.newgame.bottom.connect config -state active
    }
    # We leave the menu item active always.
}

# Create a map window, which is the main player interface to Xconq.
# The map window includes a map/view, a world map, plus info about
# individual units, lists of sides, unit types, etc.

set nummaps 0

proc create_map_window { mapn } {
    global textfont boldfont
    global lineheight
    global list_icon_size
    global nummaps map_widget map_number
    global dblbuffer
    global dside
    global prefs
    global debug

    set textfont [ list "-family" $prefs(font_family) \
	    "-size" $prefs(font_size) ]
    set boldfont [ list "-family" $prefs(font_family) \
	    "-size" $prefs(font_size) "-weight" "bold" ]
    # Asking for a font by size causes problems for some X servers.
    #set textfont fixed
    #set boldfont fixed

    set asc [ font metrics $textfont -ascent ]
    set dsc [ font metrics $textfont -descent ]
    set lineheight [ expr $asc + $dsc + 1 ]

    set nums [ numsides ]

    incr nummaps

    set map .m$mapn

    set map_widget($mapn) $map
    set map_number($map) $mapn

    toplevel $map
    wm title $map "Xconq Map $mapn"

    #    $map.menubar.windows add command -label "Map 1"
    # (should add entries for each window created)

    set_options_from_prefs $map

    # Set the main window to take up most of the screen.

    set mainwid [ winfo screenwidth . ]
    set mainhgt [ winfo screenheight . ]

    set mainwid [ expr int(0.95 * $mainwid) ]
    set mainhgt [ expr int(0.90 * $mainhgt) ]

    set geomspec ""
    set geomspec [ append geomspec $mainwid "x" $mainhgt ]

    wm geometry $map $geomspec

    create_map_menus $map

    create_left_right_panes $map 0.80

    # Set up the left side's subpanes.

    create_top_bottom_panes $map.leftside 0.10

    frame $map.leftside.topside.notices -borderwidth 0
    pack $map.leftside.topside.notices -side top -expand true -fill both

    text $map.leftside.topside.notices.t -borderwidth 1 -height 1000 -font $textfont \
	    -yscrollcommand "$map.leftside.topside.notices.yscroll set"
    whelp $map.leftside.topside.notices.t "Notices of events and other info"
    scrollbar $map.leftside.topside.notices.yscroll -orient vert \
	    -command "$map.leftside.topside.notices.t yview"
    whelp $map.leftside.topside.notices.yscroll "Notices of events and other info"
    pack $map.leftside.topside.notices.yscroll -side right -fill y
    pack $map.leftside.topside.notices.t -side left -fill both -expand true

    frame $map.leftside.botside.buttons -borderwidth 0
    pack $map.leftside.botside.buttons -side left -fill y

    fill_in_button_box $mapn $map.leftside.botside.buttons

    text $map.leftside.botside.mouseover -borderwidth 1 -height 1 \
	    -font $textfont
    whelp $map.leftside.botside.mouseover "Description of what the mouse is over"
    pack $map.leftside.botside.mouseover -side top -fill x

    frame $map.leftside.botside.uf -borderwidth 0
    pack $map.leftside.botside.uf -side top -fill x
    
    canvas $map.leftside.botside.uf.unitinfo \
	    -height [ expr 5 * $lineheight ] -width 2000 \
	    -borderwidth 1 -relief sunken
    whelp $map.leftside.botside.uf.unitinfo "Details about the current unit"
    pack $map.leftside.botside.uf.unitinfo -side left -fill y -expand true

    frame $map.leftside.botside.mapf
    pack $map.leftside.botside.mapf -side bottom -fill both

    # Ask for a frame larger than the window, so that it's guaranteed to
    # fill up its grid position.
    frame $map.leftside.botside.mapf.mapf2 -width 4000 -height 4000 -bg gray
    if { $debug } {
	$map.leftside.botside.mapf.mapf2 config -bg green
    }
    pack propagate $map.leftside.botside.mapf.mapf2 false
#    scrollbar $map.leftside.botside.mapf.xscroll -orient horiz \
#	    -command "$map.leftside.botside.mapf.mapf2.map xview"
#    scrollbar $map.leftside.botside.mapf.yscroll -orient vert \
#	    -command "$map.leftside.botside.mapf.mapf2.map yview"
#    grid $map.leftside.botside.mapf.mapf2 $map.leftside.botside.mapf.yscroll -sticky news
#    grid $map.leftside.botside.mapf.xscroll -sticky ew
    grid $map.leftside.botside.mapf.mapf2 -sticky news -padx 1 -pady 1
    grid rowconfigure $map.leftside.botside.mapf 0 -weight 1
    grid columnconfigure $map.leftside.botside.mapf 0 -weight 1

    map $map.leftside.botside.mapf.mapf2.map -power $prefs(power) \
	    -grid $prefs(grid) \
	    -coverage $prefs(coverage) \
	    -elevations $prefs(elevations) \
	    -lighting $prefs(lighting) \
	    -people $prefs(people) \
	    -control $prefs(control) \
	    -temperature $prefs(temperature) \
	    -winds $prefs(winds) \
	    -clouds $prefs(clouds) \
	    -unitnames $prefs(unit_names) \
	    -featurenames $prefs(feature_names) \
	    -featureboundaries $prefs(feature_boundaries) \
	    -meridians $prefs(meridians) \
	    -meridianinterval $prefs(meridian_interval) \
	    -ai $prefs(ai) \
	    -terrainimages $prefs(terrain_images) \
	    -terrainpatterns $prefs(terrain_patterns) \
	    -transitions $prefs(transitions) \
	    -font $boldfont \
	    -dbl $dblbuffer
    pack $map.leftside.botside.mapf.mapf2.map -expand true

    # Set up the right side's subpanes.

    set rightwid [ expr (1.0 - 0.75) * $mainwid ]

    # Create the turn/date pane.

    frame $map.rightside.turnf -borderwidth 1 -relief sunken
    pack $map.rightside.turnf -side top -fill x -expand true

    canvas $map.rightside.turnf.turn -height [ expr $lineheight + 4 ]
    whelp $map.rightside.turnf.turn "Current turn info"
    pack $map.rightside.turnf.turn -side top -fill x -expand true

    # Create the side list pane.

    frame $map.rightside.gamef -borderwidth 1 -relief sunken
    pack $map.rightside.gamef -side top -fill x -expand true

    # (should be sized later, when actual side elements filled in)

    set game_entry_height [ expr 2 * $lineheight + 20 ]
    set game_win_height [ expr $nums * $game_entry_height ]
    set numtreas [ numtreasury ]
    incr game_win_height [ expr (($numtreas + 1) / 2) * $lineheight ]
    set actualheight $game_win_height
    # Limit side list space to 40% of main window height.
    set limitheight [ expr ( $mainhgt * 40 ) / 100 ]
    if { $actualheight > $limitheight } {
	set actualheight $limitheight
    }
    canvas $map.rightside.gamef.game -height $actualheight \
	    -scrollregion [ list 0 0 $rightwid $game_win_height ] \
	    -yscrollcommand "$map.rightside.gamef.yscroll set"
    whelp $map.rightside.gamef.game "List of sides in game"
    scrollbar $map.rightside.gamef.yscroll -orient vert \
	    -command "$map.rightside.gamef.game yview"
    whelp $map.rightside.gamef.yscroll "List of sides in game"
    pack $map.rightside.gamef.yscroll -side right -fill y
    pack $map.rightside.gamef.game -side left -fill both -expand true

#    $map.rightside.gamef.game create line 1 1 10 100 -stipple ants

    # Create the world map pane.

    # A border of 1 is more consistent, but not a good idea until the
    # grip has been changed from a box to a stripe between panes.
    frame $map.rightside.worldf -borderwidth 2 -relief sunken -bg gray
    pack $map.rightside.worldf -side bottom -fill both -expand true

    set pow [ fit_map $rightwid ]
    # Limit world map space to 40% of main window height.
    set limitheight [ expr ( $mainhgt * 40 ) / 100 ]
    map $map.rightside.worldf.world -world 1 -power $pow \
	    -maxheight $limitheight -dbl $dblbuffer
    whelp $map.rightside.worldf.world "Map of the whole world"
    # The pad here looks a little strange, but it serves two purposes:
    # first, to keep the grip from "leaking" into the world map when
    # scrolling, and second, to distinguish white terrain (such as ice)
    # from the sunken border of the frame.
    pack $map.rightside.worldf.world -padx 1 -pady 1

    global last_world_width last_world_power
    set last_world_width $rightwid
    set last_world_power $pow

    # Create the unit type list pane.  This comes last packingwise,
    # since it will usually need to scroll, so it's not so important
    # to give it all the space it would like.

    frame $map.rightside.listf -borderwidth 1 -relief sunken
    pack $map.rightside.listf -side top -expand true -fill x

    set numu [ numutypes_available $dside ]
    set list_entry_height [ expr $list_icon_size + 6 ]
    set listwinheight [ expr $lineheight + $numu * $list_entry_height ]
    canvas $map.rightside.listf.unitlist -height $listwinheight \
	    -scrollregion [ list 0 0 $rightwid $listwinheight ] \
	    -yscrollcommand "$map.rightside.listf.yscroll set"
    whelp $map.rightside.listf.unitlist "List of unit types"
    scrollbar $map.rightside.listf.yscroll -orient vert \
	    -command "$map.rightside.listf.unitlist yview"
    whelp $map.rightside.listf.yscroll "List of unit types"
    pack $map.rightside.listf.yscroll -side right -fill y
    pack $map.rightside.listf.unitlist -side left -fill both -expand true

    # Preload widget with tagged text and other items.

    # Pre-tag groups of blank chars for the ranges that we will use for
    # notification and interaction.
    $map.leftside.topside.notices.t insert end " " notices
    $map.leftside.topside.notices.t insert end " " prefix
    $map.leftside.topside.notices.t insert end " " prompt
    $map.leftside.topside.notices.t insert end "  " answer
    # Make the user interaction things stand out more.
    $map.leftside.topside.notices.t tag config prefix -font $boldfont
    $map.leftside.topside.notices.t tag config prompt -font $boldfont
    $map.leftside.topside.notices.t tag config answer -font $boldfont

    set unitinfo $map.leftside.botside.uf.unitinfo
    set bgcolor [ $unitinfo cget -background ]
    imfsample $unitinfo.pic -width 32 -height 32 -bg $bgcolor
    $unitinfo create window 4 4 -window $unitinfo.pic -anchor nw
    set col1a [ expr 6 + 32 ]
    set col1b 6
    set col2 250
    set ypos [ expr 2 + $lineheight ]
    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
    $unitinfo create text $col1 $ypos -tag { handle textual }
    $unitinfo create text $col2 $ypos -tag { hp textual col2 }
    incr ypos $lineheight
    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
    $unitinfo create text $col1 $ypos -tag { loc textual }
    $unitinfo create text $col2 $ypos -tag { stack textual col2 }
    incr ypos $lineheight
    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
    $unitinfo create text $col1 $ypos -tag { occ textual }
    $unitinfo create text $col2 $ypos -tag { s0 textual col2 }
    incr ypos $lineheight
    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
    $unitinfo create text $col1 $ypos -tag { plan textual }
    $unitinfo create text $col2 $ypos -tag { s1 textual col2 }
    incr ypos $lineheight
    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
    $unitinfo create text $col1 $ypos -tag { t0 textual }
    $unitinfo create text $col2 $ypos -tag { aux0 textual col2 }
    incr ypos $lineheight

#    if { $ypos < $lineheight + 32 } { set col1 $col1a } { set col1 $col1b }
#    $unitinfo create text $col1 $ypos -tag { t1 textual }
#    $unitinfo create text $col2 $ypos -tag { aux0 textual col2 }

    # Make all the textual unit info items look the same.
    $unitinfo itemconfig textual -anchor sw -font $textfont

    set turnpane $map.rightside.turnf.turn
    $turnpane create text 4 4 -tag the_date -anchor nw -font $boldfont

    fill_in_side_list $map

    fill_in_unit_type_list $map

    make_normal_bindings $map
}

proc fill_in_button_box { mapn buttonbox } {
    button $buttonbox.move -bitmap shoot_cursor \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "survey" ]
    whelp $buttonbox.move "Switch between move and survey modes"
    pack $buttonbox.move -side top
    frame $buttonbox.divider1 -width 24 -height 8
    pack $buttonbox.divider1 -side top
    button $buttonbox.build -bitmap build \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "produce-unit" ]
    whelp $buttonbox.build "Build a type of unit"
    pack $buttonbox.build -side top
    button $buttonbox.return -bitmap return \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "return" ]
    whelp $buttonbox.return "Return for more supplies"
    pack $buttonbox.return -side top
    button $buttonbox.sleep -bitmap sleep \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "sleep" ]
    whelp $buttonbox.sleep "Sleep indefinitely"
    pack $buttonbox.sleep -side top
    button $buttonbox.reserve -bitmap sleep \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "reserve" ]
    whelp $buttonbox.reserve "Reserve unit for next turn"
    pack $buttonbox.reserve -side top
    button $buttonbox.delay -bitmap delay \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "delay" ]
    whelp $buttonbox.delay "Delay moving unit until others moved this turn"
    pack $buttonbox.delay -side top
    frame $buttonbox.divider2 -width 24 -height 8
    pack $buttonbox.divider2 -side top
    button $buttonbox.zoomin -bitmap closer \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "zoom-in" ]
    whelp $buttonbox.zoomin "Zoom in"
    pack $buttonbox.zoomin -side top
    button $buttonbox.zoomout -bitmap farther \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "zoom-out" ]
    whelp $buttonbox.zoomout "Zoom out"
    pack $buttonbox.zoomout -side top
    button $buttonbox.iso -bitmap iso \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "map iso" ]
    whelp $buttonbox.iso "Switch between isometric and overhead"
    pack $buttonbox.iso -side top
    button $buttonbox.rotl -bitmap rotl -state disabled \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "map rotl" ]
    whelp $buttonbox.rotl "Rotate view left"
    pack $buttonbox.rotl -side top
    button $buttonbox.rotr -bitmap rotr -state disabled \
	    -width 24 -height 24 \
	    -command [ list execute_long_command $mapn "map rotr" ]
    whelp $buttonbox.rotr "Rotate view right"
    pack $buttonbox.rotr -side top
}

# This proc adds all the informational elements about each side in the
# side list.

proc fill_in_side_list { map } {
    global textfont boldfont
    global lineheight
    global progress_bar_color
    global dside

    set nums [ numsides ]
    set dside [ dside ]
    set numtreas [ numtreasury ]

    set sidelist $map.rightside.gamef.game
    set game_entry_height [ expr 2 * $lineheight + 20 ]
    set bgcolor [ $sidelist cget -background ]

    set sy 0
    for { set i 1 } { $i <= $nums } { incr i } {
	set tsy [ expr $sy + $lineheight ]
	set msy [ expr $sy + floor($lineheight * .60) ]
	set rtop [ expr $sy + $lineheight + 4 ]
	set rbot [ expr $sy + $lineheight + 12 ]
	set scy [ expr $sy + (2 * $lineheight) + 15 ]
	if { $i > 1 } {
	    $sidelist create line 0 $sy 2000 $sy -fill gray
	}
	imfsample $sidelist.e$i -width 16 -height 16 -bg $bgcolor
	$sidelist.e$i add imf [ side_emblem $i ]
	$sidelist create window 4 [ expr $sy + 4 ] -window $sidelist.e$i \
		-anchor nw
	$sidelist create text 24 $tsy -tag s$i -anchor sw -font $textfont
	# (should make conditional on liveness of side)
	$sidelist create rect 23 $rtop 125 $rbot -tag frame$i
	$sidelist create rect 24 [ expr $rtop + 1 ] 24 $rbot -tag left$i \
		-fill $progress_bar_color -outline ""
	$sidelist create rect 24 [ expr $rtop + 1 ] 24 $rbot -tag resv$i \
		-fill gray -outline ""
	$sidelist create text 24 $scy -tag score0_$i -text "" -anchor sw -font $textfont
	# Start the loss line and victory laurels offscreen. 
	$sidelist create line 4000 $msy 5000 $msy -tag lost$i -fill black
	$sidelist create bitmap 4000 [ expr $sy + 22 ] -bitmap laurels -tag won$i -anchor nw
	incr sy $game_entry_height
	# Possibly add treasury materials.
	if { $numtreas > 0 && $i == $dside } {
	    # Make two columns.
	    set rows [ expr ($numtreas + 1) / 2 ]
	    set j 0
	    for { set row 0 } { $row < $rows } { incr row } {
		$sidelist create text 40 $sy -text m$i,$j -tag m$i,$j -anchor ne -font $textfont
		$sidelist create text 45 $sy -text [ mtype_name [ mtype_actual $j ] ] -anchor nw -font $textfont
		incr j
		# Only do second column if sufficient treasury materials.
		if { $j < $numtreas } {
		    $sidelist create text 120 $sy -text m$i,$j -tag m$i,$j -anchor ne -font $textfont
		    $sidelist create text 125 $sy -text [ mtype_name [ mtype_actual $j ] ] -anchor nw -font $textfont
		    incr j
		}
		incr sy $lineheight
	    }
	}
    }

    $sidelist itemconfig s$dside -font $boldfont
}

# This proc adds all the informational elements about each unit type.

proc fill_in_unit_type_list { map } {
    global textfont boldfont
    global lineheight
    global list_icon_size
    global dside

    set unitlist $map.rightside.listf.unitlist

    set bgcolor [ $unitlist cget -background ]

    $unitlist create text [ expr $list_icon_size + 16 ] $lineheight -text "Type"\
	    -anchor se -font $textfont
    $unitlist create text [ expr $list_icon_size + 44 ] $lineheight -text "Num" \
	    -anchor s -font $textfont

    set sy 16
    set list_entry_height [ expr $list_icon_size + 4 ]
    set numu [ numutypes_available $dside ]
    for { set i 0 } { $i < $numu } { incr i } {
	# Compute the y position of text items.
	set tsy [ expr $sy + $list_icon_size / 2 + $lineheight / 2 ]
	imfsample $unitlist.u$i -width $list_icon_size -height $list_icon_size \
		-bg $bgcolor
#	whelp $unitlist.u$i "name$i"
	$unitlist.u$i add imf [ u_image_name [ utype_actual $i ] ]
	# Add the side emblem as a second image, but don't display it
	# as an image; instead declare as the "emblem".
	$unitlist.u$i add imf [ side_emblem $dside ]
	$unitlist.u$i emblem 1
	$unitlist create window 4 $sy -window $unitlist.u$i -anchor nw
	$unitlist create text [ expr $list_icon_size + 16 ] $tsy -tag u$i \
		-anchor s -font $textfont
	$unitlist create text [ expr $list_icon_size + 44 ] $tsy -tag n$i \
		-anchor se -font $textfont
	$unitlist create text [ expr $list_icon_size + 44 ] $tsy -tag i$i \
		-anchor sw -font $textfont
	$unitlist create text [ expr $list_icon_size + 80 ] $tsy -tag name$i \
		-anchor sw -font $textfont
	set rtop [ expr $sy - 1 ]
	set rbot [ expr $sy + $list_icon_size + 1 ]
	$unitlist create rect 3 $rtop [ expr $list_icon_size + 5 ] $rbot \
		-tag rect$i -outline $bgcolor
	incr sy $list_entry_height
    }
}

# The following collection of flags govern what is enabled and disabled
# in the menus and other controls.  They have to be set/reset each time
# a different unit becomes the current one.

set can_act 0
set can_plan 0
set can_move 0
set can_return 0
set can_build 0
set can_repair 0
set can_attack 0
set can_fire 0
set can_detonate 0
set can_give_take 0
set can_embark 0
set can_disembark 0
set can_detach 0
set can_disband 0
set can_add_terrain 0
set can_remove_terrain 0

set can_see_people 0
set can_see_control 0
set can_see_elev 0
set can_see_lighting 0
set can_see_temp 0
set can_see_winds 0
set can_see_clouds 0

set map_survey 0

if { $unix_feature == "disabled" } {
    set default_map_options(grid) 0
}

proc set_options_from_prefs { map } {
    global view_option_list
    global prefs
    global default_map_options

    foreach opt $view_option_list {
	set default_map_options($opt) $prefs($opt)
    }
}

# Create the complete menu bar for a given map window.

proc create_map_menus { map } {
    global view_option_names
    global default_map_options
    global unix_feature
    global map_number

    set mapn $map_number($map)

    set nums [ numsides ]

    menu $map.menubar
    $map config -menu $map.menubar

    $map.menubar add cascade -label "File" -menu $map.menubar.file
    menu $map.menubar.file -postcommand [ list adjust_file_menu $map ]
    $map.menubar.file add command -label "New Game..." -state disabled
    $map.menubar.file add command -label "Open Game..." -state disabled
    $map.menubar.file add command -label "Connect" -state disabled \
	    -command { popup_connect }
    $map.menubar.file add command -label "Chat" -state disabled \
	    -command { popup_chat }
    $map.menubar.file add separator
    $map.menubar.file add command -label "Help" -accelerator "?" \
	    -command { popup_help_dialog }
    $map.menubar.file add separator
    $map.menubar.file add command -label "Close" -state disabled
    $map.menubar.file add command -label "Save Game" -accelerator "S" \
	    -command [ list execute_long_command $mapn "save 0" ]
    $map.menubar.file add command -label "Save Game As" \
	    -command [ list execute_long_command $mapn "save 1" ]
    $map.menubar.file add separator
    $map.menubar.file add command -label "Preferences..." \
	    -command { popup_preferences_dialog }
    $map.menubar.file add separator
    $map.menubar.file add command -label "Print..." -state disabled
    $map.menubar.file add separator
    $map.menubar.file add command -label Resign \
	    -command [ list execute_long_command $mapn "resign" ]
    $map.menubar.file add command -label Quit -accelerator "Q" \
	    -command [ list execute_long_command $mapn "quit" ]

    $map.menubar add cascade -label "Edit" -menu $map.menubar.edit
    menu $map.menubar.edit -postcommand [ list adjust_edit_menu $map ]
    $map.menubar.edit add command -label "Can't Undo" -state disabled
    $map.menubar.edit add separator
    $map.menubar.edit add command -label "Cut" -state disabled
    $map.menubar.edit add command -label "Copy" -state disabled
    $map.menubar.edit add command -label "Paste" -state disabled
    $map.menubar.edit add command -label "Clear" -state disabled
    $map.menubar.edit add separator
    $map.menubar.edit add command -label "Select All" -state disabled
    $map.menubar.edit add separator
    $map.menubar.edit add check -label "Design" \
	    -command [ list execute_long_command $mapn "design" ] \
	    -variable designer -offvalue 0 -onvalue 1

    $map.menubar add cascade -label "Find" -menu $map.menubar.find
    menu $map.menubar.find -postcommand [ list adjust_find_menu $map ]
    $map.menubar.find add command -label "Previous" -state disabled
    $map.menubar.find add command -label "Next" -state disabled
    $map.menubar.find add command -label "Next Occupant" -accelerator "i" \
	    -command [ list execute_long_command $mapn "in" ]
    $map.menubar.find add separator
    $map.menubar.find add command -label "Location..." -state disabled
    $map.menubar.find add command -label "Unit by Name..." \
	    -command [ list popup_find_dialog $mapn ]
    $map.menubar.find add command -label "Distance" -accelerator "\#" \
	    -command [ list execute_long_command $mapn "distance" ]
    $map.menubar.find add separator
    $map.menubar.find add command -label "Current Unit" -accelerator "." \
	    -command [ list execute_long_command $mapn "recenter" ]

    $map.menubar add cascade -label "Play" -menu $map.menubar.play
    menu $map.menubar.play -postcommand [ list adjust_play_menu $map ]
    $map.menubar.play add command -label "Closeup" -state disabled
    $map.menubar.play add command -label "City Dialog" -state disabled
    $map.menubar.play add command -label "Move To" \
	    -command [ list execute_long_command $mapn "move-to" ]
    $map.menubar.play add command -label "Return" -accelerator "r" \
	    -command [ list execute_long_command $mapn "return" ]
    $map.menubar.play add command -label "Set Formation" \
	    -command [ list execute_long_command $mapn "formation" ]
    $map.menubar.play add separator
    $map.menubar.play add command -label "Wake" -accelerator "w" \
	    -command [ list execute_long_command $mapn "wake" ]
    $map.menubar.play add command -label "Wake All" -accelerator "W" \
	    -command [ list execute_long_command $mapn "wakeall" ]
    $map.menubar.play add command -label "Sleep" -accelerator "s" \
	    -command [ list execute_long_command $mapn "sleep" ]
    $map.menubar.play add command -label "Reserve" \
	    -command [ list execute_long_command $mapn "reserve" ]
    $map.menubar.play add command -label "Idle" -accelerator "I" \
	    -command [ list execute_long_command $mapn "idle" ]
    $map.menubar.play add command -label "Delay" -accelerator "d" \
	    -command [ list execute_long_command $mapn "delay" ]
    $map.menubar.play add separator
    $map.menubar.play add command -label "Build" -accelerator "P" \
	    -command [ list execute_long_command $mapn "produce-unit" ]
    $map.menubar.play add command -label "Repair" \
	    -command [ list execute_long_command $mapn "repair" ]
    $map.menubar.play add separator
    $map.menubar.play add command -label "Attack" -accelerator "a" \
	    -command [ list execute_long_command $mapn "attack" ]
    $map.menubar.play add command -label "Overrun" \
	    -command [ list execute_long_command $mapn "attack" ]
    $map.menubar.play add command -label "Fire" \
	    -command [ list execute_long_command $mapn "fire" ]
    $map.menubar.play add command -label "Fire Into" \
	    -command [ list execute_long_command $mapn "fire-into" ]
    $map.menubar.play add command -label "Detonate" -accelerator "\!" \
	    -command [ list execute_long_command $mapn "detonate" ]

    $map.menubar add cascade -label "More" -menu $map.menubar.more
    menu $map.menubar.more -postcommand [ list adjust_more_menu $map ]
    $map.menubar.more add command -label "Give" -accelerator "g" \
	    -command [ list execute_long_command $mapn "give" ]
    $map.menubar.more add command -label "Take" -accelerator "t" \
	    -command [ list execute_long_command $mapn "take" ]
    $map.menubar.more add command -label "Collect" \
	    -command [ list execute_long_command $mapn "collect" ]
    $map.menubar.more add separator
    $map.menubar.more add command -label "Embark" -accelerator "e" \
	    -command [ list execute_long_command $mapn "embark" ]
    $map.menubar.more add command -label "Disembark" \
	    -command [ list execute_long_command $mapn "disembark" ]
    $map.menubar.more add separator
    $map.menubar.more add command -label "Detach" \
	    -command [ list execute_long_command $mapn "detach" ]
    $map.menubar.more add command -label "Disband" -accelerator "D" \
	    -command [ list execute_long_command $mapn "disband" ]
    $map.menubar.more add separator
    $map.menubar.more add command -label "Add Terrain" -accelerator "A" \
	    -command [ list execute_long_command $mapn "add-terrain" ]
    $map.menubar.more add command -label "Remove Terrain" -accelerator "R" \
	    -command [ list execute_long_command $mapn "remove-terrain" ]
    $map.menubar.more add separator
    $map.menubar.more add cascade -label "Plan Type" \
	    -menu $map.menubar.more.plantype
    menu $map.menubar.more.plantype
    $map.menubar.more.plantype add command -label "None" \
	    -command [ list execute_long_command $mapn "map plan-none" ]
    $map.menubar.more.plantype add command -label "Passive" \
	    -command [ list execute_long_command $mapn "map plan-passive" ]
    $map.menubar.more.plantype add command -label "Defensive" \
	    -command [ list execute_long_command $mapn "map plan-defensive" ]
    $map.menubar.more.plantype add command -label "Exploratory" \
	    -command [ list execute_long_command $mapn "map plan-exploratory" ]
    $map.menubar.more.plantype add command -label "Offensive" \
	    -command [ list execute_long_command $mapn "map plan-offensive" ]
    $map.menubar.more.plantype add command -label "Random" \
	    -command [ list execute_long_command $mapn "map plan-random" ]
    $map.menubar.more add command -label "AI Control" \
	    -command [ list execute_long_command $mapn "auto" ]
    $map.menubar.more add separator
    $map.menubar.more add command -label "Rename..." \
	    -command [ list execute_long_command $mapn "name" ]
    $map.menubar.more add cascade -label "Give Unit" \
	    -menu $map.menubar.more.giveunit
    menu $map.menubar.more.giveunit
    for { set i 0 } { $i <= $nums } { incr i } {
	$map.menubar.more.giveunit add command -label [ side_adjective $i ] \
		-command [ list execute_long_command 0 "$i give-unit" ]
    }

    $map.menubar add cascade -label "Side" -menu $map.menubar.side
    menu $map.menubar.side -postcommand [ list adjust_side_menu $map ]
    $map.menubar.side add command -label "Closeup" -state disabled
    $map.menubar.side add command -label "End This Turn" \
	    -command [ list execute_long_command $mapn "end-turn" ]
    $map.menubar.side add separator
    $map.menubar.side add radio -label "Move Mode" -accelerator "z" \
	    -command [ list execute_long_command $mapn "survey" ] \
	    -variable map_survey -value 0
    $map.menubar.side add radio -label "Survey Mode" -accelerator "z" \
	    -command [ list execute_long_command $mapn "survey" ] \
	    -variable map_survey -value 1
    $map.menubar.side add separator
    $map.menubar.side add cascade -label "AI" \
	    -menu $map.menubar.side.ai
    menu $map.menubar.side.ai
    $map.menubar.side.ai add radio -label "None" \
	    -command [ list execute_long_command $mapn "ai none" ] \
	    -variable side_ai -value none
    $map.menubar.side.ai add radio -label "Mplayer" \
	    -command [ list execute_long_command $mapn "ai mplayer" ] \
	    -variable side_ai -value mplayer
    $map.menubar.side.ai add radio -label "Iplayer" \
	    -command [ list execute_long_command $mapn "ai iplayer" ] \
	    -variable side_ai -value iplayer
    $map.menubar.side add check -label "AI May Resign" \
	    -state active \
	    -command { toggle_ai_may_resign } \
	    -variable ai_may_resign -offvalue 0 -onvalue 1
    $map.menubar.side add separator
    $map.menubar.side add command -label "Doctrines" -state disabled
    $map.menubar.side add separator
    $map.menubar.side add command -label "Message" -accelerator "M" \
	    -command [ list execute_long_command $mapn "message" ]
    $map.menubar.side add command -label "Agreements" \
	    -command { create_agreements_window }

    $map.menubar add cascade -label "Windows" -menu $map.menubar.windows
    menu $map.menubar.windows -postcommand [ list adjust_windows_menu $map ]
    $map.menubar.windows add command -label "Scores" \
	    -command { popup_scores }
    $map.menubar.windows add separator
    $map.menubar.windows add command -label "New Map" \
	    -command [ list execute_long_command $mapn "new-map" ]
    $map.menubar.windows add separator

    $map.menubar add cascade -label "View" -menu $map.menubar.view
    menu $map.menubar.view
    $map.menubar.view add command -label "Recenter" -accelerator "." \
	    -command [ list execute_long_command $mapn "recenter" ]
    $map.menubar.view add command -label "Closer" -accelerator "\}" \
	    -command [ list execute_long_command $mapn "zoom-in" ]
    $map.menubar.view add command -label "Farther" -accelerator "\{" \
	    -command [ list execute_long_command $mapn "zoom-out" ]
    $map.menubar.view add separator
    $map.menubar.view add check -label $view_option_names(grid) \
	    -state $unix_feature \
	    -command [ list set_map_view_option $map grid ] \
	    -variable default_map_options(grid) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(coverage) \
	    -command [ list set_map_view_option $map coverage ] \
	    -variable default_map_options(coverage) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(elevations) \
	    -command [ list set_map_view_option $map elevations ] \
	    -variable default_map_options(elevations) -offvalue 0 -onvalue 1
    $map.menubar.view add command -label "Contour Interval" \
	    -command [ list popup_contour_interval_dialog $map ]
    $map.menubar.view add check -label $view_option_names(lighting) \
	    -command [ list set_map_view_option $map lighting ] \
	    -variable default_map_options(lighting) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(people) \
	    -command [ list set_map_view_option $map people ] \
	    -variable default_map_options(people) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(control) \
	    -command [ list set_map_view_option $map control ] \
	    -variable default_map_options(control) -offvalue 0 -onvalue 1
    $map.menubar.view add cascade -label "Weather" \
	    -menu $map.menubar.view.weather
    menu $map.menubar.view.weather
    $map.menubar.view.weather add check -label $view_option_names(temperature) \
	    -command [ list set_map_view_option $map temperature ] \
	    -variable default_map_options(temperature) -offvalue 0 -onvalue 1
    $map.menubar.view.weather add check -label $view_option_names(winds) \
	    -command [ list set_map_view_option $map winds ] \
	    -variable default_map_options(winds) -offvalue 0 -onvalue 1
    $map.menubar.view.weather add check -label $view_option_names(clouds) \
	    -command [ list set_map_view_option $map clouds ] \
	    -variable map_clouds -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(unit_names) \
	    -command [ list set_map_view_option $map unit_names ] \
	    -variable default_map_options(unit_names) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(feature_names) \
	    -command [ list set_map_view_option $map feature_names ] \
	    -variable default_map_options(feature_names) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(feature_boundaries) \
	    -command [ list set_map_view_option $map feature_boundaries ] \
	    -variable default_map_options(feature_boundaries) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(meridians) \
	    -command [ list set_map_view_option $map meridians ] \
	    -variable default_map_options(meridians) -offvalue 0 -onvalue 1
    $map.menubar.view add cascade -label $view_option_names(meridian_interval) \
	    -menu $map.menubar.view.mi
    menu $map.menubar.view.mi
    $map.menubar.view.mi add radio -label "15 min" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 15
    $map.menubar.view.mi add radio -label "30 min" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 30
    $map.menubar.view.mi add radio -label "1 deg" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 60
    $map.menubar.view.mi add radio -label "2 deg" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 120
    $map.menubar.view.mi add radio -label "5 deg" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 300
    $map.menubar.view.mi add radio -label "10 deg" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable default_map_options(meridian_interval) -value 600
    $map.menubar.view.mi add radio -label "Other..." \
	    -command { popup_meridian_interval_dialog } \
	    -variable default_map_options(meridian_interval) -value 1
    $map.menubar.view add check -label $view_option_names(ai) \
	    -command [ list set_map_view_option $map ai ] \
	    -variable default_map_options(ai) -offvalue 0 -onvalue 1

    global may_set_show_all
    global show_all_was_enabled

    set show_all_was_enabled($map) 0

    if { $may_set_show_all } {
	add_show_all_item $map
    }

    adjust_view_menu $map
}

proc add_show_all_item { map } {
    global show_all_was_enabled
    global map_number

    $map.menubar.view add check -label "Show All" \
	    -command [ list execute_long_command $map_number($map) "map show-all" ] \
	    -variable map_options($map,show_all) -offvalue 0 -onvalue 1
    set show_all_was_enabled($map) 1
}

proc set_map_view_option { map opt } {
    global view_option_flags
    global default_map_options

    $map.leftside.botside.mapf.mapf2.map config $view_option_flags($opt) $default_map_options($opt)
}

proc adjust_file_menu { map } {
    global my_rid
    global endofgame
    global designer

    adjust_menu_entry $map file "Connect" [ expr ($my_rid == 0) && !$endofgame ]
    adjust_menu_entry $map file "Chat" [ expr ($my_rid > 0) && !$endofgame ]
    adjust_menu_entry $map file "Save Game" [ expr !$endofgame ]
    adjust_menu_entry $map file "Save Game As" [ expr !$endofgame ]
    adjust_menu_entry $map file "Resign" [ expr !$endofgame && !$designer ]
}

proc adjust_edit_menu { map } {
    global endofgame

    adjust_menu_entry $map edit "Design" [ expr !$endofgame ]
}

# Enable/disable things on the find menu.

proc adjust_find_menu { map } {
    global curunit
    global can_act can_plan can_move can_return can_embark can_disembark
    global can_build can_repair can_disband can_add_terrain can_remove_terrain
    global can_give_take can_detach
    global can_attack can_fire can_detonate

    # (should disable if no next occ)
    adjust_menu_entry $map find "Next Occupant" [ expr $curunit ]
    adjust_menu_entry $map find "Distance" [ expr $curunit ]
    adjust_menu_entry $map find "Current Unit" [ expr $curunit ]
}

# Enable/disable things on the play menu.

proc adjust_play_menu { map } {
    global curunit
    global can_act can_plan can_move can_return can_embark can_disembark
    global can_build can_repair can_disband can_add_terrain can_remove_terrain
    global can_give_take can_detach
    global can_attack can_fire can_detonate

    adjust_menu_entry $map play "Move To" [ expr $curunit && $can_move ]
    adjust_menu_entry $map play "Return" [ expr $curunit && $can_return ]
    adjust_menu_entry $map play "Set Formation" [ expr $curunit && $can_move ]
    adjust_menu_entry $map play "Wake" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Wake All" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Sleep" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Reserve" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Idle" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Delay" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map play "Build" [ expr $curunit && $can_build ]
    adjust_menu_entry $map play "Repair" [ expr $curunit && $can_repair ]
    adjust_menu_entry $map play "Attack" [ expr $curunit && $can_attack ]
    adjust_menu_entry $map play "Overrun" [ expr $curunit && $can_move && $can_attack ]
    adjust_menu_entry $map play "Fire" [ expr $curunit && $can_fire ]
    adjust_menu_entry $map play "Fire Into" [ expr $curunit && $can_fire ]
    adjust_menu_entry $map play "Detonate" [ expr $curunit && $can_detonate ]
}

# Enable/disable things on the more menu.

proc adjust_more_menu { map } {
    global curunit
    global can_act can_plan can_move can_return can_embark can_disembark
    global can_build can_repair can_disband can_add_terrain can_remove_terrain
    global can_give_take can_detach
    global can_attack can_fire can_detonate
    global endofgame

    adjust_menu_entry $map more "Give" [ expr $curunit && $can_give_take ]
    adjust_menu_entry $map more "Take" [ expr $curunit && $can_give_take ]
    adjust_menu_entry $map more "Collect" [ expr $curunit && $can_move && $can_give_take ]
    adjust_menu_entry $map more "Embark" [ expr $curunit && $can_embark ]
    adjust_menu_entry $map more "Disembark" [ expr $curunit && $can_disembark ]
    adjust_menu_entry $map more "Detach" [ expr $curunit && $can_detach ]
    adjust_menu_entry $map more "Disband" [ expr $curunit && $can_disband ]
    adjust_menu_entry $map more "Add Terrain" [ expr $curunit && $can_add_terrain ]
    adjust_menu_entry $map more "Remove Terrain" [ expr $curunit && $can_remove_terrain ]
    adjust_menu_entry $map more "Plan Type" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map more "AI Control" [ expr $curunit && $can_plan ]
    adjust_menu_entry $map more "Rename..." [ expr !$endofgame ]
    adjust_menu_entry $map more "Give Unit" [ expr !$endofgame ]
}

# Enable/disable things on the side menu.

proc adjust_side_menu { map } {
    global endofgame

    adjust_menu_entry $map side "End This Turn" [ expr !$endofgame ]
    adjust_menu_entry $map side "Move Mode" [ expr !$endofgame ]
    adjust_menu_entry $map side "Survey Mode" [ expr !$endofgame ]
    adjust_menu_entry $map side "AI" [ expr !$endofgame ]
}

# Enable/disable things on the windows menu.

proc adjust_windows_menu { map } {
    global endofgame

    # Alternatively, we could force newly-created maps to come up
    # in survey mode, but it seems unlikely that players would
    # ever have much use for creating new maps after the game is over.
    adjust_menu_entry $map windows "New Map" [ expr !$endofgame ]
}

# Enable/disable things on the view menu.

proc adjust_view_menu { map } {
    global see_all
    global can_see_people can_see_control can_see_elev can_see_lighting
    global can_see_temp can_see_winds can_see_clouds
    global view_option_names
    global designer

    adjust_menu_entry $map view $view_option_names(coverage) [ expr !$see_all ]
    adjust_menu_entry $map view $view_option_names(people) $can_see_people
    adjust_menu_entry $map view $view_option_names(control) $can_see_control
    adjust_menu_entry $map view $view_option_names(elevations) $can_see_elev
    adjust_menu_entry $map view "Contour Interval" $can_see_elev
    adjust_menu_entry $map view $view_option_names(lighting) $can_see_lighting
    set weather [ expr $can_see_temp | $can_see_winds | $can_see_clouds ]
    adjust_menu_entry $map view "Weather" $weather
    if { $weather } {
	adjust_menu_entry $map view.weather $view_option_names(temperature) \
		$can_see_temp
	adjust_menu_entry $map view.weather $view_option_names(winds) \
		$can_see_winds
	adjust_menu_entry $map view.weather $view_option_names(clouds) \
		$can_see_clouds
    }
    set feats [ expr ([ numfeatures ] > 0) || $designer ]
    adjust_menu_entry $map view $view_option_names(feature_names) $feats
    adjust_menu_entry $map view $view_option_names(feature_boundaries) $feats
}

# Enable/disable a single specified menu entry.

proc adjust_menu_entry { map menu entryname val } {
    set state disabled
    if { $val } {
	set state active
    }
    $map.menubar.$menu entryconfig $entryname -state $state
}

proc toggle_ai_may_resign {} {
    global ai_may_resign

    if { $ai_may_resign } {
	execute_long_command 0 "ai +"
    } else {
	execute_long_command 0 "ai -"
    }
}

# A popup to set the elevation contour interval directly.

set contour_interval 0
set contour_interval_map foo

proc popup_contour_interval_dialog { map } {
    global contour_interval_map

    set contour_interval_map $map

    if { "[ winfo exists .contour ]" } {
	wm deiconify .contour
	return
    }

    toplevel .contour
    wm title .contour "Xconq Contour Interval"

    entry .contour.interval -textvariable contour_interval
    pack .contour.interval -side top
    button .contour.ok -text "OK" \
	    -command { ok_contour_interval }
    pack .contour.ok -side right
    button .contour.cancel -text "Cancel" \
	    -command { wm withdraw .contour }
    pack .contour.cancel -side right
}

proc ok_contour_interval {} {
    global contour_interval
    global contour_interval_map map_number

    execute_long_command $map_number($contour_interval_map) \
	    "map contour-interval=$contour_interval"

    wm withdraw .contour
}

set new_meridian_interval 0

proc popup_meridian_interval_dialog {} {
    global new_meridian_interval
    global default_map_options

    set new_meridian_interval $default_map_options(meridian_interval)

    if { "[ winfo exists .meridian ]" } {
	wm deiconify .meridian
	return
    }

    toplevel .meridian
    wm title .meridian "Xconq Meridian Interval"

    label .meridian.label -text "Spacing in arc minutes:"
    pack .meridian.label -side top
    entry .meridian.interval -textvariable new_meridian_interval
    pack .meridian.interval -side top
    button .meridian.ok -text "OK" \
	    -command { ok_meridian_interval }
    pack .meridian.ok -side right
    button .meridian.cancel -text "Cancel" \
	    -command { wm withdraw .meridian }
    pack .meridian.cancel -side right
}

proc ok_meridian_interval {} {
    global new_meridian_interval
    global default_map_options

    set default_map_options(meridian_interval) $new_meridian_interval
    set_map_view_option .m1 meridian_interval

    wm withdraw .meridian
}

# Given a map window, set up all of its standard event bindings.

proc make_normal_bindings { map } {
    global dside

    bind $map <Key> \
	    { if {"%A" != "{}" } { handle_key_binding "%A" %W %X %Y } }

    set mapview $map.leftside.botside.mapf.mapf2.map

    bind $mapview <ButtonPress> { mouse_down_cmd %W %x %y %b }
    bind $mapview <ButtonRelease> { mouse_up_cmd %W %x %y %b }
    bind $mapview <Motion> { mouse_over_cmd %W %x %y }
    bind $mapview <Leave> { mouse_over_cmd %W -1 -1 }

    bind $map <Enter> { update_widget_help "%W" }

    set numu [ numutypes_available $dside ]
    set unitlist $map.rightside.listf.unitlist
    for { set i 0 } { $i < $numu } { incr i } {
	bind $unitlist.u$i <ButtonPress> [ list select_unit_type $map $i ]
    }

    set worldview $map.rightside.worldf.world

    bind $worldview <ButtonPress> { world_mouse_down_cmd %W %x %y %b }
    bind $worldview <ButtonRelease> { world_mouse_up_cmd %W %x %y %b }
    bind $worldview <Motion> { world_mouse_over_cmd %W %x %y }
    bind $worldview <Leave> { world_mouse_over_cmd %W -1 -1 }

    bind $map.rightside.worldf <Configure> { resize_world_map %W %v %w %h }

    bind $map.leftside.botside.uf.unitinfo <Configure> \
	    { resize_unit_info %W %v %w %h }
}

# Handle a keystroke by passing it into C code along the current mouse
# position, and update the numeric prefix argument if the key was a
# digit adding to the prefix.

# The map_number($win) existence test is to handle the unusual but
# reproducible case of a non-toplevel window getting passed in here
# (according to the supposed event binding stack rules).  Rather than
# trying to figure out what's going on, just dig out the toplevel and
# go with it, since that's all we really care about.

proc handle_key_binding { str win x y } {
    global handling_key
    global map_number

    if { [ info exists map_number($win) ] } {
	set mwin $win
    } else {
	set mwin [ winfo toplevel $win ]
	if { ! [ info exists map_number($mwin) ] } {
	    low_notify "key binding screwup in $win, ignoring key"
	    return
	}
    }
    set handling_key 1
    set prefix [ interp_key $map_number($mwin) "$str" $x $y ]
    $mwin.leftside.topside.notices.t delete prefix.first "prefix.last -1 chars"
    if { "$prefix" >= 0 } {
	$mwin.leftside.topside.notices.t insert prefix.first ":" prefix
	$mwin.leftside.topside.notices.t insert prefix.first $prefix prefix
    }
    set handling_key 0
}

proc run_game_cmd {} {
    set interval [ run_game 1 ]
#    after $interval run_game_cmd
    after 1 run_game_cmd
}

proc animate_selection_cmd {} {
    animate_selection
    after 100 animate_selection_cmd
}

proc run_game_idle_cmd {} {
    run_game_idle
#    after 100 run_game_idle_cmd
    after 2 run_game_idle_cmd
}

# Map zoom command.

proc zoom_in_out { mapn incr } {
    global map_widget

    set map $map_widget($mapn)
    set maxpower 6

    set power [ $map.leftside.botside.mapf.mapf2.map cget -power ]
    set newpower [ expr $power + $incr ]
    if { $newpower < 0 } {
	set newpower 0
    }
    if { $newpower > $maxpower } {
	set newpower $maxpower
    }
    if { $newpower != $power } {
	$map.leftside.botside.mapf.mapf2.map config -power $newpower
	# Update the states of various controls.
	if { $newpower < $maxpower } {
	    set newstate normal
	} else {
	    set newstate disabled
	}
	$map.menubar.view entryconfigure "Closer" -state $newstate
	$map.leftside.botside.buttons.zoomin config -state $newstate
	if { $newpower > 0 } {
	    set newstate normal
	} else {
	    set newstate disabled
	}
	$map.menubar.view entryconfigure "Farther" -state $newstate
	$map.leftside.botside.buttons.zoomout config -state $newstate
    }
}

# Turn isometric display on and off.

proc set_isometric { mapn flag scale } {
    global map_widget

    set map $map_widget($mapn)
    $map.leftside.botside.mapf.mapf2.map config -isometric $flag \
	    -verticalscale $scale
    if { $flag } {
	set newstate normal
    } else {
	set newstate disabled
    }
    $map.leftside.botside.buttons.rotl config -state $newstate
    $map.leftside.botside.buttons.rotr config -state $newstate
}

# Set the direction of viewing for an isometric display.

proc set_iso_dir { mapn dir } {
    global map_widget

    set map $map_widget($mapn)
    $map.leftside.botside.mapf.mapf2.map config -direction $dir
}

# Update routines called from C code.

proc update_game_state { str } {
    global debug
    global nummaps map_widget

    if { $debug } {
	set str "$str (Debug)"
    }
    for { set i 1 } { $i <= $nummaps } { incr i } {
	$map_widget($i).rightside.turnf.turn itemconfig the_date -text $str
    }
}

# (should optimize by remembering states and changing canvas items
# only once)

proc update_game_side_info { s str everingame ingame status } {
    global nummaps map_widget

    # puts stdout "ugsi $s $str $everingame $ingame $status"
    for { set i 1 } { $i <= $nummaps } { incr i } {
	set sidelist $map_widget($i).rightside.gamef.game
	$sidelist itemconfig s$s -text $str
	if { !$everingame } {
	    $sidelist itemconfig s$s -fill gray
	    set bgcolor [ $sidelist cget -background ]
	    $sidelist itemconfig left$s -fill $bgcolor
	    $sidelist itemconfig resv$s -fill $bgcolor
	    $sidelist itemconfig frame$s -outline $bgcolor
	} elseif { !$ingame } {
	    $sidelist itemconfig frame$s -outline gray
	    set bgcolor [ $sidelist cget -background ]
	    $sidelist itemconfig left$s -fill $bgcolor
	    $sidelist itemconfig resv$s -fill $bgcolor
	}
	if { $status > 0 } {
	    # Find the the victory laurels and move into visibility.
	    set lis [ $sidelist coords won$s ]
	    set xval [ lindex $lis 0 ]
	    if { $xval > 4 } {
		$sidelist move won$s [expr 4 - $xval ] 0
		$sidelist raise won$s
	    }
	}
	if { $status < 0 } {
	    # Find the the loss line and move into visibility.
	    set lis [ $sidelist coords lost$s ]
	    set xval [ lindex $lis 0 ]
	    if { $xval > 0 } {
		$sidelist move lost$s [expr 0 - $xval ] 0
		$sidelist raise lost$s
	    }
	}
    }
}

proc update_game_side_score { which str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set game $map_widget($i).rightside.gamef.game
	$game itemconfig $which -text $str
    }
}

# (should optimize by remembering states and changing canvas items
# only once)

proc update_side_progress { s acting left resv finished } {
    global lineheight
    global nummaps map_widget

    # puts stdout "progress $s $acting $left $resv $finished"
    for { set i 1 } { $i <= $nummaps } { incr i } {
	set game $map_widget($i).rightside.gamef.game
	set old [ $game coords left$s ]
	set rtop [ lindex $old 1 ]
	set rbot [ lindex $old 3 ]
	if { $acting } {
	    $game itemconfig frame$s -outline black
	    $game coords left$s 24 $rtop [ expr 24 + $left ] $rbot
	    $game coords resv$s 24 $rtop [ expr 24 + $resv ] $rbot
	    if { !$finished } {
		$game itemconfig left$s -fill black
	    } else {
		$game itemconfig left$s -fill gray
	    }
	} else {
	    $game itemconfig frame$s -outline gray
	    $game coords left$s 24 $rtop 24 $rbot
	    $game coords resv$s 24 $rtop 24 $rbot
	}
    }
}

proc update_side_treasury { s j amt } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set game $map_widget($i).rightside.gamef.game
	$game itemconfig m$s,$j -text $amt
    }
}

proc update_unitlist_char { n str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set unitlist $map_widget($i).rightside.listf.unitlist
	$unitlist itemconfig u$n -text $str
    }
}

proc update_unitlist_count { n str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set unitlist $map_widget($i).rightside.listf.unitlist
	$unitlist itemconfig n$n -text $str
    }
}

proc update_unitlist_incomplete { n str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set unitlist $map_widget($i).rightside.listf.unitlist
	$unitlist itemconfig i$n -text $str
    }
}

proc update_unitlist_name { n str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set unitlist $map_widget($i).rightside.listf.unitlist
	$unitlist itemconfig name$n -text $str
    }
}

proc update_unit_info { mapn tag str } {
    global curunit
    global map_widget

    if { "$tag" == "curunit" } {
	set curunit $str
    } else {
	$map_widget($mapn).leftside.botside.uf.unitinfo itemconfig $tag -text $str
    }
}

# Make sure the unit picture in the unit info window is showing the
# given image and emblem, switching if necessary.

set last_image "(no)"
set last_emblem "(no)"

proc update_unit_picture { mapn image emblem } {
    global map_widget
    global last_image last_emblem

    if { "$image" != "$last_image" } {
	set imsamp $map_widget($mapn).leftside.botside.uf.unitinfo.pic
	if { "$image" != "(no)" } {
	    $imsamp replace imf $image
	    if { "$emblem" != "$last_emblem" } {
		if { "$emblem" != "(no)" } {
		    $imsamp replace emblem $emblem
		    $imsamp emblem 1
		} else {
		    $imsamp remove emblem $last_emblem
		    $imsamp emblem -1
		}
	    }
	    set last_emblem $emblem
	} else {
	    $imsamp remove all
	    set last_emblem "(no)"
	}
	set last_image $image
    } elseif { "$emblem" != "$last_emblem" } {
	set imsamp $map_widget($mapn).leftside.botside.uf.unitinfo.pic
	if { "$emblem" != "(no)" } {
	    $imsamp replace emblem $emblem
	    $imsamp emblem 1
	} else {
	    $imsamp remove emblem $last_emblem
	    $imsamp emblem -1
	}
	set last_emblem $emblem
    }
}

# Update the appearance of any mode controls/displays.

proc update_mode { mapn mode } {
    global map_survey
    global map_widget

    if { "$mode" == "survey" } {
	set map_survey 1
	set relief raised
    } elseif { "$mode" == "move" } {
	set map_survey 0
	set relief sunken
    } else {
	# This will induce a distinctive tcl error shortly.
	set relief badmode
    }
    $map_widget($mapn).leftside.botside.buttons.move config -relief $relief
    update idletasks
}

proc whelp { widg str } {
    global widget_help_strings

    set widget_help_strings($widg) $str
}

# Given a widget, put any helpful info about it in the mouseover display.

proc update_widget_help { widg } {
    global widget_help_strings
    global nummaps

    if { [ info exists widget_help_strings($widg) ] } {
	set str $widget_help_strings($widg)
    } else {
	set str ""
    }
    # a hack, should extract map from widget
    if { $nummaps == 1 } {
	update_mouseover 1 $str
    }
}

# Replace the current mouseover text with the given version.
# Time-critical, called from C and tcl code.
# (should try to replace text string in one op if possible)

proc update_mouseover { mapn str } {
    global map_widget

    $map_widget($mapn).leftside.botside.mouseover delete 1.0 end
    $map_widget($mapn).leftside.botside.mouseover insert insert "$str"
}

# Scroll the main or world map by the given amount.

proc autoscroll { mapn which xdelta ydelta } {
    global map_widget

    if { $which == 0 } {
	set widget $map_widget($mapn).leftside.botside.mapf.mapf2.map
    } else {
	set widget $map_widget($mapn).rightside.worldf.world
    }
    if { $xdelta != 0 } {
	$widget xview scroll $xdelta units
	update idletasks
    } elseif { $ydelta != 0 } {
	$widget yview scroll $ydelta units
	update idletasks
    }
}

proc update_action_controls_info { a1 a2 a3 a4 a5 flags } {
    global can_act can_plan can_move can_return can_embark can_disembark
    global can_build can_repair can_disband can_add_terrain can_remove_terrain
    global can_give_take can_detach
    global can_attack can_fire can_detonate
    global curunit
    global nummaps map_widget

    set can_act $a1
    set can_plan $a2
    set can_move $a3
    set can_build $a4
    set can_attack $a5
    set can_return 0
    set can_repair 0
    set can_fire 0
    set can_detonate 0
    set can_embark 0
    set can_disembark 0
    set can_disband 0
    set can_detach 0
    set can_add_terrain 0
    set can_remove_terrain 0
    set can_give_take 0

    foreach flag $flags {
	set $flag 1
    }
    for { set i 1 } { $i <= $nummaps } { incr i } {
	set buttons $map_widget($i).leftside.botside.buttons
	set state normal
	if { !$curunit || !$can_build } {
	    set state disabled
	}
	$buttons.build config -state $state
	set state normal
	if { !$curunit || !$can_return } {
	    set state disabled
	}
	$buttons.return config -state $state
	set state normal
	if { !$curunit || !$can_plan } {
	    set state disabled
	}
	$buttons.sleep config -state $state
	$buttons.reserve config -state $state
	$buttons.delay config -state $state
    }
}

proc update_view_controls_info { a1 a3 a4 a5 a6 a7 a8 a9 } {
    global see_all
    global can_see_people can_see_control can_see_elev can_see_lighting
    global can_see_temp can_see_winds can_see_clouds
    global nummaps map_widget

    set see_all $a1
    set can_see_people $a3
    set can_see_control $a4
    set can_see_elev $a5
    set can_see_lighting $a6
    set can_see_temp $a7
    set can_see_winds $a8
    set can_see_clouds $a9
    for { set i 1 } { $i <= $nummaps } { incr i } {
	set map $map_widget($i)
	adjust_view_menu $map
    }
}

proc update_show_all_info { a1 } {
    global see_all
    global may_set_show_all
    global show_all_was_enabled
    global nummaps map_widget

    if { $see_all } {
	return
    }
    set may_set_show_all $a1
    # Make "Show All" menu item appear and disappear.
    if { $may_set_show_all } {
	for { set i 1 } { $i <= $nummaps } { incr i } {
	    set map $map_widget($i)
	    if { !$show_all_was_enabled($map) } {
		add_show_all_item $map
	    }
	}
    } else {
	for { set i 1 } { $i <= $nummaps } { incr i } {
	    set map $map_widget($i)
	    if { $show_all_was_enabled($map) } {
		$map.menubar.view delete "Show All"
		set show_all_was_enabled($map) 0
	    }
	}
    }
}

proc update_show_all { mapn value } {
    global see_all
    global map_widget
    global map_options

    if { $see_all } {
	return
    }
    set map $map_widget($mapn)
    set map_options($map,show_all) $value
}

proc low_notify { str } {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	set notices $map_widget($i).leftside.topside.notices.t
	$notices insert notices.last $str notices
	# (should only do if already scrolled to end of notices)
	$notices yview moveto 1.0
    }
}

proc ask_bool_mode { mapn str dflt } { 
    global handling_key
    global map_widget

    if { $handling_key } {
	if { $dflt } {
	    set dfltstr "yn"
	} else {
	    set dfltstr "ny"
	}
	set notices $map_widget($mapn).leftside.topside.notices.t
	$notices insert prompt.first "$str \[$dfltstr\]" prompt
	# (should only do if already scrolled to end of notices)
	$notices yview moveto 1.0
    } else {
	set map $map_widget($mapn)
	toplevel .bool
	wm title .bool "Xconq Query"
	set x [ winfo rootx $map ]
	incr x 200
	set y [ winfo rooty $map ]
	incr y 200
	wm geometry .bool "+$x+$y"
	message .bool.msg -text "$str" -aspect 1000
	frame .bool.buttons
	pack .bool.msg .bool.buttons -side top -fill x -padx 10 -pady 10
	button .bool.buttons.yes -text Yes -command [ list bool_yes $mapn ]
	button .bool.buttons.no -text No -command [ list bool_no $mapn ]
	grid .bool.buttons.yes .bool.buttons.no -pad 5
	# (should use dflt arg here)
	update idletasks
    }
}

proc bool_yes { mapn } {
    interp_key $mapn "y" 0 0
}

proc bool_no { mapn } {
    interp_key $mapn "n" 0 0
}

proc ask_bool_done { mapn } {
    global handling_key

    if { $handling_key } {
	clear_command_line $mapn
    } else {
	wm withdraw .bool
	destroy .bool
    }
}

proc ask_position_mode { mapn str } {
    global map_widget

    $map_widget($mapn).leftside.topside.notices.t insert prompt.first "$str" prompt
    $map_widget($mapn).leftside.botside.mapf.mapf2.map config -cursor cross
    # (should only do if already scrolled to end of notices)
    $map_widget($mapn).leftside.topside.notices.t yview moveto 1.0
}

proc ask_position_done { mapn } {
    global map_widget

    clear_command_line $mapn
    # (should be restoring prev cursor) */
    $map_widget($mapn).leftside.botside.mapf.mapf2.map config -cursor top_left_arrow
}

proc ask_unit_type_mode { mapn str } {
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices insert prompt.first "$str" prompt
    # (should only do if already scrolled to end of notices)
    $notices yview moveto 1.0
}

proc enable_unitlist { mapn n flag } {
    global map_widget

    set map $map_widget($mapn)
    if { $flag == 1 } {
	set color black
    } else {
	set color [ $map.rightside.gamef.game cget -background ]
    }
    $map.rightside.listf.unitlist itemconfig rect$n -outline $color
}

proc select_unit_type { map n } {
    global map_number

    set color [ $map.rightside.listf.unitlist itemcget rect$n -outline ]
    if { "$color" == "black" } {
	set_unit_type $map_number($map) [ utype_actual $n ]
	# Arguments are dummies, this is effectively a pseudo-event
	# that gets the modalhandler function to run.
	interp_key $map_number($map) a 0 0
    }
}

proc ask_unit_type_done { mapn } {
    clear_command_line $mapn
}

proc ask_terrain_type_mode { mapn str } { 
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices insert prompt.first "$str" prompt
    # (should only do if already scrolled to end of notices)
    $notices yview moveto 1.0
}

proc ask_terrain_type_done { mapn } {
    clear_command_line $mapn
}

# Put a given string and default into the map's prompt and answer tags
# in its notices window.

proc ask_string_mode { mapn str dflt } { 
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices insert prompt.first "$str" prompt
    $notices insert "answer.first + 1 chars" "$dflt" answer
    # (should only do if already scrolled to end of notices)
    $notices yview moveto 1.0
}

# Replace the answer tag with a new string.

proc update_string_mode { mapn answer } {
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices delete "answer.first + 1 chars" "answer.last - 1 chars"
    $notices insert "answer.first + 1 chars" $answer answer
}

proc ask_string_done { mapn } {
    clear_command_line $mapn
}

# Side asking mode is similar to string asking mode.

proc ask_side_mode { mapn str dflt } { 
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices insert prompt.first "$str" prompt
    $notices insert "answer.first + 1 chars" "$dflt" answer
    # (should only do if already scrolled to end of notices)
    $notices yview moveto 1.0
}

proc update_side_mode { mapn answer } {
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t 
    $notices delete "answer.first + 1 chars" "answer.last - 1 chars"
    $notices insert "answer.first + 1 chars" $answer answer
}

proc ask_side_done { mapn } {
    clear_command_line $mapn
}

proc clear_command_line { mapn } {
    global map_widget

    set notices $map_widget($mapn).leftside.topside.notices.t
    $notices delete prompt.first "prompt.last - 1 chars"
    $notices delete "answer.first + 1 chars" "answer.last - 1 chars"
}

set new_find_name ""
set mapn_find_name 0

proc popup_find_dialog { mapn } {
    global mapn_find_name

    set mapn_find_name $mapn

    if { "[ winfo exists .find ]" } {
	wm deiconify .find
	return
    }

    toplevel .find
    wm title .find "Xconq Find"

    label .find.label -text "Name of unit to find:"
    pack .find.label -side top
    entry .find.name -textvariable new_find_name
    pack .find.name -side top
    label .find.matches -text ""
    pack .find.matches -side top

    button .find.find -text "Find" -command ok_find
    pack .find.find -side right
    button .find.close -text "Close" -command { wm withdraw .find }
    pack .find.close -side right
}

proc ok_find {} {
    global new_find_name
    global mapn_find_name

    set rslt [ center_on_unit $mapn_find_name "$new_find_name" ]
    if { $rslt == 1 } {
	.find.matches config -text "$rslt match found"
    } else {
	.find.matches config -text "$rslt matches found"
    }
    if { $rslt == 0 } {
	bell
    }
}

# The research dialog lets the player select a new type of advance
# to research.

proc popup_research_dialog {} {

    if { "[ winfo exists .research ]" } {
	wm deiconify .research
	fill_research_dialog
	return
    }

    toplevel .research
    wm title .research "Xconq Research"

    listbox .research.topics -selectmode browse -width 25
    pack .research.topics -side top

    button .research.ok -text "Research" -command ok_research
    pack .research.ok -side top
    button .research.rest -text "Rest" -command rest_research
    pack .research.rest -side top

    fill_research_dialog
}

proc fill_research_dialog {} {
    .research.topics delete 0 end
    for { set i 0 } { $i < 127 } { incr i } {
	set aname [ available_advance $i ]
	if { "$aname" != "?" } {
	    .research.topics insert end $aname
	} else {
	    break
	}
    }
    .research.topics selection set 0
}

proc ok_research {} {
    set i [ .research.topics curselection ]
    set_side_research $i
    wm withdraw .research
}

proc rest_research {} {
    set_side_research nothing
    wm withdraw .research
}

# Create and popup an agreement editing window.

proc create_agreements_window {} {
    toplevel .agreements
    wm title .agreements "Xconq Agreements"

#    puts stdout "[agreements]"

    frame .agreements.top
    pack .agreements.top -side top -fill x

    scrolled_listbox .agreements.top.toc -selectmode browse
    pack .agreements.top.toc -side left -fill both -expand true

    bind .agreements.top.toc.list <ButtonRelease-1> { select_agreement }

    frame .agreements.top.titlef
    pack .agreements.top.titlef -side top -fill x

    label .agreements.top.titlef.tlabel -text "Title:"
    pack .agreements.top.titlef.tlabel -side left -anchor nw
    entry .agreements.top.titlef.title
    pack .agreements.top.titlef.title -side left -anchor nw

    frame .agreements.top.statef
    pack .agreements.top.statef -side top -fill x

    label .agreements.top.statef.slabel -text "State:"
    pack .agreements.top.statef.slabel -side left -anchor nw
    label .agreements.top.statef.state -text "()"
    pack .agreements.top.statef.state -side left -anchor nw

    label .agreements.top.termslabel -text "Terms:"
    pack .agreements.top.termslabel -side top -anchor nw

    frame .agreements.top.termsf
    pack .agreements.top.termsf -side top

    text .agreements.top.termsf.terms -width 40 -height 20
    pack .agreements.top.termsf.terms -side top

    .agreements.top.termsf.terms delete 1.0 end
    .agreements.top.termsf.terms insert insert "(terms)"

    label .agreements.top.sideslabel -text "Sides:"
    pack .agreements.top.sideslabel -side top -anchor nw

    frame .agreements.top.sidesf -height 100
    pack .agreements.top.sidesf -side top -fill both

    canvas .agreements.top.sidesf.sides -width 300 -height 100 \
	    -borderwidth 2 -relief sunken
    pack .agreements.top.sidesf.sides -side top -fill both

    # Add listboxes for drafters, proposers, signers, announcees
    # Add text boxes for terms and comments
    # Add popup to choose specific types of terms
    
    frame .agreements.bot
    pack .agreements.bot -side bottom -fill both -expand true

    button .agreements.bot.new -text "New" \
	    -command { new_agreement }
    pack .agreements.bot.new -side left
    button .agreements.bot.addside -text "Add Side" -state disabled
    pack .agreements.bot.addside -side left
    button .agreements.bot.circulate -text "Circulate" -state disabled
    pack .agreements.bot.circulate -side left
    button .agreements.bot.propose -text "Propose" -state disabled
    pack .agreements.bot.propose -side left
    button .agreements.bot.sign -text "Sign" -state disabled
    pack .agreements.bot.sign -side left
    button .agreements.bot.withdraw -text "Withdraw" -state disabled
    pack .agreements.bot.withdraw -side left
    button .agreements.bot.done -text "Done" \
	    -command { close_agreements_window }
    pack .agreements.bot.done -side left
}

proc new_agreement {} {
    execute_long_command 0 "agreement-draft"
    update_agreement_display
}

proc close_agreements_window {} {
    wm withdraw .agreements
}

proc update_agreement_display {} {
    .agreements.top.toc.list delete 0 end
    set aglist [ agreements ]
    foreach agid $aglist {
	.agreements.top.toc.list insert end $agid
    }
    # (should add info about selected agreement)
}

proc select_agreement {} {
    set i [ .agreements.top.toc.list curselection ]
    set agid [ .agreements.top.toc.list get $i ]
}

proc popup_scores {} {

    if { "[ winfo exists .scores ]" } {
	wm deiconify .scores
	# Refresh the scores list each time.
	.scores.main.text delete 1.0 end
	.scores.main.text insert end [ get_scores ]
	return
    }

    toplevel .scores
    wm title .scores "Xconq Scores"

    scrolled_textbox .scores.main
    pack .scores.main -side top -fill both -expand true

    .scores.main.text insert end [ get_scores ]

    button .scores.close -text "Close" -command { dismiss_scores }
    pack .scores.close
}

proc dismiss_scores {} {
    wm withdraw .scores
}

# Create and popup the preferences dialog.

proc popup_preferences_dialog {} {
    global view_option_list
    global textfont
    global last_prefs_topic

    if { "[ winfo exists .prefs ]" } {
	wm deiconify .prefs
	init_newprefs
	return
    }

    toplevel .prefs
    wm title .prefs "Xconq Preferences"

    frame .prefs.main
    pack .prefs.main -side top -fill both -expand true

    scrolled_listbox .prefs.main.topics -selectmode browse -font $textfont
    pack .prefs.main.topics -side left -fill both -expand true

    .prefs.main.topics.list insert end "Map View"
    .prefs.main.topics.list insert end "Fonts"
    .prefs.main.topics.list insert end "Files"
    .prefs.main.topics.list insert end "Imagery"

    frame .prefs.main.v -width 400 -height 300
    pack .prefs.main.v -side left
    pack propagate .prefs.main.v false

    add_map_prefs_items
    set last_prefs_topic "Map View"

    bind .prefs.main.topics.list <ButtonRelease-1> { select_prefs_topic }

    frame .prefs.bot
    pack .prefs.bot -side bottom -fill both -expand true

    button .prefs.bot.ok -text OK \
	    -command { ok_preferences }
    button .prefs.bot.cancel -text Cancel \
	    -command { dismiss_preferences_dialog }
    pack .prefs.bot.ok .prefs.bot.cancel -side right

    init_newprefs
}

proc init_newprefs {} {
    global view_option_list
    global imagery_option_list
    global prefs newprefs

    foreach opt $view_option_list {
	set newprefs($opt) $prefs($opt)
    }
    set_power_pref $newprefs(power)
    set_font_family_newpref $prefs(font_family)
    set_font_size_newpref $prefs(font_size)
    foreach opt $imagery_option_list {
	set newprefs($opt) $prefs($opt)
    }
    set newprefs(checkpoint_interval) $prefs(checkpoint_interval)
}

proc add_map_prefs_items {} {
    global view_option_list view_option_names

    set mapvf .prefs.main.v.map
    if { !"[ winfo exists $mapvf ]" } {
	frame $mapvf

	menubutton $mapvf.power -text $view_option_names(power) \
		-borderwidth 2 -relief raised \
		-menu $mapvf.power.menu
	pack $mapvf.power -side top -anchor nw
	menu $mapvf.power.menu -tearoff 0
	for { set i 0 } { $i <= 6 } { incr i } {
	    $mapvf.power.menu add command -label "$i" \
		    -command [ list set_power_pref $i ]
	}
	frame $mapvf.checks
	pack $mapvf.checks -side top
	set cnt 0
	foreach opt $view_option_list {
	    if { "$opt" == "power" } continue
	    if { "$opt" == "meridian_interval" } continue
	    set opts($cnt) $opt
	    incr cnt
	}
	for { set i 0 } { $i < $cnt } { incr i 2 } {
	    set opt1 $opts($i)
	    set j [ expr $i + 1 ]
	    if { $j < $cnt } {
		set even 1
	    } else {
		set even 0
	    }
	    checkbutton $mapvf.checks.$opt1 \
		    -text $view_option_names($opt1) \
		    -variable newprefs($opt1)
	    if { $even } {
		set opt2 $opts($j)
		checkbutton $mapvf.checks.$opt2 \
			-text $view_option_names($opt2) \
			-variable newprefs($opt2)
		grid $mapvf.checks.$opt1 $mapvf.checks.$opt2 -sticky w
	    } else {
		grid $mapvf.checks.$opt1
	    }
	}
    }
    pack $mapvf
}

proc remove_map_prefs_items {} {
    pack forget .prefs.main.v.map
}

proc add_fonts_prefs_items {} {
    global prefs

    if { !"[ winfo exists .prefs.main.v.fonts ]" } {
	frame .prefs.main.v.fonts

	label .prefs.main.v.fonts.label -borderwidth 0 -text "Font Size:"
	pack .prefs.main.v.fonts.label -side top -anchor nw
	menubutton .prefs.main.v.fonts.family -text "$prefs(font_family)" \
		-borderwidth 2 -relief raised \
		-menu .prefs.main.v.fonts.family.menu
	pack .prefs.main.v.fonts.family -side top
	menu .prefs.main.v.fonts.family.menu -tearoff 0
	foreach family [font families] {
	    .prefs.main.v.fonts.family.menu add command -label "$family" \
		    -command [ list set_font_family_newpref $family ]
	}
	menubutton .prefs.main.v.fonts.size -text "$prefs(font_size)" \
		-borderwidth 2 -relief raised \
		-menu .prefs.main.v.fonts.size.menu
	pack .prefs.main.v.fonts.size -side top
	menu .prefs.main.v.fonts.size.menu -tearoff 0
	foreach size { 9 10 12 14 18 24 36 } {
	    .prefs.main.v.fonts.size.menu add command -label "$size" \
		    -command [ list set_font_size_newpref $size ]
	}
	# The size of the text widget will change as the font sizes;
	# so keep it inside a fixed-size box.
	frame .prefs.main.v.fonts.sampf -width 200 -height 100
	pack .prefs.main.v.fonts.sampf -side top
	pack propagate .prefs.main.v.fonts.sampf false

	set tmpfont [ list "-family" $prefs(font_family) "-size" $prefs(font_size) ]
	text .prefs.main.v.fonts.sampf.sample -font $tmpfont
	pack .prefs.main.v.fonts.sampf.sample -side top
	.prefs.main.v.fonts.sampf.sample insert end "Your triumph is complete."
    }
    pack .prefs.main.v.fonts
}

proc remove_fonts_prefs_items {} {
    pack forget .prefs.main.v.fonts
}

set want_checkpoints 0
set cp_interval 0

proc add_files_prefs_items {} {
    global prefs

    set filesf .prefs.main.v.files
    if { !"[ winfo exists $filesf ]" } {
	frame $filesf

	checkbutton $filesf.checkpoint -text "Checkpoint Game" \
		-variable want_checkpoints \
		-command { toggle_checkpoints }
	pack $filesf.checkpoint -side top -fill x -anchor w

	frame $filesf.cpf
	pack $filesf.cpf -side top -fill x -anchor w

	label $filesf.cpf.lab1 -text "Every"
	entry $filesf.cpf.interval -width 8 \
		-textvariable newprefs(checkpoint_interval)
	label $filesf.cpf.lab2 -text "Turns"
	pack $filesf.cpf.lab1 $filesf.cpf.interval $filesf.cpf.lab2 -side left
    }
    pack $filesf
}

proc toggle_checkpoints {} {
    global want_checkpoints

    if { $want_checkpoints } {
	set state normal
    } else {
	set state disabled
    }
    .prefs.main.v.files.cpf.interval config -state $state
}

proc remove_files_prefs_items {} {
    pack forget .prefs.main.v.files
}

proc add_imagery_prefs_items {} {
    global prefs
    global imagery_option_names

    set imageryf .prefs.main.v.imagery
    if { !"[ winfo exists $imageryf ]" } {
	frame $imageryf

	checkbutton $imageryf.terrain_images \
		-text $imagery_option_names(terrain_images) \
		-variable newprefs(terrain_images)
	pack $imageryf.terrain_images -side top
	checkbutton $imageryf.terrain_patterns \
		-text $imagery_option_names(terrain_patterns) \
		-variable newprefs(terrain_patterns)
	pack $imageryf.terrain_patterns -side top
	checkbutton $imageryf.transitions \
		-text $imagery_option_names(transitions) \
		-variable newprefs(transitions)
	pack $imageryf.transitions -side top
    }
    pack $imageryf
}

proc remove_imagery_prefs_items {} {
    pack forget .prefs.main.v.imagery
}

proc set_power_pref { val } {
    global newprefs

    set newprefs(power) $val
    .prefs.main.v.map.power config -text "Power $newprefs(power)"
}

proc set_font_family_newpref { val } {
    global newprefs

    set newprefs(font_family) $val
    if { "[ winfo exists .prefs.main.v.fonts ]" } {
	.prefs.main.v.fonts.family config -text "$newprefs(font_family)"
	set tmpfont [ list "-family" $newprefs(font_family) \
		"-size" $newprefs(font_size) ]
	.prefs.main.v.fonts.sampf.sample config -font $tmpfont
    }
}

proc set_font_size_newpref { val } {
    global newprefs

    set newprefs(font_size) $val
    if { "[ winfo exists .prefs.main.v.fonts ]" } {
	.prefs.main.v.fonts.size config -text "$newprefs(font_size)"
	set tmpfont [ list "-family" $newprefs(font_family) \
		"-size" $newprefs(font_size) ]
	.prefs.main.v.fonts.sampf.sample config -font $tmpfont
    }
}

proc set_pref_value { pref val } {
    global prefs
    global textfont boldfont

#    puts stdout "Setting prefs($pref) = $val"
    set prefs($pref) $val
}

proc select_prefs_topic {} {
    global last_prefs_topic

    set i [ .prefs.main.topics.list curselection ]
    set str [ .prefs.main.topics.list get $i ]
#    puts stdout "want $str prefs"
    if { $str == $last_prefs_topic } {
	return
    }
    if { $last_prefs_topic == "Map View" } {
	remove_map_prefs_items
    } elseif { $last_prefs_topic == "Fonts" } {
	remove_fonts_prefs_items
    } elseif { $last_prefs_topic == "Files" } {
	remove_files_prefs_items
    } elseif { $last_prefs_topic == "Imagery" } {
	remove_imagery_prefs_items
    }
    if { $str == "Map View" } {
	add_map_prefs_items
    } elseif { $str == "Fonts" } {
	add_fonts_prefs_items
    } elseif { $str == "Files" } {
	add_files_prefs_items
    } elseif { $str == "Imagery" } {
	add_imagery_prefs_items
    }
    set last_prefs_topic $str
}

# Accept the new preference settings, copying them into the prefs array
# and saving into a file.

proc ok_preferences {} {
    global view_option_list
    global view_option_flags
    global imagery_option_list
    global prefs newprefs
    global default_map_options
    global nummaps map_widget

    # Set the view option preferences.
    foreach opt $view_option_list {
	set_pref_value $opt $newprefs($opt)
	set default_map_options($opt) $prefs($opt)
	for { set i 1 } { $i <= $nummaps } { incr i } {
	    set_map_view_option $map_widget($i) $opt
	}
    }
    # Set the font preferences.
    set_pref_value font_family $newprefs(font_family)
    set_pref_value font_size $newprefs(font_size)
    set textfont [ list "-family" $prefs(font_family) \
	    "-size" $prefs(font_size) ]
    set boldfont [ list "-family" $prefs(font_family) \
	    "-size" $prefs(font_size) "-weight" "bold" ]
    # Update existing windows that use text.
    for { set i 1 } { $i <= $nummaps } { incr i } {
	set map $map_widget($i)
	$map.leftside.topside.notices.t config -font $textfont
	$map.leftside.botside.mouseover config -font $textfont
	$map.leftside.botside.uf.unitinfo itemconfig textual -font $textfont
	$map.leftside.botside.mapf.mapf2.map config -font $textfont
    }
    # (should add rest)
    # Set the files preferences.
    set_pref_value checkpoint_interval $newprefs(checkpoint_interval)
    # Set the imagery preferences.
    foreach opt $imagery_option_list {
	set_pref_value $opt $newprefs($opt)
	for { set i 1 } { $i <= $nummaps } { incr i } {
	    set mapv $map_widget($i).leftside.botside.mapf.mapf2.map
	    $mapv config -terrainimages $prefs(terrain_images)
	    $mapv config -terrainpatterns $prefs(terrain_patterns)
	    $mapv config -transitions $prefs(transitions)
	}
    }
    
    save_preferences
    dismiss_preferences_dialog
}

# Make the dialog go away, without altering any preferences.

proc dismiss_preferences_dialog {} {
    wm withdraw .prefs
}

# Create and popup the help window.

proc popup_help_dialog {} {
    global textfont

    if { [ winfo exists .help ] } {
	wm deiconify .help
	return
    }

    toplevel .help
    wm title .help "Xconq Help"

    set bigfont {-size 14 -weight bold}

    frame .help.top
    pack .help.top -side top -fill x

    button .help.top.help -text "Help" \
	    -command { help_goto help }
    button .help.top.prev -text "Prev" \
	    -command { help_goto prev }
    button .help.top.next -text "Next" \
	    -command { help_goto next }
    button .help.top.back -text "Back" \
	    -command { help_goto back }
    button .help.top.close -text "Close" \
	    -command { dismiss_help_dialog }
    pack .help.top.help .help.top.prev .help.top.next -side left
    pack .help.top.back .help.top.close -side left
    label .help.top.title -text "(title)" -font $bigfont
    pack .help.top.title -fill both

    frame .help.bot
    pack .help.bot -side bottom -fill both -expand true

    scrolled_listbox .help.bot.topics -selectmode browse -font $textfont
    pack .help.bot.topics -side left -fill both -expand true

    bind .help.bot.topics.list <ButtonRelease-1> { select_help_topic }

    frame .help.bot.t
    text .help.bot.t.txt -width 60 -height 30 -font $textfont -wrap word \
	    -yscrollcommand { .help.bot.t.scroll set }
    scrollbar .help.bot.t.scroll -command { .help.bot.t.txt yview }
    pack .help.bot.t.scroll -side right -fill y
    pack .help.bot.t.txt -side left -fill both -expand true
    pack .help.bot.t -side right -fill both -expand true

    set bgcolor [ .help.bot.t.txt cget -background ]

    canvas .help.bot.t.txt.img -width 32 -height 32 -bg $bgcolor
    imfsample .help.bot.t.txt.img.samp -width 32 -height 32 -bg $bgcolor
    .help.bot.t.txt.img create window 2 2 -anchor nw \
	    -window .help.bot.t.txt.img.samp
    .help.bot.t.txt window create end -window .help.bot.t.txt.img
    .help.bot.t.txt insert end "(heading)" heading
    .help.bot.t.txt tag config heading -font $bigfont
    .help.bot.t.txt insert end "\n"
    .help.bot.t.txt insert end "(text)" body

    help_goto "map"
}

# Dig up the selected topic and go to that node.

proc select_help_topic {} {
    set i [ .help.bot.topics.list curselection ]
    set str [ .help.bot.topics.list get $i ]
    help_goto "$str"
}

# Given a help topic key, add it to the list of topics.  This is called
# from C code.

proc add_help_topic_key { key } {
    .help.bot.topics.list insert end $key
}

# This proc is called from C code to actually fill in the help window
# with help topic and text.

proc update_help { key contents nclass arg } {
    .help.top.title config -text "$key"
    .help.bot.t.txt delete heading.first heading.last
    .help.bot.t.txt insert 1.1 "$key" heading
    if { $nclass == "u" } {
	.help.bot.t.txt.img.samp replace imf [ u_image_name $arg ]
    } elseif { $nclass == "t" } {
	.help.bot.t.txt.img.samp replace imf [ t_image_name $arg ]
    } else {
	.help.bot.t.txt.img.samp remove imf foo
    }
    .help.bot.t.txt delete body.first body.last
    .help.bot.t.txt insert end "$contents" body
}

proc scrolled_listbox { f args } {
    frame $f
    listbox $f.list -yscrollcommand [ list $f.yscroll set ]
    eval { $f.list config } $args
    scrollbar $f.yscroll -orient vert \
	    -command [ list $f.list yview ]
    pack $f.yscroll -side right -fill y
    pack $f.list -side left -fill both -expand true
}

proc scrolled_textbox { f args } {
    frame $f
    text $f.text -yscrollcommand [ list $f.yscroll set ]
    eval { $f.text config } $args
    scrollbar $f.yscroll -orient vert \
	    -command [ list $f.text yview ]
    pack $f.yscroll -side right -fill y
    pack $f.text -side left -fill both -expand true
}

# Make the dialog go away.

proc dismiss_help_dialog {} {
    wm withdraw .help
}

# Game save dialog.

set save_filename ""

proc popup_game_save { origname forcepopup } {
    global designer
    global save_filename

    if { $designer } {
	popup_designer_save
	return
    }
    if { "$save_filename" == "" } {
	set new_filename $origname
	set forcepopup 1
    } else {
	# Reuse the last filename.
	set new_filename $save_filename
    }
    if { $forcepopup } {
	set dname [ file dirname $new_filename ]
	set fname [ file tail $new_filename ]
	set filename [ tk_getSaveFile -initialfile $fname -initialdir $dname ]
    } else {
	set filename $new_filename
    }
    # Note that we can't just execute the long command "save",
    # because it calls this proc.
    if { "$filename" != "" } {
	game_save $filename
	# Remember this name for the next save.
	set save_filename $filename
    }
}

# Game end dialogs.

proc popup_game_over_dialog { fate } {
    # No more mode switching.
    disable_move_mode
    # (should change all action buttons)
    # (should) Let the display settle down a bit.
    # sleep 1
    # Update the scores list.
    if { "[ winfo exists .scores ]" } {
	.scores.main.text delete 1.0 end
	.scores.main.text insert end [ get_scores ]
    }

    # (should be able to pick nicer-looking font)
    set verybigfont {-size 36 -weight bold}

    toplevel .gameover
    wm title .gameover "Xconq Game Over"

    # (should position over center of current map window, or center of screen)
    set x [ winfo rootx .m1 ]
    incr x 200
    set y [ winfo rooty .m1 ]
    incr y 200
    wm geometry .gameover "+$x+$y"

    frame .gameover.top -width 280 -height 210
    pack .gameover.top -side top -fill x

    if { "$fate" == "won" } {
	set msg "You Won!"
    } elseif { "$fate" == "lost" } {
	set msg "You Lost!"
    } else {
	set msg "Game Over!"
    }
    label .gameover.top.fate -text $msg -font $verybigfont
    pack .gameover.top.fate -padx 4 -pady 4

    button .gameover.quitnow -text "Quit Now" \
	    -command { exit_xconq }
    pack .gameover.quitnow -side top -padx 4 -pady 4

    text .gameover.hint -width 36 -height 2 -borderwidth 0
    pack .gameover.hint -side top -padx 4 -pady 4

    .gameover.hint insert end "If you continue, you can look around and see how the game ended."

    button .gameover.continue -text "Continue" \
	    -command { dismiss_game_over_dialog }
    pack .gameover.continue -side top -padx 4 -pady 4
}

proc dismiss_game_over_dialog {} {
    wm withdraw .gameover
}

proc disable_move_mode {} {
    global nummaps map_widget

    for { set i 1 } { $i <= $nummaps } { incr i } {
	$map_widget($i).leftside.botside.buttons.move config -state disabled
    }
}

# Error/warning dialogs.

set suppress_warnings 0

proc popup_init_error_dialog { str } {
    tk_messageBox -type ok -icon error \
	    -message "Fatal Setup Error: $str\n\n\
	    Something is seriously wrong, either with Xconq \
	    or with the game that you chose."
}

proc popup_init_warning_dialog { str } {
    global suppress_warnings

    if { $suppress_warnings } {
	return
    }
    set rslt [ tk_messageBox -type yesno -icon warning \
	    -message "Warning: $str\n\
	    Xconq may not be able to give you exactly the game \
	    that you asked for.  Do you want to continue \
	    setting up this game?" ]
    if { $rslt == "no" } {
	exit_xconq
    }
    # (should try to reuse dialog - may need custom)
    set rslt [ tk_messageBox -type yesno -icon question \
	    -message "Do you want to see any further warnings?" ]
    if { $rslt == "no" } {
	set suppress_warnings 1
    }
}

proc popup_run_error_dialog { str } {
    set rslt [ tk_messageBox -type yesno -icon error \
	    -message "Fatal Error: $str\n\
	    Xconq cannot possibly continue on, \
	    but may able to save the game; \
	    would you like to try to save it?" ]
    if { $rslt == "yes" } {
	execute_long_command 0 "save"
    }
    # Exiting will be done by the program. (why?)
}

proc popup_run_warning_dialog { str } {
    global suppress_warnings
    global endofgame

    if { $suppress_warnings } {
	return
    }
    if { !$endofgame } {
	set rslt [ tk_messageBox -type yesno -icon warning \
		-message "Warning: $str\n\
		This is not fatal, \
		but may cause more serious problems later on.\
		Do you want to continue playing this game?\
		(if `no', you will get a chance to save it)" ]
	if { $rslt == "no" } {
	    # (should try to reuse dialog - may need custom)
	    set rslt [ tk_messageBox -type yesno -icon warning \
		    -message "Would you like to save the game?" ]
	    if { $rslt == "yes" } {
		execute_long_command 0 "save"
	    }
	    exit_xconq
	}
    } else {
	# The post-end-of-game version doesn't offer to save.
	set rslt [ tk_messageBox -type yesno -icon warning \
		-message "Warning: $str\n\
		Do you want to continue?" ]
	if { $rslt == "no" } {
	    exit_xconq
	}
    }
    # (should try to reuse dialog - may need custom)
    set rslt [ tk_messageBox -type yesno -icon question \
	    -message "Do you want to see any further warnings?" ]
    if { $rslt == "no" } {
	set suppress_warnings 1
    }
    reset_popup_flag
}

# Designer support.

set selected_design_tool normal

set last_dbutton .design.dbuttons.normal
set last_frame .design.design.fnormal

set curfid 0

proc popup_design_palette {} {

    if { "[ winfo exists .design ]" } {
	# Make the palette appear again.
	wm deiconify .design
    } else {
	# Create the design palette from scratch.
	toplevel .design
	wm title .design "Xconq Design"

	# Create a new frame for the design buttons.
	frame .design.dbuttons

	# First column of buttons.
	button .design.dbuttons.normal -bitmap looking_glass \
		-width 24 -height 24 \
		-command { select_paint normal make_normal_frame }
	button .design.dbuttons.terrain -bitmap paint_cell \
		-width 24 -height 24 \
		-command { select_paint terrain make_terrain_paint_frame }
	button .design.dbuttons.unit -bitmap paint_unit \
		-width 24 -height 24 \
		-command { select_paint unit make_unit_paint_frame }
	button .design.dbuttons.people -bitmap paint_people \
		-width 24 -height 24 \
		-command { select_paint people make_people_paint_frame }
	button .design.dbuttons.control -bitmap paint_control \
		-width 24 -height 24 \
		-command { select_paint control make_control_paint_frame }
	button .design.dbuttons.feature -bitmap paint_feature \
		-width 24 -height 24 \
		-command { select_paint feature make_feature_paint_frame }

	# Second column.
	button .design.dbuttons.material -bitmap paint_material \
		-width 24 -height 24 -state disabled \
		-command { select_paint material make_material_paint_frame }
	button .design.dbuttons.elevation -bitmap paint_elev \
		-width 24 -height 24 \
		-command { select_paint elevation make_elev_paint_frame }
	button .design.dbuttons.temperature -bitmap paint_temp \
		-width 24 -height 24 \
		-command { select_paint temperature make_temp_paint_frame }
	button .design.dbuttons.clouds -bitmap paint_clouds \
		-width 24 -height 24 \
		-command { select_paint clouds make_clouds_paint_frame }
	button .design.dbuttons.winds -bitmap paint_winds \
		-width 24 -height 24 \
		-command { select_paint winds make_winds_paint_frame }
	button .design.dbuttons.view -bitmap paint_view \
		-width 24 -height 24 \
		-command { select_paint view make_view_paint_frame }
	menubutton .design.dbuttons.brush -text "0" -width 1 -height 1 \
		-background white -borderwidth 2 -relief raised \
		-menu .design.dbuttons.brush.menu
	menu .design.dbuttons.brush.menu -tearoff 0
	for { set i 0 } { $i < 10 } { incr i } {
	    .design.dbuttons.brush.menu add command -label "$i" \
		    -command [ list dbg_set_design_data curbrushradius $i 0 ]
	}

	grid .design.dbuttons.normal .design.dbuttons.material
	grid .design.dbuttons.terrain .design.dbuttons.elevation
	grid .design.dbuttons.unit .design.dbuttons.temperature
	grid .design.dbuttons.people .design.dbuttons.clouds
	grid .design.dbuttons.control .design.dbuttons.winds
	grid .design.dbuttons.feature .design.dbuttons.view
	grid .design.dbuttons.brush -columnspan 2 -sticky news

	# Create the frame that will enclose info about painting.
	frame .design.design -width 200 -height 150 \
		-borderwidth 2 -relief sunken
	pack propagate .design.design false

	button .design.design.done -text "Stop Designing" \
		-command { execute_long_command 0 "design" }
	pack .design.design.done -side bottom -anchor se

	pack .design.dbuttons -side left -fill y
	pack .design.design -side left -fill y
    }

    global any_elev_variation
    if { !$any_elev_variation } {
	.design.dbuttons.elevation config -state disabled
    }
    global any_temp_variation
    if { !$any_temp_variation } {
	.design.dbuttons.temperature config -state disabled
    }
    global any_wind_variation
    if { !$any_wind_variation } {
	.design.dbuttons.winds config -state disabled
    }
    global any_clouds
    if { !$any_clouds } {
	.design.dbuttons.clouds config -state disabled
    }
    global see_all
    if { $see_all } {
	.design.dbuttons.view config -state disabled
    }

    select_paint normal make_normal_frame
    update idletasks
}

proc select_paint { type maker } {
    global last_dbutton
    global last_frame

    $last_dbutton config -relief raised
    .design.dbuttons.$type config -relief sunken
    set last_dbutton .design.dbuttons.$type
    if { "[ winfo exists $last_frame ]" == 1 } {
	pack forget $last_frame
    }
    set fframe .design.design.f$type
    if { "[ winfo exists $fframe ]" == 0 } {
	frame $fframe
	pack $fframe -side top -fill both
	$maker $fframe
    } else {
	pack $fframe -side top -fill both
    }
    set last_frame $fframe
    select_design_tool $type
    update idletasks
}

proc make_normal_frame { fnormal } {
    label $fnormal.label -text "Normal"
    pack $fnormal.label -side top -fill x
}

proc make_terrain_paint_frame { fterrain } {
    set numt [ numttypes ]
    set bgcolor [ $fterrain cget -background ]

    label $fterrain.label -text "Paint Terrain"
    pack $fterrain.label -side top -fill x

    canvas $fterrain.canvas -width 100 -height 100
    pack $fterrain.canvas -side left -pady 4 -pady 4

    # Place the foreground terrain second, so that it overlaps the
    # background terrain.
    imfsample $fterrain.canvas.bg -width 44 -height 48 -bg $bgcolor
    $fterrain.canvas.bg add imf [ t_image_name 0 ]
    $fterrain.canvas create window 30 50 -anchor nw -window $fterrain.canvas.bg

    imfsample $fterrain.canvas.fg -width 44 -height 48 -bg $bgcolor
    $fterrain.canvas.fg add imf [ t_image_name 0 ]
    $fterrain.canvas create window 4 4 -anchor nw -window $fterrain.canvas.fg

    menubutton $fterrain.fg -text [ ttype_name 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $fterrain.fg.menu
    pack $fterrain.fg -expand true
    menu $fterrain.fg.menu -tearoff 0
    for { set i 0 } { $i < $numt } { incr i } {
	$fterrain.fg.menu add command -label [ ttype_name $i ] \
		-command [ list dbg_set_design_data curttype $i 0 ]
    }

    menubutton $fterrain.bg -text [ ttype_name 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $fterrain.bg.menu
    pack $fterrain.bg -expand true
    menu $fterrain.bg.menu -tearoff 0
    for { set i 0 } { $i < $numt } { incr i } {
	$fterrain.bg.menu add command -label [ ttype_name $i ] \
		-command [ list dbg_set_design_data curbgttype $i 0 ]
    }

    bind $fterrain.canvas <ButtonPress> \
	    { cycle_design_data terrain incr }
    bind $fterrain.canvas <Control-ButtonPress> \
	    { cycle_design_data terrain decr }
    bind $fterrain.canvas.fg <ButtonPress> \
	    { cycle_design_data terrain incr }
    bind $fterrain.canvas.fg <Control-ButtonPress> \
	    { cycle_design_data terrain decr }
    bind $fterrain.canvas.bg <ButtonPress> \
	    { cycle_design_data terrain incr }
    bind $fterrain.canvas.bg <Control-ButtonPress> \
	    { cycle_design_data terrain decr }
}

proc make_unit_paint_frame { funit } {
    set numu [ numutypes ]
    set nums [ numsides ]
    set bgcolor [ $funit cget -background ]

    label $funit.label -text "Place Unit"
    pack $funit.label -side top -fill x

    canvas $funit.canvas -width 34 -height 34
    pack $funit.canvas -side left -padx 6 -pady 6
    imfsample $funit.canvas.samp -width 32 -height 32 -bg $bgcolor
    $funit.canvas.samp add imf [ u_image_name 0 ]
    $funit.canvas create window 1 1 -anchor nw -window $funit.canvas.samp

    menubutton $funit.type -text [ utype_name 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $funit.type.menu
    pack $funit.type -expand true
    menu $funit.type.menu -tearoff 0
    for { set i 0 } { $i < $numu } { incr i } {
	$funit.type.menu add command -label [ utype_name $i ] \
		-command [ list dbg_set_design_data curutype $i 0 ]
    }

    menubutton $funit.side -text [ side_adjective 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $funit.side.menu
    pack $funit.side -expand true
    menu $funit.side.menu -tearoff 0
    for { set i 0 } { $i <= $nums } { incr i } {
	$funit.side.menu add command -label [ side_adjective $i ] \
		-command [ list dbg_set_design_data curusidenumber $i 0 ]
	# Preload the unit sample with emblems for all sides, then
	# later we can just select at will.
	if { $i >= 1 } {
	    $funit.canvas.samp add imf [ side_emblem $i ]
	}
    }

    bind $funit.canvas <ButtonPress> \
	    [ list cycle_design_data unit incr ]
    bind $funit.canvas <Control-ButtonPress> \
	    [ list cycle_design_data unit decr ]
    bind $funit.canvas.samp <ButtonPress> \
	    [ list cycle_design_data unit incr ]
    bind $funit.canvas.samp <Control-ButtonPress> \
	    [ list cycle_design_data unit decr ]
}

proc make_people_paint_frame { fpeople } {
    set nums [ numsides ]
    set bgcolor [ $fpeople cget -background ]

    label $fpeople.label -text "Paint People"
    pack $fpeople.label -side top -fill x

    canvas $fpeople.canvas -width 32 -height 32
    pack $fpeople.canvas -side left -pady 4 -pady 4
    imfsample $fpeople.canvas.people -width 16 -height 16 -bg $bgcolor
    $fpeople.canvas.people add imf [ side_emblem 0 ]
    $fpeople.canvas create window 16 16 -anchor c \
	    -window $fpeople.canvas.people

    menubutton $fpeople.people -text [ side_name 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $fpeople.people.menu
    pack $fpeople.people -expand true
    menu $fpeople.people.menu -tearoff 0
    for { set i 0 } { $i <= $nums } { incr i } {
	$fpeople.people.menu add command -label [ side_name $i ] \
		-command [ list dbg_set_design_data curpeoplenumber $i 0 ]
    }

    bind $fpeople.canvas <ButtonPress> \
	    [ list cycle_design_data people incr ]
    bind $fpeople.canvas <Control-ButtonPress> \
	    [ list cycle_design_data people decr ]

    # Automatically turn on display of people layer.
    # (should indicate better what is happening)
    global nummaps map_widget
    global default_map_options
    for { set i 1 } { $i <= $nummaps } { incr i } {
	if { $default_map_options(people) == 0 } {
	    set default_map_options(people) 1
	    set_map_view_option $map_widget($i) people
	}
    }
}

proc make_control_paint_frame { fcontrol } {
    set nums [ numsides ]
    set bgcolor [ $fcontrol cget -background ]

    label $fcontrol.label -text "Paint Control"
    pack $fcontrol.label -side top -fill x

    canvas $fcontrol.canvas -width 32 -height 32
    pack $fcontrol.canvas -side left -pady 4 -pady 4
    imfsample $fcontrol.canvas.control -width 16 -height 16 -bg $bgcolor
    $fcontrol.canvas.control add imf [ side_emblem 0 ]
    $fcontrol.canvas create window 16 16 -anchor c \
	    -window $fcontrol.canvas.control

    menubutton $fcontrol.control -text [ side_name 0 ] \
	    -borderwidth 2 -relief raised \
	    -menu $fcontrol.control.menu
    pack $fcontrol.control -expand true
    menu $fcontrol.control.menu -tearoff 0
    for { set i 0 } { $i <= $nums } { incr i } {
	$fcontrol.control.menu add command -label [ side_name $i ] \
		-command [ list dbg_set_design_data curcontrolnumber $i 0 ]
    }

    bind $fcontrol.canvas <ButtonPress> \
	    [ list cycle_design_data control incr ]
    bind $fcontrol.canvas <Control-ButtonPress> \
	    [ list cycle_design_data control decr ]

    # Automatically turn on display of control layer.
    # (should indicate better what is happening)
    global nummaps map_widget
    global default_map_options
    for { set i 1 } { $i <= $nummaps } { incr i } {
	if { $default_map_options(control) == 0 } {
	    set default_map_options(control) 1
	    set_map_view_option $map_widget($i) control
	}
    }
}

set rename_name ""
set rename_type_name ""

proc make_feature_paint_frame { ffeature } {
    global curfid

    set numf [ numfeatures ]

    label $ffeature.label -text "Paint Feature"
    pack $ffeature.label -side top -fill x

    menubutton $ffeature.name -text "[ feature_desc 0 ]" \
	    -borderwidth 2 -relief raised \
	    -menu $ffeature.name.menu
    pack $ffeature.name -side top
    menu $ffeature.name.menu -tearoff 0
    $ffeature.name.menu add command -label "[ feature_desc 0 ]" \
	    -command [ list dbg_set_design_data curfid 0 0 ]
    for { set i 1 } { $i <= $numf } { incr i } {
	set colbreak 0
	if { $i % 25 == 0 } {
	    set colbreak 1
	}
	$ffeature.name.menu add command -label "[ feature_desc $i ]" \
		-command [ list dbg_set_design_data curfid $i 0 ] \
		-columnbreak $colbreak
    }

    button $ffeature.new -text New \
	    -command { new_feature }
    button $ffeature.rename -text Rename -state disabled \
	    -command { rename_feature $curfid }
    button $ffeature.delete -text Delete -state disabled \
	    -command { delete_feature $curfid }
    pack $ffeature.new $ffeature.rename $ffeature.delete -side top -anchor nw

    # (should add text labels describing each field)
    entry $ffeature.newname -textvariable rename_name
    entry $ffeature.typename -textvariable rename_type_name
    pack $ffeature.newname $ffeature.typename -side top -fill x

    update_feature_name_entry 0
}

# For the given feature id, update the rename fields.

proc update_feature_name_entry { fid } {
    global rename_name rename_type_name

    set state active
    if { $fid == 0 } {
	set state disabled
    }
    .design.design.ffeature.rename config -state $state
    .design.design.ffeature.delete config -state $state

    set rawinfo [ feature_info $fid ]
    set finfo "list $rawinfo"
    set finfo2 [ lindex $finfo 1 ]
    set rename_name [ lindex $finfo2 0 ]
    set rename_type_name [ lindex $finfo2 1 ]
}

# Make the proposed renaming real.

proc rename_feature { fid } {
    global rename_name rename_type_name

    set_feature_info $fid $rename_name $rename_type_name
    # Update the feature menu entry.
    .design.design.ffeature.name.menu entryconfigure $fid \
	    -label "[ feature_desc $fid ]"
    # Update the menu button as well, for immediate feedback.
    .design.design.ffeature.name config -text "[ feature_desc $fid ]"
}

# Make the given feature disappear.

proc delete_feature { fid } {
    global curfid

    if { $fid < 1 } {
	# (should complain)
	return
    }
    set entryname [ feature_desc $fid ]
    destroy_feature $fid
    # Clear from the feature menu entry, but not by index.
    # (what if entryname were a number?)
    .design.design.ffeature.name.menu delete $entryname
    # If the deleted feature was the currently selected one (which is
    # usually the case), make the previous feature current.
    if { $curfid == $fid } {
	incr curfid -1
	dbg_set_design_data curfid $curfid 0
    }
}

proc make_material_paint_frame { fmaterial } {
    label $fmaterial.label -text "Paint Material"
    pack $fmaterial.label -side top -fill x
}

set elev_var 0
set elev_vary_var 0

proc make_elev_paint_frame { felev } {
    global elev_var elev_vary_var

    label $felev.label -text "Paint Elevation"
    pack $felev.label -side top -fill x

    frame $felev.entries
    pack $felev.entries -side top -fill x

    label $felev.entries.lab1 -text "Elevation:"
    entry $felev.entries.entry -textvariable elev_var
    grid $felev.entries.lab1 $felev.entries.entry
    label $felev.entries.lab2 -text "Random +/-:"
    entry $felev.entries.ventry -textvariable elev_vary_var
    grid $felev.entries.lab2 $felev.entries.ventry

    frame $felev.buttons
    pack $felev.buttons -side top

    button $felev.buttons.set -text Set \
	    -command { set_elevation }
    button $felev.buttons.raise -text Raise \
	    -command { raise_elevation }
    button $felev.buttons.lower -text Lower \
	    -command { lower_elevation }
    pack $felev.buttons.set $felev.buttons.raise $felev.buttons.lower -side left -anchor nw

    button $felev.fix -text Fix \
	    -command { designer_fix elevation }
    pack $felev.fix -side top

    label $felev.state1 -text "Set to elevation 0"
    pack $felev.state1 -side top
    label $felev.state2 -text "Randomly vary +/- 0"
    pack $felev.state2 -side top

    # Automatically turn on display of elevations.
    # (should indicate better what is happening)
    global nummaps map_widget
    global default_map_options
    for { set i 1 } { $i <= $nummaps } { incr i } {
	if { $default_map_options(elevations) == 0 } {
	    set default_map_options(elevations) 1
	    set_map_view_option $map_widget($i) elevations
	}
    }
}

proc set_elevation {} {
    global elev_var elev_vary_var

    dbg_set_design_data curelevation $elev_var 0
    dbg_set_design_data curelevation_vary $elev_vary_var 0
}

proc raise_elevation {} {
    global elev_var elev_vary_var

    dbg_set_design_data curelevation incr $elev_var
    dbg_set_design_data curelevation_vary $elev_vary_var 0
}

proc lower_elevation {} {
    global elev_var elev_vary_var

    dbg_set_design_data curelevation decr $elev_var
    dbg_set_design_data curelevation_vary $elev_vary_var 0
}

set tempvar 0

proc make_temp_paint_frame { ftemp } {
    global tempvar

    label $ftemp.label -text "Paint Temperature"
    pack $ftemp.label -side top -fill x

    entry $ftemp.entry -textvariable tempvar
    pack $ftemp.entry

    button $ftemp.set -text Set \
	    -command [ list dbg_set_design_data curtemperature $tempvar 0 ]
    pack $ftemp.set -side left -anchor nw
}

proc make_clouds_paint_frame { fclouds } {
    label $fclouds.label -text "Paint Clouds"
    pack $fclouds.label -side top -fill x

    entry $fclouds.dentry -textvariable clouddvar
    pack $fclouds.dentry
    entry $fclouds.bentry -textvariable cloudbvar
    pack $fclouds.bentry
    entry $fclouds.hentry -textvariable cloudhvar
    pack $fclouds.hentry
}

proc make_winds_paint_frame { fwinds } {
    label $fwinds.label -text "Paint Winds"
    pack $fwinds.label -side top -fill x

    menubutton $fwinds.dir -text "0" \
	    -borderwidth 2 -relief raised \
	    -menu $fwinds.dir.menu
    pack $fwinds.dir -expand true
    menu $fwinds.dir.menu -tearoff 0
    foreach dir { 0 1 2 3 4 5 } {
	$fwinds.dir.menu add command -label "$dir" \
		-command [ list dbg_set_design_data curwinddir $dir 0 ]
    }
    menubutton $fwinds.force -text "0" \
	    -borderwidth 2 -relief raised \
	    -menu $fwinds.force.menu
    pack $fwinds.force -expand true
    menu $fwinds.force.menu -tearoff 0
    foreach force { 0 1 2 3 4 } {
	$fwinds.force.menu add command -label "$force" \
		-command [ list dbg_set_design_data curwindforce $force 0 ]
    }
}

proc make_view_paint_frame { fview } {
    label $fview.label -text "Paint View"
    pack $fview.label -side top -fill x

}

# Make the palette go away, but don't destroy - might want to get it back
# in the near future.

proc dismiss_design_palette {} {
    wm withdraw .design
}

# Given the name of a designer tool, make it the current one in use.

proc select_design_tool { name } {
    global selected_design_tool

    if { $name == $selected_design_tool } {
	return
    }
    set_design_tool $name
    set selected_design_tool $name
}

# Given a type of design data/tool and a value for that type of data,
# set it to be the value to paint and update any feedback displays.

proc dbg_set_design_data { type val val2 } {
    global curfid

    set newval [ set_design_data $type $val $val2 ]
    set dframe .design.design
    if { $type == "curttype" } {
	$dframe.fterrain.canvas.fg replace imf [ t_image_name $newval ]
	$dframe.fterrain.fg config -text [ ttype_name $newval ]
    } elseif { $type == "curbgttype" } {
	$dframe.fterrain.canvas.bg replace imf [ t_image_name $newval ]
	$dframe.fterrain.bg config -text [ ttype_name $newval ]
    } elseif { $type == "curutype" } {
	$dframe.funit.canvas.samp replace imf [ u_image_name $newval ]
	$dframe.funit.type config -text [ utype_name $newval ]
    } elseif { $type == "curusidenumber" } {
	$dframe.funit.side config -text [ side_adjective $newval ]
	if { $newval > 0 } {
	    $dframe.funit.canvas.samp emblem $newval
	} else {
	    $dframe.funit.canvas.samp emblem -1
	}
    } elseif { $type == "curpeoplenumber" } {
	$dframe.fpeople.canvas.people replace imf [ side_emblem $newval ]
	$dframe.fpeople.people config -text [ side_name $newval ]
    } elseif { $type == "curcontrolnumber" } {
	$dframe.fcontrol.canvas.control replace imf [ side_emblem $newval ]
	$dframe.fcontrol.control config -text [ side_name $newval ]
    } elseif { $type == "curfid" } {
	$dframe.ffeature.name config -text [ feature_desc $newval ]
	update_feature_name_entry $newval
	# The current feature appears in a different color, so all
	# maps need to be updated.
	global nummaps
	for { set i 1 } { $i <= $nummaps } { incr i } {
	    execute_long_command $i "refresh"
	}
	set curfid $newval
    } elseif { $type == "curelevation" } {
	global elev_var elev_vary_var
	set lab $dframe.felevation.state1
	if { $val == "incr" } {
	    $lab config -text "Raise elevation by $elev_var"
	} elseif { $val == "decr" } {
	    $lab config -text "Lower elevation by $elev_var"
	} else {
	    $lab config -text "Set elevation to $elev_var"
	}
    } elseif { $type == "curelevation_vary" } {
	global elev_var elev_vary_var
	$dframe.felevation.state2 config -text "Randomly vary +/- $elev_vary_var"
    } elseif { $type == "curwinddir" } {
    } elseif { $type == "curwindforce" } {
    } elseif { $type == "curbrushradius" } {
	.design.dbuttons.brush config -text "$newval"
    }
}

proc cycle_design_data { type dir } {
    # The brush size setter is not a selectable tool.
    if { $type != "brush" } {
	select_design_tool $type
    }
    if { $type == "terrain" } {
	dbg_set_design_data curttype $dir 0
    } elseif { $type == "unit" } {
	dbg_set_design_data curutype $dir 0
    } elseif { $type == "people" } {
	dbg_set_design_data curpeoplenumber $dir 0
    } elseif { $type == "control" } {
	dbg_set_design_data curcontrolnumber $dir 0
    } elseif { $type == "feature" } {
	dbg_set_design_data curfid $dir 0
    } elseif { $type == "brush" } {
	dbg_set_design_data curbrushradius $dir o
    }
}

proc new_feature {} {
    set fid [ create_new_feature ]
    .design.design.ffeature.name.menu add command \
	    -label "[ feature_desc $fid ]" \
	    -command [ list dbg_set_design_data curfid $fid 0 ]
    dbg_set_design_data curfid $fid 0
}

set dsave_done 0

set dsave(name) "game-data"

set dsave(all) 0
set dsave(types) 0
set dsave(tables) 0
set dsave(globals) 0
set dsave(scoring) 0
set dsave(world) 0
set dsave(area) 0
set dsave(terrain) 0
set dsave(areamisc) 0
set dsave(weather) 0
set dsave(material) 0
set dsave(sides) 0
set dsave(views) 0
set dsave(docts) 0
set dsave(players) 0
set dsave(agreements) 0
set dsave(units) 0
set dsave(unitids) 0
set dsave(unitprops) 0
set dsave(unitactions) 0
set dsave(unitplans) 0
set dsave(history) 0

proc popup_designer_save {} {
    global dsave dsave_done

    toplevel .dsave
    wm title .dsave "Xconq Designer Save"

    set dsave_done 0

    frame .dsave.top
    pack .dsave.top -side top -fill x

    label .dsave.top.modulelabel -text "Module Name:"
    entry .dsave.top.modulename -width 40
    .dsave.top.modulename insert end $dsave(name)
    pack .dsave.top.modulelabel .dsave.top.modulename -side left

    frame .dsave.f1
    pack .dsave.f1 -side top

    checkbutton .dsave.f1.all -text "Save All" -variable dsave(all)
    grid .dsave.f1.all -sticky w

    checkbutton .dsave.f1.types -text "Types" -variable dsave(types)
    checkbutton .dsave.f1.tables -text "Tables" -variable dsave(tables)
    grid .dsave.f1.types .dsave.f1.tables -sticky w

    checkbutton .dsave.f1.globals -text "Globals" -variable dsave(globals)
    grid .dsave.f1.globals -sticky w

    checkbutton .dsave.f1.scoring -text "Scoring" -variable dsave(scoring)
    grid .dsave.f1.scoring -sticky w

    checkbutton .dsave.f1.world -text "World" -variable dsave(world)
    grid .dsave.f1.world -sticky w

    checkbutton .dsave.f1.area -text "Area Basic" -variable dsave(area)
    checkbutton .dsave.f1.terrain -text "Area Terrain" -variable dsave(terrain)
    checkbutton .dsave.f1.areamisc -text "Area Misc" -variable dsave(areamisc)
    checkbutton .dsave.f1.weather -text "Area Weather" -variable dsave(weather)
    checkbutton .dsave.f1.material -text "Area Material" \
	    -variable dsave(material)
    grid .dsave.f1.area .dsave.f1.areamisc .dsave.f1.terrain \
	    .dsave.f1.weather .dsave.f1.material -sticky w

    checkbutton .dsave.f1.sides -text "Sides Basic" -variable dsave(sides)
    checkbutton .dsave.f1.sideviews -text "Side Views" -variable dsave(views)
    checkbutton .dsave.f1.sidedocts -text "Side Doctrines" \
	    -variable dsave(docts)
    grid .dsave.f1.sides .dsave.f1.sideviews .dsave.f1.sidedocts -sticky w

    checkbutton .dsave.f1.players -text "Players" -variable dsave(players)
    grid .dsave.f1.players -sticky w

    checkbutton .dsave.f1.agreements -text "Agreements" -variable dsave(agreements)
    grid .dsave.f1.agreements -sticky w

    checkbutton .dsave.f1.units -text "Units Basic" -variable dsave(units)
    checkbutton .dsave.f1.unitids -text "Unit Ids" -variable dsave(unitids)
    checkbutton .dsave.f1.unitprops -text "Unit Properties" \
	    -variable dsave(unitprops)
    checkbutton .dsave.f1.unitactions -text "Unit Actions" \
	    -variable dsave(unitactions)
    checkbutton .dsave.f1.unitplans -text "Unit Plans" \
	    -variable dsave(unitplans)
    grid .dsave.f1.units .dsave.f1.unitids .dsave.f1.unitprops .dsave.f1.unitactions .dsave.f1.unitplans -sticky w

    checkbutton .dsave.f1.history -text "History" -variable dsave(history)
    grid .dsave.f1.history -sticky w

    frame .dsave.bottom -height 40 -width 40
    pack .dsave.bottom -side bottom -fill x

    button .dsave.bottom.save -text "Save" \
	    -command { save_design }
    button .dsave.bottom.cancel -text "Cancel" \
	    -command { set dsave_done 1 }
    grid .dsave.bottom.save .dsave.bottom.cancel -sticky news

    focus .dsave
    tkwait visibility .dsave
    grab .dsave
    tkwait variable dsave_done
    grab release .dsave
    destroy .dsave
}

proc save_design {} {
    global dsave dsave_done

    set args ""
    if { $dsave(all) } { set args " all $args" }
    if { $dsave(types) } { set args " types $args" }
    if { $dsave(tables) } { set args " tables $args" }
    if { $dsave(globals) } { set args " globals $args" }
    if { $dsave(scoring) } { set args " scoring $args" }
    if { $dsave(world) } { set args " world $args" }
    if { $dsave(area) } { set args " area $args" }
    if { $dsave(areamisc) } { set args " areamisc $args" }
    if { $dsave(terrain) } { set args " terrain $args" }
    if { $dsave(weather) } { set args " weather $args" }
    if { $dsave(material) } { set args " material $args" }
    if { $dsave(sides) } { set args " sides $args" }
    if { $dsave(views) } { set args " views $args" }
    if { $dsave(docts) } { set args " docts $args" }
    if { $dsave(players) } { set args " players $args" }
    if { $dsave(agreements) } { set args " agreements $args" }
    if { $dsave(units) } { set args " units $args" }
    if { $dsave(unitids) } { set args " unitids $args" }
    if { $dsave(unitprops) } { set args " unitprops $args" }
    if { $dsave(unitactions) } { set args " unitactions $args" }
    if { $dsave(unitplans) } { set args " unitplans $args" }
    if { $dsave(history) } { set args " history $args" }
    set dsave(name) "[.dsave.top.modulename get ]"
    set filename [ tk_getSaveFile -initialfile $dsave(name).g -initialdir "." ]
    if { "$filename" != "" } {
	designer_save $dsave(name) $filename $args
    }
    set dsave_done 1
}

proc create_left_right_panes { win leftratio } {

    frame $win.leftside -borderwidth 2 -relief sunken
    place $win.leftside -in $win -relx 0 -rely 1.0 \
	    -relwidth $leftratio -relheight 1 -anchor sw

    set rightratio [ expr 1.0 - $leftratio ]

    frame $win.rightside -borderwidth 2 -relief sunken
    place $win.rightside -in $win -relx 1.0 -rely 1.0 \
	    -relwidth $rightratio -relheight 1 -anchor se

    frame $win.grip -width 9 -height 9 -borderwidth 2 -relief raised
    place $win.grip -relx $leftratio -rely 0.95 -anchor c

    bind $win.grip <ButtonPress-1>	"lr_panedwindow_grab $win"
    bind $win.grip <B1-Motion>		"lr_panedwindow_drag $win %X"
    bind $win.grip <ButtonRelease-1>	"lr_panedwindow_drop $win %X"
}

proc lr_panedwindow_grab { win } {
    $win.grip config -relief sunken
}

proc lr_panedwindow_drag { win x } {
    set realx [ expr $x - [ winfo rootx $win ] ]
    set xmax [ winfo width $win ]
    set frac [ expr double($realx) / $xmax ]
    if { $frac < 0.05 } {
	set frac 0.05
    }
    if { $frac > 0.95 } {
	set frac 0.95
    }
    place $win.grip -relx $frac
    return $frac
}

proc lr_panedwindow_drop { win x } {
    set frac [ lr_panedwindow_drag $win $x ]
    place $win.leftside -relwidth $frac
    place $win.rightside -relwidth [ expr 1.0 - $frac ]
    place $win.grip -relx $frac
    $win.grip config -relief raised
}

proc create_top_bottom_panes { win topratio } {

    frame $win.topside -borderwidth 1 -relief sunken
    place $win.topside -in $win -relx 0 -rely 0 \
	    -relwidth 1 -relheight $topratio -anchor nw

    set bottomratio [ expr 1.0 - $topratio ]

    frame $win.botside -borderwidth 1 -relief sunken
    place $win.botside -in $win -relx 0 -rely 1.0 \
	    -relwidth 1 -relheight $bottomratio -anchor sw

    frame $win.grip -width 9 -height 9 -borderwidth 2 -relief raised
    place $win.grip -relx 0.95 -rely $topratio -anchor c

    bind $win.grip <ButtonPress-1>	"tb_panedwindow_grab $win"
    bind $win.grip <B1-Motion>		"tb_panedwindow_drag $win %Y"
    bind $win.grip <ButtonRelease-1>	"tb_panedwindow_drop $win %Y"
}

proc tb_panedwindow_grab { win } {
    $win.grip config -relief sunken
}

proc tb_panedwindow_drag { win y } {
    set realy [ expr $y - [ winfo rooty $win ] ]
    set ymax [ winfo height $win ]
    set frac [ expr double($realy) / $ymax ]
    if { $frac < 0.05 } {
	set frac 0.05
    }
    if { $frac > 0.95 } {
	set frac 0.95
    }
    place $win.grip -rely $frac
    return $frac
}

proc tb_panedwindow_drop { win y } {
    set frac [ tb_panedwindow_drag $win $y ]
    place $win.topside -relheight $frac
    place $win.botside -relheight [ expr 1.0 - $frac ]
    place $win.grip -rely $frac
    $win.grip config -relief raised
}

proc fit_map { wid } {
    for { set i 6 } { $i >= 0 } { incr i -1 } {
	set siz [ map_size_at_power $i ]
	if { [ lindex $siz 0 ] <= $wid } {
	    return $i
	}
    }
    return 0
}

proc resize_world_map { worldf val w h } {
    global last_world_width last_world_power

    if { $val == 613 } {
	if { $last_world_width != $w } {
	    set newpow [ fit_map $w ]
	    if { $newpow != $last_world_power } {
		$worldf.world config -power $newpow
		set last_world_width $w
		set last_world_power $newpow
	    }
	}
    }
}

# If the unit info box has changed size, adjust the position of the
# second column of info so that it is always in the middle.

proc resize_unit_info { unitinfo val w h } {
    set oldcol2 [ lindex [ $unitinfo coords hp ] 0 ]
    set newcol2 [ expr $w / 2 ]
    $unitinfo move col2 [ expr $newcol2 - $oldcol2 ] 0
}

proc find_image_filename { name } {
    global pathlist

    foreach path $pathlist {
	set filename [ file join $path $name ]
	if { "[ file exists $filename ]" } {
	    return $filename
	}
    }
    # Fallback - look for sibling images dir next to each library path.
    foreach path $pathlist {
	set filename [ file join [ file dirname $path ] "images" $name ]
	if { "[ file exists $filename ]" } {
	    return $filename
	}
    }
    return ""
}
