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

set lineheight 5

set list_icon_size 32

set dblbuffer 1

set designer 0

set dside 0

set all_see_all 0
set may_set_see_all 0

set handling_key 0

set curunit 0

set debug 1

if { $debug == 1 } {
    set dblbuffer 0
}

# 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 == 1 } {
	.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 { puts stdout "connect_dialog not implemented yet" }
    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 imagebase "../../xc7.2.x"
    set splashname [ file join $imagebase "images" "splash.gif" ]
    if { !"[ file exists $splashname ]" } {
	set imagebase "/usr/local/lib/xconqdir"
	set splashname [ file join $imagebase "images" "splash.gif" ]
    }
    # Only try to create the image if we found the file.
    if { "[ file exists $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
    # We won't be needing the third button again.
    .newgame.bottom.b3 config -text "" -state disabled -borderwidth 0
}

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

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
    }

    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
}

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

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 260 5 -tag advantage -anchor ne -text ""
	set bgcolor [ $sp_entry cget -background ]
	imfsample $sp_entry.emblem -width 16 -height 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" -state disabled -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 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

    # 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
    }
    set selected_player $newsel
    set sp_entry .newgame.top.f1.f11.c.f2.s$selected_player
    $sp_entry itemconfig outline -width 4 -outline black
    # Enable/disable advantage adjustment.
    set side [ assigned_side $selected_player ]
    set player [ assigned_player $selected_player ]
    if { "[ player_advantage $player ]" < "[ max_advantage $side ]"} {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.aplus config -state $state
    if { "[ player_advantage $player ]" > "[ min_advantage $side ]"} {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.aminus config -state $state
    if { "[ can_rename $side ]" } {
	set state active
    } else {
	set state disabled
    }
    .newgame.top.plbuttons.rename 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
    }
}

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

# 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 lineheight
    global list_icon_size
    global dblbuffer
    global dside

    set textfont fixed
#{-size 12}
    set boldfont fixed
