# The tcl/tk interface to Xconq.
# Copyright (C) 1998, 1999 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

# Isometric display is flaky, leave off for now.

set isometric_state disabled

set dside 0

set all_see_all 0
set may_set_see_all 0

set handling_key 0

set curunit 0

set pathlist [ split [ xconq_library_paths ] ";" ]

set debug 0

# Debugging hacks.

if { "$env(USER)" == "shebs" } {
    set debug 1
}

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
    # Make this available for experimentation.
    set isometric_state normal
}

set last_world_width 0
set last_world_power -1

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

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"

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(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 7 -text New -font $bigfont \
	    -command { popup_game_dialog }
    button .newgame.bottom.b2 -width 7 -text Open -font $bigfont \
	    -command { puts stdout "open_game_dialog not implemented yet" }
    button .newgame.bottom.b3 -width 7 -text Connect -font $bigfont \
	    -command { popup_connect_dialog }
    pack .newgame.bottom.b1 .newgame.bottom.b2 .newgame.bottom.b3 \
	    -side left -padx 4 -pady 4
    button .newgame.bottom.quit -text Quit \
	    -command { exit }
    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
    .newgame.bottom.b2 config -text Cancel -state disabled
}

# The new game dialog.

proc popup_game_dialog {} {
    wm title .newgame "Xconq New Game Setup"
    remove_splash_screen_dialog_items
    add_new_game_dialog_items
    .newgame.bottom.b1 config -text "OK" -command { new_game }
    .newgame.bottom.b3 config -text "Network" -command { popup_hosting }
}

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

    set numgames [ numgames ]

    for { set i 0 } { $i < $numgames } { incr i } {
	set rawdata [ game_info $i ]
	set agame "list $rawdata"
	set agame2 [ lindex $agame 1 ]
	set entry [ lindex $agame2 3 ]
	append entry [ lindex $agame2 1 ]
	.newgame.top.left.f.games insert end $entry
    }

    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 150 \
	    -borderwidth 2 -relief sunken
    .newgame.top.right.preview create text 100 75 -tag label -anchor c
    pack .newgame.top.right.preview -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 10 -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 -fill both -expand true

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

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.

proc select_game {} {
    global selected_game_title

    set i [ .newgame.top.left.f.games curselection ]
    set rawdata [ game_info $i ]
    set agame "list $rawdata"
    set agame2 [ lindex $agame 1 ]
    .newgame.top.right.preview itemconfigure label -text "(no picture)"
    .newgame.top.right.blurb.t delete 1.0 end
    .newgame.top.right.blurb.t insert end [ lindex $agame2 2 ]
    set selected_game_title [ lindex $agame2 1 ]
}

proc new_game {} {
    set i [ .newgame.top.left.f.games curselection ]
    start_new_game $i
    remove_new_game_dialog_items
    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
    .newgame.bottom.b3 config -text "" -state disabled -borderwidth 0
}

proc add_variants_dialog_items {} {
    global selected_game_title
    global varianttext variantstate
    global vary_world vary_real_time
    global new_width new_height new_circumference new_latitude new_longitude
    global new_time_for_game new_time_per_side new_time_per_turn

    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
	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 < 5 } { incr row } {
	set col1 $row
	    set col2 [ expr $row + 5 ]
	    checkbutton .newgame.top.checks.v$col1 -text $varianttext($col1) \
		    -state $variantstate($col1) -variable variantvalue($col1)
	    checkbutton .newgame.top.checks.v$col2 -text $varianttext($col2) \
		    -state $variantstate($col2) -variable variantvalue($col2)
	    grid .newgame.top.checks.v$col1 .newgame.top.checks.v$col2 \
		    -sticky w -pad 5
	}
	for { set v 0 } { $v < 10 } { 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 == 0 } {
	    .newgame.top.buttons.worldsize config -state disabled
	}
	if { $vary_real_time == 0 } {
	    .newgame.top.buttons.realtime config -state disabled
	}
    }
    pack .newgame.top.buttons -side right -fill y
}

proc show_variant_help { var } {
    set msg ""
    if { $var == 0 } {
	set msg "If set, whole world's terrain will be seen at outset of game."
    } elseif { $var == 1 } {
	set msg "If set, everything in the game is seen all the time."
    } elseif { $var == 2 } {
	set msg "If set, each side moves one at a time."
    } else {
	set msg "(No help available.)"
    }
    .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 remove_variants_dialog_items {} {
    pack forget .newgame.top.header
    pack forget .newgame.top.vhelp
    pack forget .newgame.top.checks
    pack forget .newgame.top.buttons
}

set vary_world 0
set vary_real_time 0

# (should get these defaults from C code)
set new_width 60
set new_height 30
set new_circumference 360
set new_latitude 0
set new_longitude 0

set new_time_for_game 1200
set new_time_per_side 0
set new_time_per_turn 120

proc set_variants {} {
    global variantstate variantvalue
    global new_width new_height new_circumference new_latitude new_longitude
    global new_time_for_game new_time_per_side new_time_per_turn

    for { set i 0 } { $i < 10 } { incr i } {
	if { "$variantstate($i)" == "active" } {
	    set_variant_value $i $variantvalue($i)
	}
    }
    set_variant_value -1 $new_width $new_height $new_circumference \
	    $new_latitude $new_longitude
    set_variant_value -2 $new_time_for_game $new_time_per_side $new_time_per_turn
    implement_variants
    remove_variants_dialog_items
    launch_game
    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
	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 ]
    # 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 ] ]
    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
    .newgame.bottom.b3 config -text "" -state disabled -borderwidth 0
}

set selected_player -1