#{-size 12 -weight bold}
    set asc [ font metrics $textfont -ascent ]
    set dsc [ font metrics $textfont -descent ]
    set lineheight [ expr $asc + $dsc + 1 ]

    set nums [ numsides ]
    set numu [ numutypes ]

    set mapn 1
    set map .m$mapn

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

    # 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

    set leftratio 0.75

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

    frame $map.leftside.top
    pack $map.leftside.top -side top -fill x

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

    set noteheight [ expr int(0.20 * $mainhgt) / $lineheight ]

    text $map.leftside.top.notices.t -height $noteheight -font $textfont \
	    -yscrollcommand "$map.leftside.top.notices.yscroll set"
    scrollbar $map.leftside.top.notices.yscroll -orient vert \
	    -command "$map.leftside.top.notices.t yview"
    pack $map.leftside.top.notices.yscroll -side right -fill y
    pack $map.leftside.top.notices.t -side left -fill both -expand true

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

    button $map.leftside.buttons.move -bitmap shoot_cursor \
	    -width 24 -height 24 \
	    -command { execute_long_command "survey" }
    pack $map.leftside.buttons.move -side top
    button $map.leftside.buttons.survey -bitmap looking_glass \
	    -width 24 -height 24 \
	    -command { execute_long_command "survey" }
    pack $map.leftside.buttons.survey -side top
    button $map.leftside.buttons.build -bitmap build \
	    -width 24 -height 24 \
	    -command { execute_long_command "produce-unit" }
    pack $map.leftside.buttons.build -side top
    button $map.leftside.buttons.zoomin -bitmap closer \
	    -width 24 -height 24 \
	    -command { execute_long_command "zoom-in" }
    pack $map.leftside.buttons.zoomin -side top
    button $map.leftside.buttons.zoomout -bitmap farther \
	    -width 24 -height 24 \
	    -command { execute_long_command "zoom-out" }
    pack $map.leftside.buttons.zoomout -side top

    text $map.leftside.mouseover -height 1 -font $textfont
    pack $map.leftside.mouseover -side top -fill x

    frame $map.leftside.uf
    pack $map.leftside.uf -side top -fill x
    
    canvas $map.leftside.uf.unitinfo \
	    -height [ expr 6 * $lineheight ] -width 2000 \
	    -borderwidth 2 -relief sunken
    pack $map.leftside.uf.unitinfo -side left -fill y -expand true

    frame $map.leftside.mapf
    pack $map.leftside.mapf -side bottom -fill x

    map $map.leftside.mapf.map -power 5 -dbl $dblbuffer
    scrollbar $map.leftside.mapf.xscroll -orient horiz \
	    -command "$map.leftside.mapf.map xview"
    scrollbar $map.leftside.mapf.yscroll -orient vert \
	    -command "$map.leftside.mapf.map yview"
    grid $map.leftside.mapf.map $map.leftside.mapf.yscroll -sticky news
    grid $map.leftside.mapf.xscroll -sticky ew
    grid rowconfigure $map.leftside.mapf 0 -weight 1
    grid columnconfigure $map.leftside.mapf 0 -weight 1

    set rightratio [ expr 1.0 - $leftratio ]
    set rightwid [ expr $rightratio * $mainwid ]

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

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

    canvas $map.rightside.turnf.turn -height 20
    pack $map.rightside.turnf.turn -side top -fill x -expand true

    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 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"
    scrollbar $map.rightside.gamef.yscroll -orient vert \
	    -command "$map.rightside.gamef.game yview"
    pack $map.rightside.gamef.yscroll -side right -fill y
    pack $map.rightside.gamef.game -side left -fill both -expand true

    frame $map.rightside.worldf -borderwidth 2 -relief sunken
    pack $map.rightside.worldf -side bottom -fill both -expand true

    map $map.rightside.worldf.world -world 1 -width $rightwid -dbl $dblbuffer
    pack $map.rightside.worldf.world -side top -fill both -expand true

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

    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"
    scrollbar $map.rightside.listf.yscroll -orient vert \
	    -command "$map.rightside.listf.unitlist yview"
    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.top.notices.t insert end " " notices
    $map.leftside.top.notices.t insert end " " prefix
    $map.leftside.top.notices.t insert end " " prompt
    $map.leftside.top.notices.t insert end " " answer
    # Make the user interaction things stand out more.
    $map.leftside.top.notices.t tag configure prefix -font $boldfont
    $map.leftside.top.notices.t tag configure prompt -font $boldfont
    $map.leftside.top.notices.t tag configure answer -font $boldfont

    set col1 6
    set col2 250
    set ypos [ expr 2 + $lineheight ]
    set unitinfo $map.leftside.uf.unitinfo 
    $unitinfo create text $col1 $ypos -tag handle -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag hp -anchor sw -font $textfont
    incr ypos $lineheight
    $unitinfo create text $col1 $ypos -tag loc -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag stack -anchor sw -font $textfont
    incr ypos $lineheight
    $unitinfo create text $col1 $ypos -tag occ -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag s0 -anchor sw -font $textfont
    incr ypos $lineheight
    $unitinfo create text $col1 $ypos -tag plan -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag s1 -anchor sw -font $textfont
    incr ypos $lineheight
    $unitinfo create text $col1 $ypos -tag t0 -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag s2 -anchor sw -font $textfont
    incr ypos $lineheight
    $unitinfo create text $col1 $ypos -tag t1 -anchor sw -font $textfont
    $unitinfo create text $col2 $ypos -tag s3 -anchor sw -font $textfont

    set turnpane $map.rightside.turnf.turn
    $turnpane create text 24 [ expr $lineheight + 2 ] -tag the_date -anchor sw -font $textfont

    set gamepane $map.rightside.gamef.game

    set bgcolor [ $gamepane 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 } {
	    $gamepane create line 0 $sy 400 $sy -fill gray
	}
	imfsample $gamepane.e$i -width 16 -height 16 -bg $bgcolor
	$gamepane.e$i add imf [ side_emblem $i ]
	$gamepane create window 4 [ expr $sy + 4 ] -window $gamepane.e$i \
		-anchor nw
	$gamepane create text 24 $tsy -tag s$i -anchor sw -font $textfont
	# (should make conditional on liveness of side)
	$gamepane create rect 23 $rtop 125 $rbot -tag frame$i
	$gamepane create rect 24 [ expr $rtop + 1 ] 24 $rbot -tag left$i \
		-fill "dark blue" -outline ""
	$gamepane create rect 24 [ expr $rtop + 1 ] 24 $rbot -tag resv$i \
		-fill gray -outline ""
	$gamepane create text 24 $scy -tag score0_$i -text sc0_$i -anchor sw -font $textfont
	# Start the loss line and victory laurels offscreen. 
	$gamepane create line 400 $msy 1600 $msy -tag lost$i -fill black
	$gamepane create bitmap 400 [ expr $sy + 22 ] -bitmap laurels -tag won$i -anchor nw
	incr sy $game_entry_height
    }

    set dside [ dside ]

    $gamepane itemconfigure s$dside -font $boldfont

    set unitlist $map.rightside.listf.unitlist
    $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
    for { set i 0 } { $i < $numu } { incr i } {
	# (should filter out or diminish entries for unavailable types)
	# 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
	$unitlist.u$i add imf [ u_image_name $i ]
	$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
	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
    }

    make_normal_bindings $map
}

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

set map_grid 1
set map_coverage 0
set map_people 0
set map_control 0
set map_elev 0
set map_lighting 1
set map_temp 0
set map_winds 0
set map_unit_names 0
set map_feature_names 0
set map_feature_boundaries 0
set map_meridians 0
set map_see_all 0
set map_transitions 0
set map_terrain_style 1
set map_unit_style 0

proc create_map_menus { map } {
    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..." -state disabled
    $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
    $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 "occupant" }
    $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 "Selected" -state disabled

    $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 Occupants" -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 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 command -label "Set Mag" -state disabled
    $map.menubar.view add separator
    $map.menubar.view add check -label "Grid" \
	    -command { execute_long_command "map grid" } \
	    -variable map_grid -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Coverage" \
	    -command { execute_long_command "map cover" } \
	    -variable map_coverage -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Elevations" \
	    -command { execute_long_command "map elevations" } \
	    -variable map_elev -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Day/Night" \
	    -command { execute_long_command "map lighting" } \
	    -variable map_lighting -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "People" \
	    -command { execute_long_command "map people" } \
	    -variable map_people -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Control" \
	    -command { execute_long_command "map control" } \
	    -variable map_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 "Temperature" \
	    -command { execute_long_command "map temperature" } \
	    -variable map_temp -offvalue 0 -onvalue 1
    $map.menubar.view.weather add check -label "Winds" \
	    -command { execute_long_command "map winds" } \
	    -variable map_winds -offvalue 0 -onvalue 1
    $map.menubar.view.weather add check -label "Clouds" \
	    -command { execute_long_command "map clouds" } \
	    -variable map_clouds -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Unit Names" \
	    -command { execute_long_command "map unames" } \
	    -variable map_unit_names -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Feature Names" \
	    -command { execute_long_command "map fnames" } \
	    -variable map_feature_names -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Feature Boundaries" \
	    -command { execute_long_command "map fboundaries" } \
	    -variable map_feature_boundaries -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "Meridians" \
	    -command { execute_long_command "map meridians" } \
	    -variable map_meridians -offvalue 0 -onvalue 1
    $map.menubar.view add check -label "See All" \
	    -command { execute_long_command "map seeall" } \
	    -variable map_see_all -offvalue 0 -onvalue 1
    $map.menubar.view add cascade -label "Terrain Style" \
	    -menu $map.menubar.view.tstyle
    menu $map.menubar.view.tstyle
    $map.menubar.view.tstyle add check -label "Transitions" \
	    -command { execute_long_command "map transitions" } \
	    -variable map_transitions -offvalue 0 -onvalue 1
    $map.menubar.view.tstyle add radio -label "Solid Colors" \
	    -command { execute_long_command "map tstyle-solid" } \
	    -variable map_terrain_style -value 0
    $map.menubar.view.tstyle add radio -label "Patterns" \
	    -command { execute_long_command "map tstyle-pattern" } \
	    -variable map_terrain_style -value 1
    $map.menubar.view.tstyle add radio -label "Images" -state disabled \
	    -command { execute_long_command "map tstyle-image" } \
	    -variable map_terrain_style -value 2
    $map.menubar.view add cascade -label "Unit Style" \
	    -menu $map.menubar.view.ustyle
    menu $map.menubar.view.ustyle
    $map.menubar.view.ustyle add radio -label "Color" \
	    -command { execute_long_command "map unit-color" } \
	    -variable map_unit_style -value 0
    $map.menubar.view.ustyle add radio -label "Silhouette" \
	    -command { execute_long_command "map unit-silhouette" } \
	    -variable map_unit_style -value 1

    adjust_view_menu $map
}