proc add_player_dialog_items {} {
    global selected_player

    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

    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 ""
	$sp_entry create text 260 5 -tag remote -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
	}
	pack $sp_entry -side top -fill x -padx 1 -pady 1
	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 -pad 2
    button .newgame.top.plbuttons.add -text "Add" -state disabled \
	    -command { add_player_cmd } -width 8
    grid .newgame.top.plbuttons.add -columnspan 2 -sticky ew -pad 2
    button .newgame.top.plbuttons.remove -text "Remove" -state disabled -width 8
    grid .newgame.top.plbuttons.remove -columnspan 2 -sticky ew -pad 2
    button .newgame.top.plbuttons.rename -text "Rename" \
	    -command { rename_side_for_player_cmd } -width 8
    grid .newgame.top.plbuttons.rename -columnspan 2 -sticky ew -pad 2
    button .newgame.top.plbuttons.computer -text "Computer" \
	    -command { toggle_ai_cmd } -width 8
    grid .newgame.top.plbuttons.computer -columnspan 2 -sticky ew -pad 2
    button .newgame.top.plbuttons.remote -text "Remote" \
	    -command { toggle_remote_cmd } -width 8
    grid .newgame.top.plbuttons.remote -columnspan 2 -sticky ew -pad 2
    button .newgame.top.plbuttons.exchange -text "Exchange" -state disabled \
	    -command { exchange_players_cmd } -width 8
    grid .newgame.top.plbuttons.exchange -columnspan 2 -sticky ew -pad 2

    if { $nums < $maxs } {
	.newgame.top.plbuttons.add config -state active
    }
    if { $nums > 1 } {
	.newgame.top.plbuttons.exchange config -state active
    }
    select_player 0
}

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 ]
    update_player_entry $newsel
    select_player $newsel

    set nums [ numsides ]
    set maxs [ maxsides ]

    if { $nums >= $maxs } {
	.newgame.top.plbuttons.add config -state disabled
    }
    if { $nums > 1 } {
	.newgame.top.plbuttons.exchange config -state active
    }
}

proc rename_side_for_player_cmd {} {
    global selected_player

    rename_side_for_player $selected_player
    update_player_entry $selected_player
}

proc toggle_ai_cmd {} {
    global selected_player

    set_ai_for_player $selected_player mplayer toggle
    update_player_entry $selected_player
}

proc toggle_remote_cmd {} {
    global selected_player

    set_remote_for_player $selected_player toggle
    update_player_entry $selected_player
}

proc exchange_players_cmd {} {
    global selected_player

    set new_selected [ exchange_players $selected_player -1 ]
    update_player_entry $selected_player
    update_player_entry $new_selected
    select_player $new_selected
}

proc select_player { newsel } {
    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 ]" } {
	set state active
    } else {
	set state disabled
    }
    .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
    .newgame.top.plbuttons.remote config -state $state
    .newgame.top.plbuttons.exchange config -state $state
}

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

proc update_player_entry { i } {
    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
    }
    set remote [ player_remote_status $player ]
    if { $remote > 0 } {
	$sp_entry itemconfig remote -text $remote
    }
}

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

proc set_players {} {
    launch_game_2
    # Once the game is underway, we can make this dialog go away.
    wm withdraw .newgame
}

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

# The player connection dialog.

proc popup_connect_dialog {} {
    wm title .newgame "Xconq Connect (TCP/IP)"
    remove_splash_screen_dialog_items
    add_connect_dialog_items
    .newgame.bottom.b1 config -text OK -command { join_game }
}

set joinhost localhost
set joinport 3075