proc adjust_play_menu { map } {
    global curunit

    adjust_menu_entry $map play "Move To" $curunit
    adjust_menu_entry $map play "Return" $curunit
    adjust_menu_entry $map play "Set Formation" $curunit
    adjust_menu_entry $map play "Wake" $curunit
    adjust_menu_entry $map play "Wake Occupants" $curunit
    adjust_menu_entry $map play "Sleep" $curunit
    adjust_menu_entry $map play "Reserve" $curunit
    adjust_menu_entry $map play "Idle" $curunit
    adjust_menu_entry $map play "Delay" $curunit
    adjust_menu_entry $map play "Build" $curunit
    adjust_menu_entry $map play "Repair" $curunit
    adjust_menu_entry $map play "Attack" $curunit
    adjust_menu_entry $map play "Overrun" $curunit
    adjust_menu_entry $map play "Fire" $curunit
    adjust_menu_entry $map play "Fire Into" $curunit
    adjust_menu_entry $map play "Detonate" $curunit
}

proc adjust_more_menu { map } {
    global curunit

    adjust_menu_entry $map more "Give" $curunit
    adjust_menu_entry $map more "Take" $curunit
    adjust_menu_entry $map more "Embark" $curunit
    adjust_menu_entry $map more "Disembark" $curunit
    adjust_menu_entry $map more "Detach" $curunit
    adjust_menu_entry $map more "Disband" $curunit
    adjust_menu_entry $map more "Plan Type" $curunit
    adjust_menu_entry $map more "AI Control" $curunit
    adjust_menu_entry $map more "Rename..." $curunit
    adjust_menu_entry $map more "Give Unit" $curunit
}

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

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

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

    bind $map.leftside.mapf.map <ButtonPress> { mouse_down_cmd %x %y %b }
    bind $map.leftside.mapf.map <ButtonRelease> { mouse_up_cmd %x %y %b }
    bind $map.leftside.mapf.map <Motion> { mouse_over_cmd %x %y }
    bind $map.leftside.mapf.map <Leave> { mouse_over_cmd -1 -1 }

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

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

proc handle_key_binding { str win x y } {
    global handling_key

    set handling_key 1
    set prefix [ interp_key "$str" $x $y ]
    .m1.leftside.top.notices.t delete prefix.first "prefix.last - 1 chars"
    if { "$prefix" >= 0 } {
	.m1.leftside.top.notices.t insert prefix.first ":" prefix
	.m1.leftside.top.notices.t insert prefix.first $prefix prefix
    }
    set handling_key 0
}

proc run_game_cmd {} {
    set interval [ run_game 5 ]
    after $interval 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
}

# Update routines called from C code.

proc update_game_state { str } {
    .m1.rightside.turnf.turn itemconfigure the_date -text $str
}

proc update_game_side_info { s str everingame ingame status } {
    set gamepane .m1.rightside.gamef.game
    $gamepane itemconfigure s$s -text $str
    if { !$everingame } {
	$gamepane itemconfigure s$s -fill gray
	$gamepane itemconfigure frame$s -fill gray
    }
    if { !$ingame } {
    }
    if { $status > 0 } {
	# Find the the victory laurels and move into visibility.
	set lis [ $gamepane coords won$s ]
	set xval [ lindex $lis 0 ]
	if { $xval > 4 } {
	    $gamepane move won$s [expr 4 - $xval ] 0
	    $gamepane raise won$s above all
	}
    }
    if { $status < 0 } {
	# Find the the loss line and move into visibility.
	set lis [ $gamepane coords lost$s ]
	set xval [ lindex $lis 0 ]
	if { $xval > 0 } {
	    $gamepane move lost$s [expr 0 - $xval ] 0
	    $gamepane raise lost$s above all
	}
    }
}

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 sy [ expr ($s - 1) * (2 * $lineheight + 20) ]
    set tsy [ expr $sy + $lineheight ]
    set rtop [ expr $sy + $lineheight + 4 + 1 ]
    set rbot [ expr $sy + $lineheight + 12 ]
    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_unitlist_name { u str } {
    .m1.rightside.listf.unitlist itemconfigure u$u -text $str
}

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

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