proc add_connect_dialog_items {} {
    global joinhost joinport

    frame .newgame.top.join
    pack .newgame.top.join
    pack propagate .newgame.top.join false

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

proc remove_connect_dialog_items {} {
    pack forget .newgame.top.join
}

proc join_game {} {
    global joinhost joinport

    try_join_game "$joinhost:$joinport"
    remove_connect_dialog_items
    popup_player_dialog
}

proc popup_hosting {} {
    popup_pregame_chat
}

proc popup_pregame_chat {} {
    global persons
    global env
    global debug

    toplevel .chat
    wm title .chat "Xconq Chat"

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

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

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

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

    set persons(1,name) $env(USER)
    set persons(1,host) $env(HOSTNAME)

    .chat.top.left.persons insert end "$persons(1,name)@$persons(1,host)"

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

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

    bind .chat <Key> { if {"%A" != "{}" } { insert_chat_char "%A" } }
    bind .chat <BackSpace> { if {"%A" != "{}" } { delete_chat_char } }
    bind .chat <Return> { if {"%A" != "{}" } { insert_chat_char "\n" } }

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

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

proc insert_chat_char { ch } {
    .chat.top.right.t insert end $ch
}

proc delete_chat_char {} {
    .chat.top.right.t delete end
}

# 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.

proc create_map_window {} {
    global textfont boldfont
    global lineheight
    global list_icon_size
    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 ]

    set mapn 1
    set map .m$mapn

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

    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.80 * $mainwid) ]
    set mainhgt [ expr int(0.80 * $mainhgt) ]

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

    wm geometry $map $geomspec

    create_map_menus $map

    create_left_right_panes $map 0.75

    # Set up the left side's subpanes.

    create_top_bottom_panes $map.leftside 0.15

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

    text $map.leftside.topside.notices.t -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
    pack $map.leftside.botside.buttons -side left -fill y

    fill_in_button_box $map.leftside.botside.buttons

    text $map.leftside.botside.mouseover -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
    pack $map.leftside.botside.uf -side top -fill x
    
    canvas $map.leftside.botside.uf.unitinfo \
	    -height [ expr 5 * $lineheight ] -width 2000 \
	    -borderwidth 2 -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 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 2 -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 2 -relief sunken
    pack $map.rightside.gamef -side top -fill x -expand true

    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
    set limitheight [ expr $mainhgt / 2 ]
    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

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

    # Create the world map pane.

    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 ]
    map $map.rightside.worldf.world -world 1 -power $pow -dbl $dblbuffer
    whelp $map.rightside.worldf.world "Map of the whole world"
    pack $map.rightside.worldf.world

    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 2 -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 single 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 configure prefix -font $boldfont
    $map.leftside.topside.notices.t tag configure prompt -font $boldfont
    $map.leftside.topside.notices.t tag configure 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 } \
	    -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag { hp textual } \
	    -anchor sw -font $textfont
    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 }
    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 }
    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 }
    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 { s2 textual }
    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 { s3 textual }

    # 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 { buttonbox } {
    global isometric_state

    button $buttonbox.move -bitmap shoot_cursor \
	    -width 24 -height 24 \
	    -command { execute_long_command "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 { execute_long_command "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 { execute_long_command "return" }
    whelp $buttonbox.return "Return for more supplies"
    pack $buttonbox.return -side top
    button $buttonbox.sleep -bitmap sleep \
	    -width 24 -height 24 \
	    -command { execute_long_command "sleep" }
    whelp $buttonbox.sleep "Sleep indefinitely"
    pack $buttonbox.sleep -side top
    button $buttonbox.reserve -bitmap sleep \
	    -width 24 -height 24 \
	    -command { execute_long_command "reserve" }
    whelp $buttonbox.reserve "Reserve unit for next turn"
    pack $buttonbox.reserve -side top
    button $buttonbox.delay -bitmap delay \
	    -width 24 -height 24 \
	    -command { execute_long_command "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 { execute_long_command "zoom-in" }
    whelp $buttonbox.zoomin "Zoom in"
    pack $buttonbox.zoomin -side top
    button $buttonbox.zoomout -bitmap farther \
	    -width 24 -height 24 \
	    -command { execute_long_command "zoom-out" }
    whelp $buttonbox.zoomout "Zoom out"
    pack $buttonbox.zoomout -side top
    button $buttonbox.iso -bitmap iso -state $isometric_state \
	    -width 24 -height 24 \
	    -command { execute_long_command "map iso" }
    whelp $buttonbox.iso "Switch between isometric and overhead"
    pack $buttonbox.iso -side top
    button $buttonbox.rotl -bitmap rotl -state $isometric_state \
	    -width 24 -height 24 \
	    -command { execute_long_command "map rotl" }
    whelp $buttonbox.rotl "Rotate view left"
    pack $buttonbox.rotl -side top
    button $buttonbox.rotr -bitmap rotr -state $isometric_state \
	    -width 24 -height 24 \
	    -command { execute_long_command "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 sc0_$i -anchor sw -font $textfont
	# Start the loss line and victory laurels offscreen. 
	$sidelist create line 4000 $msy 2000 $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
		$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 itemconfigure 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 map_options(grid) 0
}

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

    foreach opt $view_option_list {
	set 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 map_options
    global unix_feature

    set nums [ numsides ]

    menu $map.menubar
    $map configure -menu $map.menubar

    $map.menubar add cascade -label "File" -menu $map.menubar.file
    menu $map.menubar.file
    $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
    $map.menubar.file add separator
    $map.menubar.file add command -label "Help" -accelerator "?" \
	    -command { create_help_window }
    $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 { execute_long_command "save" }
    $map.menubar.file add command -label "Save Game As" -state disabled
    $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 { execute_long_command "resign" }
    $map.menubar.file add command -label Quit -accelerator "Q" \
	    -command { execute_long_command "quit" }

    $map.menubar add cascade -label "Edit" -menu $map.menubar.edit
    menu $map.menubar.edit
    $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 { execute_long_command "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 { execute_long_command "in" }
    $map.menubar.find add separator
    $map.menubar.find add command -label "Location..." -state disabled
    $map.menubar.find add command -label "Unit by Name..." -state disabled
    $map.menubar.find add command -label "Distance" -accelerator "\#" \
	    -command { execute_long_command "distance" }
    $map.menubar.find add separator
    $map.menubar.find add command -label "Current Unit" -accelerator "." \
	    -command { execute_long_command "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 { execute_long_command "move-to" }
    $map.menubar.play add command -label "Return" -accelerator "r" \
	    -command { execute_long_command "return" }
    $map.menubar.play add command -label "Set Formation" \
	    -command { execute_long_command "formation" }
    $map.menubar.play add separator
    $map.menubar.play add command -label "Wake" -accelerator "w" \
	    -command { execute_long_command "wake" }
    $map.menubar.play add command -label "Wake All" -accelerator "W" \
	    -command { execute_long_command "wakeall" }
    $map.menubar.play add command -label "Sleep" -accelerator "s" \
	    -command { execute_long_command "sleep" }
    $map.menubar.play add command -label "Reserve" \
	    -command { execute_long_command "reserve" }
    $map.menubar.play add command -label "Idle" -accelerator "I" \
	    -command { execute_long_command "idle" }
    $map.menubar.play add command -label "Delay" -accelerator "d" \
	    -command { execute_long_command "delay" }
    $map.menubar.play add separator
    $map.menubar.play add command -label "Build" -accelerator "P" \
	    -command { execute_long_command "produce-unit" }
    $map.menubar.play add command -label "Repair" \
	    -command { execute_long_command "repair" }
    $map.menubar.play add separator
    $map.menubar.play add command -label "Attack" -accelerator "a" \
	    -command { execute_long_command "attack" }
    $map.menubar.play add command -label "Overrun" \
	    -command { execute_long_command "attack" }
    $map.menubar.play add command -label "Fire" \
	    -command { execute_long_command "fire" }
    $map.menubar.play add command -label "Fire Into" \
	    -command { execute_long_command "fire-into" }
    $map.menubar.play add command -label "Detonate" -accelerator "\!" \
	    -command { execute_long_command "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 { execute_long_command "give" }
    $map.menubar.more add command -label "Take" -accelerator "t" \
	    -command { execute_long_command "take" }
    $map.menubar.more add command -label "Collect" \
	    -command { execute_long_command "collect" }
    $map.menubar.more add separator
    $map.menubar.more add command -label "Embark" -accelerator "e" \
	    -command { execute_long_command "embark" }
    $map.menubar.more add command -label "Disembark" \
	    -command { execute_long_command "disembark" }
    $map.menubar.more add separator
    $map.menubar.more add command -label "Detach" \
	    -command { execute_long_command "detach" }
    $map.menubar.more add command -label "Disband" -accelerator "D" \
	    -command { execute_long_command "disband" }
    $map.menubar.more add separator
    $map.menubar.more add command -label "Add Terrain" -accelerator "A" \
	    -command { execute_long_command "add-terrain" }
    $map.menubar.more add command -label "Remove Terrain" -accelerator "R" \
	    -command { execute_long_command "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 { execute_long_command "map plan-none" }
    $map.menubar.more.plantype add command -label "Passive" \
	    -command { execute_long_command "map plan-passive" }
    $map.menubar.more.plantype add command -label "Defensive" \
	    -command { execute_long_command "map plan-defensive" }
    $map.menubar.more.plantype add command -label "Exploratory" \
	    -command { execute_long_command "map plan-exploratory" }
    $map.menubar.more.plantype add command -label "Offensive" \
	    -command { execute_long_command "map plan-offensive" }
    $map.menubar.more.plantype add command -label "Random" \
	    -command { execute_long_command "map plan-random" }
    $map.menubar.more add command -label "AI Control" \
	    -command { execute_long_command "auto" }
    $map.menubar.more add separator
    $map.menubar.more add command -label "Rename..." \
	    -command { execute_long_command "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 "$i give-unit" ]
    }

    $map.menubar add cascade -label "Side" -menu $map.menubar.side
    menu $map.menubar.side
    $map.menubar.side add command -label "Closeup" -state disabled
    $map.menubar.side add command -label "End This Turn" \
	    -command { execute_long_command "end-turn" }
    $map.menubar.side add separator
    $map.menubar.side add radio -label "Move Mode" -accelerator "z" \
	    -command { execute_long_command "survey" } \
	    -variable map_survey -value 0
    $map.menubar.side add radio -label "Survey Mode" -accelerator "z" \
	    -command { execute_long_command "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 { execute_long_command "ai" } \
	    -variable side_ai -value none
    $map.menubar.side.ai add radio -label "Mplayer" \
	    -command { execute_long_command "ai mplayer" } \
	    -variable side_ai -value mplayer
    $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 { execute_long_command "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
    $map.menubar.windows add command -label "New Map" -state disabled
    $map.menubar.windows add separator
    $map.menubar.windows add command -label "Map 1"
    # (should add entries for each window created)

    $map.menubar add cascade -label "View" -menu $map.menubar.view
    menu $map.menubar.view
    $map.menubar.view add command -label "Recenter" -accelerator "." \
	    -command { execute_long_command "recenter" }
    $map.menubar.view add command -label "Closer" -accelerator "\}" \
	    -command { execute_long_command "zoom-in" }
    $map.menubar.view add command -label "Farther" -accelerator "\{" \
	    -command { execute_long_command "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 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 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 map_options(elevations) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(lighting) \
	    -command [ list set_map_view_option $map lighting ] \
	    -variable 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 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 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 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 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 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 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 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 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" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 15
    $map.menubar.view.mi add radio -label "30" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 30
    $map.menubar.view.mi add radio -label "60" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 60
    $map.menubar.view.mi add radio -label "120" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 120
    $map.menubar.view.mi add radio -label "300" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 300
    $map.menubar.view.mi add radio -label "600" \
	    -command [ list set_map_view_option $map meridian_interval ] \
	    -variable map_options(meridian_interval) -value 600
    $map.menubar.view.mi add radio -label "Other..." \
	    -command { popup_meridian_interval_dialog } \
	    -variable map_options(meridian_interval) -value 1
    $map.menubar.view add check -label "See All" \
	    -command { execute_long_command "map seeall" } \
	    -variable map_options(see_all) -offvalue 0 -onvalue 1
    $map.menubar.view add check -label $view_option_names(ai) \
	    -command [ list set_map_view_option $map ai ] \
	    -variable map_options(ai) -offvalue 0 -onvalue 1

    adjust_view_menu $map
}

proc set_map_view_option { map opt } {
    global view_option_flags
    global map_options

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

# 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

    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..." $curunit
    adjust_menu_entry $map more "Give Unit" $curunit
}

# Enable/disable things on the view menu.

proc adjust_view_menu { map } {
    global all_see_all may_set_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

    adjust_menu_entry $map view "Coverage" [ expr !$all_see_all ]
    adjust_menu_entry $map view "People" $can_see_people
    adjust_menu_entry $map view "Control" $can_see_control
    adjust_menu_entry $map view "Elevations" $can_see_elev
    adjust_menu_entry $map view "Day/Night" $can_see_lighting
    adjust_menu_entry $map view "Weather" \
	    [ expr $can_see_temp | $can_see_winds | $can_see_clouds ]
    adjust_menu_entry $map view.weather "Temperature" $can_see_temp
    adjust_menu_entry $map view.weather "Winds" $can_see_winds
    adjust_menu_entry $map view.weather "Clouds" $can_see_clouds
    adjust_menu_entry $map view "See All" [ expr $may_set_see_all ]
}

# 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 popup_meridian_interval_dialog {} {

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

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

    entry .meridian.interval -textvariable map_options(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 map_options

    puts stdout "interval is $map_options(meridian_interval)"
    wm withdraw .meridian
}

proc make_normal_bindings { map } {
    global dside

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

    bind $map.leftside.botside.mapf.mapf2.map <ButtonPress> { mouse_down_cmd %x %y %b }
    bind $map.leftside.botside.mapf.mapf2.map <ButtonRelease> { mouse_up_cmd %x %y %b }
    bind $map.leftside.botside.mapf.mapf2.map <Motion> { mouse_over_cmd %x %y }
    bind $map.leftside.botside.mapf.mapf2.map <Leave> { mouse_over_cmd -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 $i ]
    }

    bind $map.rightside.worldf.world <ButtonPress> \
	    { world_mouse_down_cmd %x %y %b }
    bind $map.rightside.worldf.world <ButtonRelease> \
	    { world_mouse_up_cmd %x %y %b }

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

proc handle_key_binding { str win x y } {
    global handling_key

#    puts stdout "[focus .m1]"

    set handling_key 1
    set prefix [ interp_key "$str" $x $y ]
    .m1.leftside.topside.notices.t delete prefix.first "prefix.last - 1 chars"
    if { "$prefix" >= 0 } {
	.m1.leftside.topside.notices.t insert prefix.first ":" prefix
	.m1.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 { incr } {
    set map .m1
    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
    }
}

# Update routines called from C code.

proc update_game_state { str } {
    global debug

    if { $debug } {
	set str "$str (Debug)"
    }
    .m1.rightside.turnf.turn itemconfigure the_date -text $str
}

proc update_game_side_info { s str everingame ingame status } {
    set sidelist .m1.rightside.gamef.game
    $sidelist itemconfigure s$s -text $str
    if { !$everingame } {
	$sidelist itemconfigure s$s -fill gray
	$sidelist itemconfigure frame$s -fill gray
    }
    if { !$ingame } {
    }
    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 } {
    .m1.rightside.gamef.game itemconfigure $which -text $str
}

proc update_side_progress { s pri left resv } {
    global lineheight

    set old [ .m1.rightside.gamef.game coords left$s ]
    set rtop [ lindex $old 1 ]
    set rbot [ lindex $old 3 ]
    if { $pri == 0 } {
	.m1.rightside.gamef.game itemconfig frame$s -outline gray
	.m1.rightside.gamef.game coords left$s 24 $rtop 24 $rbot
	.m1.rightside.gamef.game coords resv$s 24 $rtop 24 $rbot
	return
    }
    .m1.rightside.gamef.game itemconfig frame$s -outline black
    .m1.rightside.gamef.game coords left$s 24 $rtop [ expr 24 + $left ] $rbot
    .m1.rightside.gamef.game coords resv$s 24 $rtop [ expr 24 + $resv ] $rbot
}

proc update_side_treasury { s j amt } {
    .m1.rightside.gamef.game itemconfig m$s,$j -text $amt
}

proc update_unitlist_char { n str } {
    .m1.rightside.listf.unitlist itemconfigure u$n -text $str
}

proc update_unitlist_count { n str } {
    .m1.rightside.listf.unitlist itemconfigure n$n -text $str
}

proc update_unitlist_incomplete { n str } {
    .m1.rightside.listf.unitlist itemconfigure i$n -text $str
}

proc update_unitlist_name { n str } {
    .m1.rightside.listf.unitlist itemconfigure name$n -text $str
}

proc update_unit_info { tag str } {
    global curunit

    if { "$tag" == "curunit" } {
	set curunit $str
    } else {
	.m1.leftside.botside.uf.unitinfo itemconfigure $tag -text $str
    }
}

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

proc update_unit_picture { image emblem } {
    global last_image last_emblem

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

# Update the appearance of any mode controls/displays.

proc update_mode { mode } {
    global map_survey

    if { "$mode" == "survey" } {
	set map_survey 1
	.m1.leftside.botside.buttons.move configure -relief raised
    } elseif { "$mode" == "move" } {
	set map_survey 0
	.m1.leftside.botside.buttons.move configure -relief sunken
    } else {
	puts stdout "?mode?"
    }
    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

    if { [ info exists widget_help_strings($widg) ] } {
	set str $widget_help_strings($widg)
    } else {
	set str ""
    }
    update_mouseover $str
}

# Replace the current mouseover text with the given version.  Called from
# C and tcl code.

proc update_mouseover { str } {
    .m1.leftside.botside.mouseover delete 1.0 end
    .m1.leftside.botside.mouseover insert insert "$str"
}

proc map_xscroll_set { first last } {
    .m1.leftside.botside.mapf.xscroll set $first $last
}

proc map_yscroll_set { first last } {
    .m1.leftside.botside.mapf.yscroll set $first $last
}

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

    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
    }
    if { "[ winfo exists .m1 ]" } {
	set state normal
	if { !$curunit || !$can_build } {
	    set state disabled
	}
	.m1.leftside.botside.buttons.build config -state $state
	set state normal
	if { !$curunit || !$can_return } {
	    set state disabled
	}
	.m1.leftside.botside.buttons.return config -state $state
	set state normal
	if { !$curunit || !$can_plan } {
	    set state disabled
	}
	.m1.leftside.botside.buttons.sleep config -state $state
    }
}

proc update_view_controls_info { a1 a2 a3 a4 a5 a6 a7 a8 a9 } {
    global all_see_all
    global may_set_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

    set all_see_all $a1
    set may_set_see_all $a2
    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
    if { "[ winfo exists .m1.menubar.view ]" } {
	adjust_view_menu .m1
    }
}

proc low_notify { str } {
    .m1.leftside.topside.notices.t insert notices.last $str notices
    # (should only do if already scrolled to end of notices)
    .m1.leftside.topside.notices.t yview moveto 1.0
}

proc ask_bool_mode { str dflt } { 
    global handling_key

    if { $handling_key } {
	if { $dflt } {
	    set dfltstr "yn"
	} else {
	    set dfltstr "ny"
	}
	.m1.leftside.topside.notices.t insert prompt.first \
		"$str \[$dfltstr\]" prompt
	# (should only do if already scrolled to end of notices)
	.m1.leftside.topside.notices.t yview moveto 1.0
    } else {
	toplevel .bool
	wm title .bool "Xconq Query"
	set x [winfo rootx .m1]
	incr x 200
	set y [winfo rooty .m1]
	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 { bool_yes }
	button .bool.buttons.no -text No -command { bool_no }
	grid .bool.buttons.yes .bool.buttons.no -pad 5
	# (should use dflt arg here)
	update idletasks
    }
}

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

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

proc ask_bool_done {} {
    global handling_key

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

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

proc ask_position_done {} {
    clear_command_line
    .m1.leftside.botside.mapf.mapf2.map config -cursor top_left_arrow
}

proc ask_unit_type_mode { str } { 
    .m1.leftside.topside.notices.t insert prompt.first "$str" prompt
    # (should only do if already scrolled to end of notices)
    .m1.leftside.topside.notices.t yview moveto 1.0
}

proc enable_unitlist { n flag } {
    if { $flag == 1 } {
	set color black
    } else {
	set color [ .m1.rightside.gamef.game cget -background ]
    }
    .m1.rightside.listf.unitlist itemconfigure rect$n -outline $color
}

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

proc ask_unit_type_done {} {
    clear_command_line
}

proc ask_terrain_type_mode { str } { 
    .m1.leftside.topside.notices.t insert prompt.first "$str" prompt
    # (should only do if already scrolled to end of notices)
    .m1.leftside.topside.notices.t yview moveto 1.0
}

proc ask_terrain_type_done {} {
    clear_command_line
}

proc ask_string_mode { str dflt } { 
    .m1.leftside.topside.notices.t insert prompt.first "$str" prompt
    .m1.leftside.topside.notices.t insert answer.last "$dflt" answer
    # (should only do if already scrolled to end of notices)
    .m1.leftside.topside.notices.t yview moveto 1.0
}

proc update_string_mode { answer } {
    .m1.leftside.topside.notices.t delete "answer.first + 1 chars" answer.last
    .m1.leftside.topside.notices.t insert answer.last $answer answer
}

proc ask_string_done {} {
    clear_command_line
}

# Side asking mode is similar to string asking mode.

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

proc update_side_mode { answer } {
    .m1.leftside.topside.notices.t delete "answer.first + 1 chars" answer.last
    .m1.leftside.topside.notices.t insert answer.first $answer answer
}

proc ask_side_done {} {
    clear_command_line
}

proc clear_command_line {} {
    .m1.leftside.topside.notices.t delete prompt.first "prompt.last - 1 chars"
    .m1.leftside.topside.notices.t delete "answer.first + 1 chars" answer.last
}

# 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 "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 ]
}

# 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 "Imagery"

    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)
    }
    foreach opt $imagery_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)
}

proc add_map_prefs_items {} {
    global view_option_list view_option_names

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

	menubutton .prefs.main.map.power -text $view_option_names(power) \
		-borderwidth 2 -relief raised \
		-menu .prefs.main.map.power.menu
	pack .prefs.main.map.power -side top -anchor nw
	menu .prefs.main.map.power.menu -tearoff 0
	for { set i 0 } { $i <= 6 } { incr i } {
	    .prefs.main.map.power.menu add command -label "$i" \
		    -command [ list set_power_pref $i ]
	}
	foreach opt $view_option_list {
	    if { "$opt" == "power" } continue
	    if { "$opt" == "meridian_interval" } continue
	    add_view_preference_checkbox $opt $view_option_names($opt)
	}
    }
    pack .prefs.main.map
}

proc add_view_preference_checkbox { opt optname } {
    checkbutton .prefs.main.map.$opt -text $optname \
	    -variable newprefs($opt)
    pack .prefs.main.map.$opt -side top -anchor nw
}

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

proc add_fonts_prefs_items {} {
    global prefs

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

	label .prefs.main.fonts.label -borderwidth 0 -text "Font Size:"
	pack .prefs.main.fonts.label -side top -anchor nw
	menubutton .prefs.main.fonts.family -text "$prefs(font_family)" \
		-borderwidth 2 -relief raised \
		-menu .prefs.main.fonts.family.menu
	pack .prefs.main.fonts.family -side top
	menu .prefs.main.fonts.family.menu -tearoff 0
	foreach family [font families] {
	    .prefs.main.fonts.family.menu add command -label "$family" \
		    -command [ list set_font_family_newpref $family ]
	}
	menubutton .prefs.main.fonts.size -text "$prefs(font_size)" \
		-borderwidth 2 -relief raised \
		-menu .prefs.main.fonts.size.menu
	pack .prefs.main.fonts.size -side top
	menu .prefs.main.fonts.size.menu -tearoff 0
	foreach size { 9 10 12 14 18 24 36 } {
	    .prefs.main.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.fonts.sampf -width 200 -height 100
	pack .prefs.main.fonts.sampf -side top
	pack propagate .prefs.main.fonts.sampf false

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

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

proc add_imagery_prefs_items {} {
    global prefs
    global imagery_option_names

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

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

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

proc set_power_pref { val } {
    global newprefs

    set newprefs(power) $val
    .prefs.main.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.fonts ]" } {
	.prefs.main.fonts.family config -text "$newprefs(font_family)"
	set tmpfont [ list "-family" $newprefs(font_family) \
		"-size" $newprefs(font_size) ]
	.prefs.main.fonts.sampf.sample config -font $tmpfont
    }
}

proc set_font_size_newpref { val } {
    global newprefs

    set newprefs(font_size) $val
    if { "[ winfo exists .prefs.main.fonts ]" } {
	.prefs.main.fonts.size config -text "$newprefs(font_size)"
	set tmpfont [ list "-family" $newprefs(font_family) \
		"-size" $newprefs(font_size) ]
	.prefs.main.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 == "Imagery" } {
	remove_imagery_prefs_items
    }
    if { $str == "Map View" } {
	add_map_prefs_items
    } elseif { $str == "Fonts" } {
	add_fonts_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 map_options

    foreach opt $view_option_list {
	set_pref_value $opt $newprefs($opt)
	set map_options($opt) $prefs($opt)
	set_map_view_option .m1 $opt
    }

    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.
    if { "[ winfo exists .m1.leftside.topside.notices.t ]" } {
	.m1.leftside.topside.notices.t config -font $textfont
    }
    if { "[ winfo exists .m1.leftside.botside.mouseover ]" } {
	.m1.leftside.botside.mouseover config -font $textfont
    }
    if { "[ winfo exists .m1.leftside.botside.uf.unitinfo ]" } {
	.m1.leftside.botside.uf.unitinfo itemconfig textual -font $textfont
    }
    if { "[ winfo exists .m1.leftside.botside.mapf.mapf2.map ]" } {
	.m1.leftside.botside.mapf.mapf2.map config -font $textfont
    }
    # (should add rest)

    foreach opt $imagery_option_list {
	set_pref_value $opt $newprefs($opt)
	set map .m1.leftside.botside.mapf.mapf2.map
	$map config -terrainimages $prefs(terrain_images)
	$map config -terrainpatterns $prefs(terrain_patterns)
	$map 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 create_help_window {} {
    global textfont

    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 -state disabled \
	    -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 -state disabled \
	    -command { help_goto back }
    pack .help.top.help .help.top.prev .help.top.next .help.top.back -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 25 -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 configure heading -font $bigfont
    .help.bot.t.txt insert end "\n"
    .help.bot.t.txt insert end "(text)" body

    help_goto "news"
}

# 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 configure } $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
}

# Game end dialogs.

proc popup_game_over_dialog { fate } {

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

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

    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 }
    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
}

# 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 \
		-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 }
	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 < 11 } { incr i } {
	    .design.dbuttons.brush.menu add command -label "$i" \
		    -command [ list dbg_set_design_data curbrushradius $i ]
	}

	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.brush

	# 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

	pack .design.dbuttons -side left -fill y
	pack .design.design -side left -fill y
    }
    select_paint normal make_normal_frame
    update idletasks
}

proc select_paint { type maker } {
    global last_dbutton
    global last_frame

    $last_dbutton configure -relief raised
    .design.dbuttons.$type configure -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 ]

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

    canvas $fterrain.canvas -width 32 -height 32
    pack $fterrain.canvas -side left -pady 4 -pady 4
    # Place the foreground terrain second, so that it overlaps the
    # the background.
    imfsample $fterrain.canvas.bg -width 24 -height 24
    $fterrain.canvas.bg add imf [ t_image_name 0 ]
    $fterrain.canvas create window 9 9 -anchor nw -window $fterrain.canvas.bg
    imfsample $fterrain.canvas.fg -width 24 -height 24
    $fterrain.canvas.fg add imf [ t_image_name 0 ]
    $fterrain.canvas create window 3 3 -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 ]
    }

    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 ]
    }

    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 ]
    }

    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 ]
    }

    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 ]
    }

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

    global map_options
    if { $map_options(people) == 0 } {
	set map_options(people) 1
	set_map_view_option .m1 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 ]
    }

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

    global map_options
    if { $map_options(control) == 0 } {
	set map_options(control) 1
	set_map_view_option .m1 control
    }
}

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 "No Feature" \
	    -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 "No Feature" \
	    -command [ list dbg_set_design_data curfid 0 ]
    for { set i 1 } { $i <= $numf } { incr i } {
	$ffeature.name.menu add command -label "[ feature_name $i ]" \
		-command [ list dbg_set_design_data curfid $i ]
    }

    button $ffeature.new -text New \
	    -command { new_feature }
    button $ffeature.rename -text Rename \
	    -command { rename_feature $curfid }
    pack $ffeature.new $ffeature.rename -side left -anchor nw
}

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

set elevvar 0

proc make_elev_paint_frame { felev } {
    global elevvar

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

    entry $felev.entry -textvariable elevvar
    pack $felev.entry

    button $felev.set -text Set \
	    -command [ list dbg_set_design_data curelevation $elevvar ]
    pack $felev.set -side left -anchor nw
}

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 ]
    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 ]
    }
    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 ]
    }
}

# 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 } {
    global curfid

    set newval [ set_design_data $type $val ]
#    set $type $newval
    set dframe .design.design
    if { $type == "curttype" } {
	$dframe.fterrain.canvas.fg replace imf [ t_image_name $newval ]
	$dframe.fterrain.fg configure -text [ ttype_name $newval ]
    } elseif { $type == "curbgttype" } {
	$dframe.fterrain.canvas.bg replace imf [ t_image_name $newval ]
	$dframe.fterrain.bg configure -text [ ttype_name $newval ]
    } elseif { $type == "curutype" } {
	$dframe.funit.canvas.samp replace imf [ u_image_name $newval ]
	$dframe.funit.type configure -text [ utype_name $newval ]
    } elseif { $type == "curusidenumber" } {
	$dframe.funit.side configure -text [ side_adjective $newval ]
    } elseif { $type == "curpeoplenumber" } {
	$dframe.fpeople.canvas.people replace imf [ side_emblem $newval ]
	$dframe.fpeople.people configure -text [ side_name $newval ]
    } elseif { $type == "curcontrolnumber" } {
	$dframe.fcontrol.canvas.control replace imf [ side_emblem $newval ]
	$dframe.fcontrol.control configure -text [ side_name $newval ]
    } elseif { $type == "curfid" } {
	$dframe.ffeature.name configure -text [ feature_name $newval ]
	# The current feature appears in a different color, so the
	# map needs to be updated.
	execute_long_command "refresh"
	set curfid $newval
    } elseif { $type == "curwinddir" } {
    } elseif { $type == "curwindforce" } {
    } elseif { $type == "curbrushradius" } {
	.design.dbuttons.brush configure -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
    } elseif { $type == "unit" } {
	dbg_set_design_data curutype $dir
    } elseif { $type == "people" } {
	dbg_set_design_data curpeoplenumber $dir
    } elseif { $type == "control" } {
	dbg_set_design_data curcontrolnumber $dir
    } elseif { $type == "feature" } {
	dbg_set_design_data curfid $dir
    } elseif { $type == "brush" } {
	dbg_set_design_data curbrushradius $dir
    }
}

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