proc update_unit_info { tag str } {
    global curunit

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

# Update the appearance of any zoom controls.

proc update_zoom { closer farther } {
    if { $closer != 0 } {
	set newstate normal
    } else {
	set newstate disabled
    }
    .m1.menubar.view entryconfigure "Closer" -state $newstate
    .m1.leftside.buttons.zoomin configure -state $newstate
    if { $farther != 0 } {
	set newstate normal
    } else {
	set newstate disabled
    }
    .m1.menubar.view entryconfigure "Farther" -state $newstate
    .m1.leftside.buttons.zoomout configure -state $newstate
}

# Update the appearance of any mode controls/displays.

proc update_mode { mode } {
    global map_survey

    if { "$mode" == "survey" } {
	set map_survey 1
	.m1.leftside.buttons.move configure -relief raised
	.m1.leftside.buttons.survey configure -relief sunken
    } elseif { "$mode" == "move" } {
	set map_survey 0
	.m1.leftside.buttons.move configure -relief sunken
	.m1.leftside.buttons.survey configure -relief raised
    } else {
	puts stdout "?mode?"
    }
    update idletasks
}

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

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

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

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

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.top.notices.t insert notices.last $str notices
    # (should only do if already scrolled to end of notices)
    .m1.leftside.top.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.top.notices.t insert prompt.first \
		"$str \[$dfltstr\]" prompt
	# (should only do if already scrolled to end of notices)
	.m1.leftside.top.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.top.notices.t insert prompt.first "$str" prompt
    .m1.leftside.mapf.map config -cursor cross
    # (should only do if already scrolled to end of notices)
    .m1.leftside.top.notices.t yview moveto 1.0
}

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

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

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

proc select_unit_type { u } {
    set color [ .m1.rightside.listf.unitlist itemcget rect$u -outline ]
    if { "$color" == "black" } {
	set_unit_type $u
	# Arguments are dummies, this is effecttively 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.top.notices.t insert prompt.first "$str" prompt
    # (should only do if already scrolled to end of notices)
    .m1.leftside.top.notices.t yview moveto 1.0
}

proc ask_terrain_type_done {} {
    clear_command_line
}

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

proc update_string_mode { answer } {
    .m1.leftside.top.notices.t delete "answer.first + 1 chars" answer.last
    .m1.leftside.top.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.top.notices.t insert prompt.first "$str" prompt
    .m1.leftside.top.notices.t insert "answer.first + 1 chars" "$dflt" answer
    # (should only do if already scrolled to end of notices)
    .m1.leftside.top.notices.t yview moveto 1.0
}

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

proc ask_side_done {} {
    clear_command_line
}

proc clear_command_line {} {
    .m1.leftside.top.notices.t delete prompt.first "prompt.last - 1 chars"
    .m1.leftside.top.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"

    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

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

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

    # 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"
    pack .agreements.bot.new -side left
    button .agreements.bot.circulate -text "Circulate"
    pack .agreements.bot.circulate -side left
    button .agreements.bot.propose -text "Propose"
    pack .agreements.bot.propose -side left
    button .agreements.bot.sign -text "Sign"
    pack .agreements.bot.sign -side left
    button .agreements.bot.withdraw -text "Withdraw"
    pack .agreements.bot.withdraw -side left
    button .agreements.bot.done -text "Done"
    pack .agreements.bot.done -side left
}

# Create and popup the help window.

proc create_help_window {} {
    set textfont {-size 12}

    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
}

# Designer support.

set selected_design_tool normal

set last_dbutton .m1.leftside.dbuttons.normal
set last_frame .m1.leftside.uf.design.fnormal

proc popup_design_palette {} {
    if { "[ winfo exists .m1.leftside.dbuttons ]" == 0 } {
	# Create a new frame for the design buttons.
	frame .m1.leftside.dbuttons

	button .m1.leftside.dbuttons.normal -text "n" -width 1 -height 1 \
		-command { select_paint normal make_normal_frame }
	pack .m1.leftside.dbuttons.normal -side top

	button .m1.leftside.dbuttons.terrain -text "t" -width 1 -height 1 \
		-command { select_paint terrain make_terrain_paint_frame }
	pack .m1.leftside.dbuttons.terrain -side top

	button .m1.leftside.dbuttons.unit -text "u" -width 1 -height 1 \
		-command { select_paint unit make_unit_paint_frame }
	pack .m1.leftside.dbuttons.unit -side top

	button .m1.leftside.dbuttons.people -text "p" -width 1 -height 1 \
		-command { select_paint people make_people_paint_frame }
	pack .m1.leftside.dbuttons.people -side top

	button .m1.leftside.dbuttons.control -text "c" -width 1 -height 1 \
		-command { select_paint control make_control_paint_frame }
	pack .m1.leftside.dbuttons.control -side top

	button .m1.leftside.dbuttons.feature -text "f" -width 1 -height 1 \
		-command { select_paint feature make_feature_paint_frame }
	pack .m1.leftside.dbuttons.feature -side top

	button .m1.leftside.dbuttons.material -text "m" -width 1 -height 1 \
		-command { select_paint material make_material_paint_frame }
	pack .m1.leftside.dbuttons.material -side top

	button .m1.leftside.dbuttons.elev -text "e" -width 1 -height 1 \
		-command { select_paint elevation make_elev_paint_frame }
	pack .m1.leftside.dbuttons.elev -side top

	button .m1.leftside.dbuttons.temp -text "T" -width 1 -height 1 \
		-command { select_paint temperature make_temp_paint_frame }
	pack .m1.leftside.dbuttons.temp -side top

	button .m1.leftside.dbuttons.clouds -text "C" -width 1 -height 1 \
		-command { select_paint clouds make_clouds_paint_frame }
	pack .m1.leftside.dbuttons.clouds -side top

	button .m1.leftside.dbuttons.winds -text "W" -width 1 -height 1 \
		-command { select_paint winds make_winds_paint_frame }
	pack .m1.leftside.dbuttons.winds -side top

	menubutton .m1.leftside.dbuttons.brush -text "0" -width 1 -height 1 \
		-background white -borderwidth 2 -relief raised \
		-menu .m1.leftside.dbuttons.brush.menu
	pack .m1.leftside.dbuttons.brush -side top
	menu .m1.leftside.dbuttons.brush.menu -tearoff 0
	for { set i 0 } { $i < 11 } { incr i } {
	    .m1.leftside.dbuttons.brush.menu add command -label "$i" \
		    -command [ list dbg_set_design_data curbrushradius $i ]
	}

	# Create the frame that will enclose info about painting.
	frame .m1.leftside.uf.design -width 150 -height 70 \
		-borderwidth 2 -relief sunken
    }
    # Make the frames appear in the map, squeezed in between other things.
    pack .m1.leftside.dbuttons -side left -fill y -after .m1.leftside.buttons
    pack .m1.leftside.uf.design -side left -fill y \
	    -before .m1.leftside.uf.unitinfo
    pack propagate .m1.leftside.uf.design false
    select_paint normal make_normal_frame
    update idletasks
}

proc select_paint { type maker } {
    global last_dbutton
    global last_frame

    $last_dbutton configure -relief raised
    .m1.leftside.dbuttons.$type configure -relief sunken
    set last_dbutton .m1.leftside.dbuttons.$type
    if { "[ winfo exists $last_frame ]" == 1 } {
	pack forget $last_frame
    }
    set fframe .m1.leftside.uf.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 "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 "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 "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 ]
}

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

    label $fcontrol.label -text "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 ]
}