set rename_name ""
set rename_done 0

proc rename_feature { fid } {
    global rename_name rename_done

    toplevel .frename
    wm title .frename "Xconq Feature Rename"

    message .frename.msg -text "New name for feature:"
    set rename_name [ feature_name $fid ]
    entry .frename.name -textvariable rename_name

    set b [ frame .frename.buttons ]
    pack .frename.msg .frename.name .frename.buttons -side top -fill x
    button $b.ok -text "OK" -width 6 \
	    -command { set rename_done 1 }
    button $b.cancel -text "Cancel" -width 6 \
	    -command { set rename_done 0 }
    pack $b.ok -side left
    pack $b.cancel -side right

    focus .frename
    tkwait visibility .frename
    grab .frename
    tkwait variable rename_done
    grab release .frename
    destroy .frename

    if { $rename_done } {
	#    set_feature_type_name $fid $rename_typename
	set_feature_name $fid $rename_name
	# (should update name in design menu)
    }
}

set dsave_done 0

set dsave_types 0
set dsave_tables 0
set dsave_globals 0
set dsave_world 0
set dsave_area 0
set dsave_terrain 0
set dsave_weather 0
set dsave_material 0
set dsave_sides 0
set dsave_sidenames 0
set dsave_sideprops 0
set dsave_views 0
set dsave_docts 0
set dsave_units 0
set dsave_ 0

proc popup_designer_save {} {
    global 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 "game-data.g"
    pack .dsave.top.modulelabel .dsave.top.modulename -side left

    checkbutton .dsave.types -text "Types" -variable dsave_types
    checkbutton .dsave.tables -text "Tables" -variable dsave_tables
    checkbutton .dsave.globals -text "Globals" -variable dsave_globals
    pack .dsave.types .dsave.tables .dsave.globals -side top

    checkbutton .dsave.world -text "World" -variable dsave_world
    pack .dsave.world -side top

    checkbutton .dsave.area -text "Area" -variable dsave_area
    checkbutton .dsave.terrain -text "Area Terrain" -variable dsave_terrain
    checkbutton .dsave.weather -text "Area Weather" -variable dsave_weather
    checkbutton .dsave.material -text "Area Material" -variable dsave_material
    pack .dsave.area .dsave.terrain .dsave.weather .dsave.material -side top

    checkbutton .dsave.sides -text "Sides" -variable dsave_sides
    checkbutton .dsave.sidenames -text "Side Names" -variable dsave_sidenames
    checkbutton .dsave.sideproperties -text "Side Properties" -variable dsave_sideprops
    checkbutton .dsave.sideviews -text "Side Views" -variable dsave_views
    checkbutton .dsave.sidedoctrines -text "Side Doctrines" -variable dsave_docts
    pack .dsave.sides .dsave.sidenames .dsave.sideproperties .dsave.sideviews .dsave.sidedoctrines -side top

    checkbutton .dsave.units -text "Units" -variable dsave_units
    pack .dsave.units -side top

    frame .dsave.bottom -height 40 -width 40 -bg blue
    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 }