proc make_feature_paint_frame { ffeature } {
    set numf [ numfeatures ]

    label $ffeature.label -text "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 1 }
    pack $ffeature.new $ffeature.rename -side left -anchor nw
}

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

proc make_elev_paint_frame { felev } {
    label $felev.label -text "Elev"
    pack $felev.label -side top -fill x

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

proc make_temp_paint_frame { ftemp } {
    label $ftemp.label -text "Temp"
    pack $ftemp.label -side top -fill x

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

proc make_clouds_paint_frame { fclouds } {
    label $fclouds.label -text "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 "Winds"
    pack $fwinds.label -side top -fill x

    entry $fwinds.fentry -textvariable windfvar
    pack $fwinds.fentry
    entry $fwinds.dentry -textvariable winddvar
    pack $fwinds.dentry
}

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

proc dismiss_design_palette {} {
    pack forget .m1.leftside.dbuttons
    pack forget .m1.leftside.uf.design
}

proc select_design_tool { name } {
    global selected_design_tool

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

proc dbg_set_design_data { type val } {
    set newval [ set_design_data $type $val ]
    set $type $newval
    set dframe .m1.leftside.uf.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 ]
    } elseif { $type == "curbrushradius" } {
	.m1.leftside.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 ]
    dbg_set_design_data curfid $fid
    rename_feature $fid
}

set rename_name ""
set rename_done 0

proc rename_feature { fid } {
    global rename_name

    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 \
	    -command { set rename_done 1 }
    button $b.cancel -text Cancel \
	    -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

#    set_feature_type_name $fid $rename_typename
    set_feature_name $fid $rename_name
}

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
}