#    pack .dsave.bottom.save .dsave.bottom.cancel -side left
    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_done
    global dsave_types dsave_tables dsave_globals
    global dsave_world dsave_area dsave_terrain dsave_weather dsave_material
    global dsave_sides dsave_sidenames dsave_sideprops dsave_views dsave_docts
    global dsave_units

    set args ""
    if { $dsave_types } { set args " types $args" }
    if { $dsave_tables } { set args " tables $args" }
    if { $dsave_globals } { set args " globals $args" }
    if { $dsave_world } { set args " world $args" }
    if { $dsave_area } { set args " area $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_sidenames } { set args " sidenames $args" }
    if { $dsave_sideprops } { set args " sideprops $args" }
    if { $dsave_views } { set args " views $args" }
    if { $dsave_docts } { set args " docts $args" }
    if { $dsave_units } { set args " units $args" }
    designer_save [ .dsave.top.modulename get ] $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 10 -height 10 -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 2 -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 2 -relief sunken
    place $win.botside -in $win -relx 0 -rely 1.0 \
	    -relwidth 1 -relheight $bottomratio -anchor sw

    frame $win.grip -width 10 -height 10 -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 { 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 } {
		.m1.rightside.worldf.world config -power $newpow
		set last_world_width $w
		set last_world_power $newpow
	    }
	}
    }
}

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 ""
}
