#!/bin/sh
# the next line restarts using wish \
exec wish8.0 "$0" "$@"

# Copyright (C) 1998-2000 by Udo Munk (um@compuserve.com)
#
# Permission to use, copy, modify, and distribute this software
# and its documentation for any purpose and without fee is
# hereby granted, provided that the above copyright notice
# appears in all copies and that both that copyright notice and
# this permission notice appear in supporting documentation.
# The author and contibutors make no representations about the
# suitability of this software for any purpose. It is provided
# "as is" without express or implied warranty.
#
# Credit is due to Brent B. Welch, some of the ideas and procedures
# in this project were taken from his book "Practical Programming
# in Tcl and Tk", published by Prentice Hall.
#
# This program requires Tk 8.0 at least.

# ========================================================================
#                       Global Variables
# ========================================================================

# You might want to adjust this, special for platforms other than
# UNIX and Windows.
if { [string compare $tcl_platform(platform) unix] == 0 } {
	set cadconf(confdir) "/usr/local/lib/tkwadcad"
} elseif { [string compare $tcl_platform(platform) windows] == 0 } {
	set cadconf(confdir) "//c/lib/tkwadcad"
} else {
	set cadconf(confdir) ""
}

# ------------- no configuration necessary below this line ---------------

# will hold the size of the root window
set winsize(x) 0
set winsize(y) 0

# arrays used by procedures
set canvas() {}
set compile() {}
set run() {}
set enginelist() {}
set dialog() {}
set balloon() {}
set editsec() {}
set editsectype() {}
set sectypelist() {}
set flatslist() {}
set editline() {}
set editldeftype() {}
set ldeftypelist() {}
set lspecial() {}
set linepastebuf() {}
set connline() {}
set editthing() {}
set thinglist() {}
set thingpastebuf() {}
set editwtex() {}
set wtexlist() {}
set addroom() {}
set addobject() {}

# object info
set objinfo(info) ""
set objinfo(x) ""
set objinfo(y) ""

# initial grid size
set grid 64

# initial scale for the drawing canvas
set scale 1.0

# The min and max coordinates we use for maps. WAD engines use signed 16bit
# shorts for the world coordinates, don't know which size really can be
# handled. We can increase the possible map size here anyway...
set min_x [expr -192 * 64]
set min_y [expr -192 * 64]
set max_x [expr 192 * 64]
set max_y [expr 192 * 64]

# default configuration
if { [string compare $tcl_platform(platform) unix] == 0 } {
    set cadconf(shell) "/bin/sh"
} elseif { [string compare $tcl_platform(platform) windows] == 0 } {
    set cadconf(shell) "//c/bin/sh"
} else {
    set cadconf(shell) ""
}
set cadconf(doomconfdir) [file join $cadconf(confdir) "doom"]
set cadconf(doom2confdir) [file join $cadconf(confdir) "doom2"]
set cadconf(xdoomconfdir) [file join $cadconf(confdir) "xdoom"]
set cadconf(xdoomplusconfdir) [file join $cadconf(confdir) "xdoomplus"]
set cadconf(hexenconfdir) [file join $cadconf(confdir) "hexen"]
set cadconf(scriptdir) [file join $cadconf(confdir) "scripts"]
set cadconf(libdir) [file join $cadconf(confdir) "lib"]
set cadconf(bspcompilescript) "wadcompilebsp.sh"
set cadconf(idbspcompilescript) "wadcompileidbsp.sh"
set cadconf(warmcompilescript) "wadcompilewarm.sh"
set cadconf(makescript) "wadmake.sh"
set cadconf(sectypelist) "sectors.lst"
set cadconf(ldeftypelist) "linedefs.lst"
set cadconf(ldefpicker) PickLdefTypeDoom
set cadconf(thinglist) "things.lst"
set cadconf(wtexlist) "textures.lst"
set cadconf(ltexlist) ".textures"
set cadconf(flatslist) "flats.lst"
set cadconf(enginelist) "engines.lst"
set cadconf(doom) "Doom"
set cadconf(doom2) "Doom2"
set cadconf(xdoom) "XDoom"
set cadconf(xdoomplus) "XDoomPlus"
set cadconf(hexen) "Hexen"
set cadconf(defaultthing) 2014
set cadconf(defsecfloor) "FLOOR0_3"
set cadconf(defsecceil) "FLAT2"
set cadconf(wtex_gamma) 1.0
set cadconf(flat_gamma) 1.0
set cadconf(sprite_gamma) 1.0
set cadconf(def_room_width) 256
set cadconf(def_room_height) 256
set cadconf(def_texture) "GRAY4"
set cadconf(def_obj_width) 64
set cadconf(def_obj_height) 64

# default options
set options(node_builder) 1
set options(pref_doom) "wadrun_xdoom.sh"
set options(pref_hexen) "wadrun_lxhexen.sh"
set options(runscript) $options(pref_doom)
set options(nomonsters) 0
set options(devparm) 1
set options(nomusic) 1
set options(skill) 3
set options(fontsize) 12
set options(gridsnap) 1
set options(thingimg) 1
set options(textureimg) 1
set options(show_things) 1
set options(show_vertices) 0
set options(show_arrows) 0

# all informations needed for a map
set mapinfo(game) $cadconf(doom2)
set mapinfo(map_std) "Standard"
set mapinfo(map_ext) "Extended"
set mapinfo(maptype) $mapinfo(map_std)
set mapinfo(bg_doom) "#a76b6b"
set mapinfo(bg_hexen) "#ffffff"
set mapinfo(bg) $mapinfo(bg_doom)
set mapinfo(mapdir) [pwd]
set mapinfo(mapfile) ""
set mapinfo(episode) 0
set mapinfo(map) 1
set mapinfo(min_x) 0
set mapinfo(min_y) 0
set mapinfo(max_x) 0
set mapinfo(max_y) 0
set mapinfo(no_ldeftypes) 0

# the data which makes up the map
set mapdata(modified) 0
set mapdata(modstat) "N"
set mapdata(no_vertices) 0
set mapdata(no_lines) 0
set mapdata(no_sdefs) 0
set mapdata(no_sectors) 0
set mapdata(no_things) 0
set mapdata(max_sector_tags) 32767
set mapdata(max_things) 32767
set mapdata(max_thing_tids) 255
set mapdata(max_vertices) 32766
set mapdata(max_sectors) [expr round($mapdata(max_vertices) / 3)]
set mapdata(max_lines) [expr $mapdata(max_vertices) / 2]
set vertices() {}
set lines() {}
set sectors() {}
set things() {}

# dialogs can call other dialogs, we need some stacks for focus and grab
set dialogstack(top) 0
set focusstack(top) 0

# we want better precision for math than the default!
set tcl_precision 17

# load packages
lappend auto_path $cadconf(libdir)
package require -exact WCHelp 1.2

# ========================================================================
#		Error dialogs
# ========================================================================

#
# While parsing a map file there was a problem with the syntax
#
proc MapParseError { s } {
  global mapinfo

  tk_messageBox -type ok -message $s -icon error -parent .
  set mapinfo(mapfile) ""
}

#
# Tried to edit something, but no map loaded
#
proc NoMapError {} {
  set s "No map loaded, load a map first or create a new one"
  tk_messageBox -type ok -message $s -icon error -parent .
}

#
# Tried to exit or run map without saving the modified map before
#
proc MapNsaveError {} {
  set s "The current map was modified! Save it first?"
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    WriteMap
    return 0
  }
  return 1
}

#
# Tried to edit non existent sector
#
proc NoSuchSecError { sec } {
  set s [format "Sector %s doesn't exist" $sec]
  tk_messageBox -type ok -message $s -icon error -parent .
}

#
# Tried to connect line to non existent vertex
#
proc NoVertexError { ver } {
  set s [format "Vertex %s doesn't exist" $ver]
  tk_messageBox -type ok -message $s -icon error -parent .
}

#
# Tried to create a zero lenght line, both vertices the same
#
proc ZeroLineError {} {
  set s "Tried to create a zero lenght line, both vertices are the same"
  tk_messageBox -type ok -message $s -icon error -parent .
}

#
# Sector reference checker found unknown sector type
#
proc SecInvalidTypeError { s t } {
  set s [format "Sector %s has unknown type %s, continue checking?" $s $t]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Sector reference checker found unreferenced sector
#
proc SecNoRefError { s } {
  set s [format "Sector %s is not referenced, continue checking?" $s]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Line reference checker found reference to non existing vertex
#
proc CheckVertexError { lin ver } {
  set s [format "Line %s references vertex %s, which doesn't exist! Continue checking?" $lin $ver]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}
  
#
# A line references a vertex, but the vertex doesn't reference the line
#
proc CheckVertexLrefError { lin ver } {
  set s [format "Line %s references vertex %s, but the vertex doesn't reference this line! This is most likely a bug in the program, it should be reported to the author! Proceed with caution! Continue checking?" $lin $ver]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# A linedef has an unknown linedef type
#
proc CheckInvalidLinetypeError { lin typ } {
  set s [format "Line %s has unknown type %s. Continue checking?" $lin $typ]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# A sector referenced in a sidedef doesn't exist
#
proc CheckSecrefError { line sec side } {
  set s [format "The %s sidedef of line %s references sector %s, which doesn't exist! Continue checking?" $side $line $sec]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Sector has a tag which isn't referenced by any linedef
#
proc SecTagRefError { sec tag } {
  set s [format "Sector %s has tag %s, which isn't referenced by any linedef! Continue checking?" $sec $tag]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Line has a tag which isn't referenced by any sector
#
proc LinTagRefError { lin tag } {
  set s [format "Line %s has tag %s, which isn't referenced by any sector! Continue checking?" $lin $tag]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Line has a tag, but type is 0
#
proc LinNoTypeError { lin tag } {
  set s [format "Line %s has tag %s, but no type. Continue checking?" $lin $tag]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Thing has unknown thing id
#
proc ThingIdError { t i } {
  set s [format "Thing %s has unknown type %d. Continue checking?" $t $i]
  set x [tk_messageBox -type yesno -message $s -icon warning -parent .]
  if { [string compare $x yes] == 0 } {
    return 0
  }
  return 1
}

#
# Tried to paste thing properties but no copy done before
#
proc ThingPasteError {} {
  set s "No thing properties copied, can't paste"
  tk_messageBox -type ok -message $s -icon error -parent .
}

#
# Tried to paste line properties but no copy done before
#
proc LinePasteError {} {
  set s "No line properties copied, can't paste"
  tk_messageBox -type ok -message $s -icon error -parent .
}

# ========================================================================
#		Custom dialogs
# ========================================================================

#
# Create a custom dialog in a toplevel window
#
proc Dialog_Create { top title args } {
  global dialog

  if [winfo exists $top] {
    switch -- [wm state $top] {
      normal {
	# raise a buried window
	raise $top
      }
      withdrawn -
      iconified {
	# open and restore geometry
	wm deiconify $top
	catch { wm geometry $top $dialog(geo,$top) }
      }
    }
    return 0
  } else {
    eval {toplevel $top} $args
    wm title $top $title
    wm transient $top .
    wm withdraw $top
    wm protocol $top WM_DELETE_WINDOW
    return 1
  }
}

#
# Set the dialog geometry and make the window visible
#
proc Dialog_Show { top } {
  update idletasks
  set x [expr [winfo screenwidth $top]/2 - [winfo reqwidth $top]/2 \
	   - [winfo vrootx [winfo parent $top]]]
  set y [expr [winfo screenheight $top]/2 - [winfo reqheight $top]/2 \
	   - [winfo vrooty [winfo parent $top]]]
  wm geom $top +$x+$y
  wm deiconify $top
  wm minsize $top [winfo width $top] [winfo height $top]
}

#
# Wait for custom dialog to complete
#
proc Dialog_Wait {top varName {focus {}}} {
  global dialog dialogstack focusstack

  upvar $varName var

  # poke the variable if the user nukes the window
  bind $top <Destroy> [list set $varName $var]

  # grab focus for the dialog
  if {[string length $focus] == 0} {
    set focus $top
  }
  Push focusstack [focus -displayof $top]
  Push dialogstack $top
  focus $focus
  catch {tkwait visibility $top}
  catch {grab $top}

  # wait for the dialog to complete
  tkwait variable $varName
  catch {grab release $top}
  focus [Pop focusstack]
  Pop dialogstack
  set x $dialogstack(top)
  if { $x > 0 } {
    catch {grab $dialogstack([expr $x - 1])}
  }
}

#
# Unmap a custom dialog window
#
proc Dialog_Dismiss {top} {
  global dialog

  # save current size and position
  catch {
    # window may have been deleted
    set dialog(geo,$top) [wm geometry $top]
    wm withdraw $top
  }
}

#
# Create a help balloon widget and display string in it
#
proc Create_Balloon {w x y s} {
  global balloon

  catch { destroy .balloon }
  toplevel .balloon -background black -borderwidth 1
  wm overrideredirect .balloon 1
  wm withdraw .balloon
  label .balloon.label -text " $s " -font widgets -background #feea3e \
	-borderwidth 0
  pack .balloon.label
  wm geometry .balloon +$x+[expr $y + 16]
  set balloon(id) [after 1000 wm deiconify .balloon]
}

#
# Destroy help balloon widget
#
proc Delete_Balloon {} {
  global balloon

  catch { after cancel $balloon(id) }
  catch { destroy .balloon }
}

#
# Dialog for compiling a map with wadlc and node builder
#
proc Compile_Dialog {} {
  global cadconf mapinfo mapdata options compile 

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  if { $mapdata(modified) } {
    set x [MapNsaveError]
    if { $x } {
      return
    }
  }

  set f .compile
  if [Dialog_Create $f "PWAD Make/Compile Log" -borderwidth 10] {
    set compile(log) [text $f.log -width 70 -heigh 10 -borderwidth 2 \
	     -relief sunken -font input -yscrollcommand {.compile.s set}]
    scrollbar $f.s -command {.compile.log yview} -orient vertical
    button $f.ok -text OK -font widgets -command {set compile(ok) 1}
    grid $f.log $f.s -sticky news
    grid $f.ok -sticky ns -pady 5
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f.log 0 -weight 1
    grid columnconfigure $f.log 0 -weight 1
    Dialog_Show $f
  }

  $f config -cursor watch
  update idletasks
  $f.ok config -state disabled
  set compile(ok) 0
  $compile(log) config -state normal
  $compile(log) delete 1.0 end

  if { $options(node_builder) == 1 } {
    set fn [file join $cadconf(scriptdir) $cadconf(idbspcompilescript)]
  } elseif { $options(node_builder) == 2 } {
    set fn [file join $cadconf(scriptdir) $cadconf(bspcompilescript)]
  } else {
    set fn [file join $cadconf(scriptdir) $cadconf(warmcompilescript)]
  }

  set in [file join $mapinfo(mapdir) $mapinfo(mapfile)]
  set out [file join $mapinfo(mapdir) [file rootname $mapinfo(mapfile)].wad]

  if { [string compare $mapinfo(episode) "0"] == 0 } {
    set map "MAP"
    if { $mapinfo(episode) < 9 } {
      append map "0"
    }
    append map $mapinfo(map)
  } else {
    set map "E"
    append map $mapinfo(episode)
    append map "M"
    append map $mapinfo(map)
  }

  set compile(command) "$cadconf(shell) $fn $in $out $map"

  if [catch {open "|$compile(command) |& cat" r+} compile(input)] {
    $compile(log) insert end $compile(command)\n
  } else {
    fileevent $compile(input) readable Compile_Log
    fconfigure $compile(input) -blocking 0
  }

  Dialog_Wait $f compile(ok) $f.ok
  Dialog_Dismiss $f
}

#
# Dialog for compiling a map with make
#
proc MakeMap {} {
  global cadconf mapinfo mapdata compile

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  if { $mapdata(modified) } {
    set x [MapNsaveError]
    if { $x } {
      return
    }
  }

  set f .compile
  if [Dialog_Create $f "PWAD Make/Compile Log" -borderwidth 10] {
    set compile(log) [text $f.log -width 70 -heigh 10 -borderwidth 2 \
	-relief sunken -font input -yscrollcommand {.compile.s set}]
    scrollbar $f.s -command {.compile.log yview} -orient vertical
    button $f.ok -text OK -font widgets -command {set compile(ok) 1}
    grid $f.log $f.s -sticky news
    grid $f.ok -sticky ns -pady 5
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f.log 0 -weight 1
    grid columnconfigure $f.log 0 -weight 1
    Dialog_Show $f
  }

  $f config -cursor watch
  update idletasks
  $f.ok config -state disabled
  set compile(ok) 0
  $compile(log) config -state normal
  $compile(log) delete 1.0 end

  set fn [file join $cadconf(scriptdir) $cadconf(makescript)]
  set compile(command) "$cadconf(shell) $fn $mapinfo(mapdir)"

  if [catch {open "|$compile(command) |& cat" r+} compile(input)] {
    $compile(log) insert end $compile(command)\n
  } else {
    fileevent $compile(input) readable Compile_Log
    fconfigure $compile(input) -blocking 0
  }

  Dialog_Wait $f compile(ok) $f.ok
  Dialog_Dismiss $f
}

#
# Update progress of the make or compile run in the log widget
#
proc Compile_Log {} {
  global compile

  if { ![eof $compile(input)] } {
    if { [gets $compile(input) line] > 0 } {
      $compile(log) insert end $line\n
      $compile(log) see end
    }
  } else {
    catch { close $compile(input) }
    $compile(log) config -state disabled
    .compile.ok config -state normal
    .compile config -cursor top_left_arrow
    update idletasks
  }
}

#
# Run the map with the selected WAD engine
#
proc RunMap {} {
  global run mapinfo cadconf options

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  set fn [file join $mapinfo(mapdir) [file rootname $mapinfo(mapfile)].wad]

  if { $mapinfo(episode) == 0 } {
    set e ""
  } else {
    set e $mapinfo(episode)
  }
  set m $mapinfo(map)

  wm iconify .

  set f .run
  if [Dialog_Create $f "PWAD Run Log" -borderwidth 10] {
    set run(log) [text $f.log -width 70 -heigh 10 -borderwidth 2 \
	-relief sunken -font input -yscrollcommand {.run.s set}]
    scrollbar $f.s -command {.run.log yview} -orient vertical
    button $f.ok -text OK -font widgets -command {set run(ok) 1}
    grid $f.log $f.s -sticky news
    grid $f.ok -sticky ns -pady 5
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f.log 0 -weight 1
    grid columnconfigure $f.log 0 -weight 1
    Dialog_Show $f
  }

  set run(ok) 0
  $f.ok config -state disabled
  $run(log) config -state normal
  $run(log) delete 1.0 end

  set cmd "$cadconf(shell) [file join $cadconf(scriptdir) \
	$options(runscript)] $fn $e $m"

  if { $options(nomonsters) == 1 } {
    append cmd " -nomonsters"
  }
  if { $options(devparm) == 1 } {
    append cmd " -devparm"
  }
  if { $options(nomusic) == 1 } {
    append cmd " -nomusic"
  }
  append cmd " -skill "
  append cmd $options(skill)

  if [catch {open "|$cmd |& cat" r+} run(input)] {
    $run(log) insert end $cmd\n
  } else {
    fileevent $run(input) readable Run_Log
    fconfigure $run(input) -blocking 0
  }

  Dialog_Wait $f run(ok) $f.ok
  Dialog_Dismiss $f
}

#
# Update progress of the engine run in the log widget
#
proc Run_Log {} {
  global run

  if { ![eof $run(input)] } {
    if { [gets $run(input) line] > 0 } {
      $run(log) insert end $line\n
      $run(log) see end
    }
  } else {
    catch { close $run(input) }
    $run(log) config -state disabled
    .run.ok config -state normal
    wm deiconify .
  }
}

#
# Sector editor dialog
#
proc EditSector { sec } {
  global mapinfo mapdata editsec sectors flatslist

  # does sector exist?
  if { ![info exists sectors($sec)] } {
    NoSuchSecError $sec
    return
  }

  # get sectors data
  set editsec(sector) $sec
  set editsec(floor_height) [lindex $sectors($sec) 0]
  set editsec(ceil_height) [lindex $sectors($sec) 1]
  set editsec(sec_height) [expr $editsec(ceil_height) - $editsec(floor_height)]
  set editsec(floor_flat) [lindex $sectors($sec) 2]
  set editsec(ceil_flat) [lindex $sectors($sec) 3]
  set editsec(light) [lindex $sectors($sec) 4]
  set editsec(type) [lindex $sectors($sec) 5]
  set editsec(tag) [lindex $sectors($sec) 6]

  trace variable editsec(floor_height) w RecalculateSecHeight
  trace variable editsec(ceil_height) w RecalculateSecHeight

  # create custom dialog to edit sector
  set f .editsec
  if [Dialog_Create $f "Sector Editor"] {
    frame $f.data -borderwidth 2 -relief raised
    label $f.data.l1 -text "Sector" -font widgets
    entry $f.data.se -width 5 -relief sunken -textvariable editsec(sector) \
	-font input -exportselection 0
    $f.data.se config -state disabled
    label $f.data.l2 -text "Floor Height" -font widgets
    entry $f.data.fh -width 5 -relief sunken \
	-textvariable editsec(floor_height) -font input -exportselection 0
    label $f.data.l3 -text "Ceiling Height" -font widgets
    entry $f.data.ch -width 5 -relief sunken \
	-textvariable editsec(ceil_height) -font input -exportselection 0
    label $f.data.l3a -text "Sector Height" -font widgets
    entry $f.data.sh -width 5 -relief sunken \
	-textvariable editsec(sec_height) -font input
    $f.data.sh config -state disabled
    label $f.data.l4 -text "Floor Flat" -font widgets
    listbox $f.data.ff -yscrollcommand {.editsec.data.ffs set} \
	-height 2 -width 10 -font input -exportselection 0
    scrollbar $f.data.ffs -command {.editsec.data.ff yview} -orient vertical \
	-width 10
    label $f.data.l5 -text "Ceiling Flat" -font widgets
    listbox $f.data.cf -yscrollcommand {.editsec.data.cfs set} \
	-height 2 -width 10 -font input -exportselection 0
    scrollbar $f.data.cfs -command {.editsec.data.cf yview} -orient vertical \
	-width 10
    label $f.data.l6 -text "Brightness" -font widgets
    entry $f.data.br -width 5 -relief sunken -textvariable editsec(light) \
	-font input
    label $f.data.l7 -text "Type" -font widgets
    entry $f.data.ty -width 5 -relief sunken -textvariable editsec(type) \
	-font input -exportselection 0
    button $f.data.tys -text "Sel" -font widgets \
	-command {PickSectorType editsec(type)}
    bind $f.data.tys <Enter> {Create_Balloon %W %X %Y "Select sector type"}
    bind $f.data.tys <Leave> {Delete_Balloon}
    label $f.data.l8 -text "Tag" -font widgets
    entry $f.data.ta -width 5 -relief sunken -textvariable editsec(tag) \
	-font input -exportselection 0
    button $f.data.ft -text "Find" -command {set editsec(tag) [FindTag]} \
	-font widgets
    bind $f.data.ft <Enter> {Create_Balloon %W %X %Y "Find next unused tag"}
    bind $f.data.ft <Leave> {Delete_Balloon}
    grid $f.data.l1 $f.data.se -sticky w
    grid $f.data.l2 $f.data.fh -sticky w
    grid $f.data.l3 $f.data.ch -sticky w
    grid $f.data.l3a $f.data.sh -sticky w
    grid $f.data.l4 -row 4 -column 0 -sticky w
    grid $f.data.ff -row 4 -column 1 -columnspan 2 -sticky w
    grid $f.data.ffs -row 4 -column 3 -sticky nsw
    grid $f.data.l5 -row 5 -column 0 -sticky w
    grid $f.data.cf -row 5 -column 1 -columnspan 2 -sticky w
    grid $f.data.cfs -row 5 -column 3 -sticky nsw
    grid $f.data.l6 -row 6 -column 0 -sticky w
    grid $f.data.br -row 6 -column 1 -sticky w
    grid $f.data.l7 -row 7 -column 0 -sticky w
    grid $f.data.ty -row 7 -column 1 -sticky w
    grid $f.data.tys -row 7 -column 2 -columnspan 2 -sticky w
    grid $f.data.l8 -row 8 -column 0 -sticky w
    grid $f.data.ta -row 8 -column 1 -sticky w
    grid $f.data.ft -row 8 -column 2 -columnspan 2 -sticky w

    frame $f.fflat -borderwidth 2 -relief raised
    label $f.fflat.l1 -text "Floor" -font widgets
    canvas $f.fflat.im -background $mapinfo(bg) -borderwidth 1 -relief sunken \
	-highlightthickness 0 -width 64 -height 64
    grid $f.fflat.l1 -sticky w
    grid $f.fflat.im -sticky w -pady 2 -padx 2

    frame $f.cflat -borderwidth 2 -relief raised
    label $f.cflat.l1 -text "Ceiling" -font widgets
    canvas $f.cflat.im -background $mapinfo(bg) -borderwidth 1 -relief sunken \
	-highlightthickness 0 -width 64 -height 64
    grid $f.cflat.l1 -sticky w
    grid $f.cflat.im -sticky w -pady 2 -padx 2

    frame $f.gamma -borderwidth 2 -relief raised
    label $f.gamma.l1 -text Gamma -font widgets
    entry $f.gamma.ga -width 4 -relief sunken -textvariable cadconf(flat_gamma)\
	-font input
    button $f.gamma.p -text "+" -font widgets -command {ChangeFlGamma +0.1}
    bind $f.gamma.p <Enter> {Create_Balloon %W %X %Y "Increment gamma correction"}
    bind $f.gamma.p <Leave> {Delete_Balloon}
    button $f.gamma.m -text "-" -font widgets -command {ChangeFlGamma -0.1}
    bind $f.gamma.m <Enter> {Create_Balloon %W %X %Y "Decrement gamma correction"}
    bind $f.gamma.m <Leave> {Delete_Balloon}
    grid $f.gamma.l1 $f.gamma.ga $f.gamma.p $f.gamma.m -sticky w
    $f.gamma.ga config -state disabled

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets -command {set editsec(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets -command {set editsec(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    bind $f.data.ff <ButtonRelease-1> {
	focus .editsec.data.ff
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-Up> {
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-Down> {
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-End> {
	.editsec.data.ff activate end
	.editsec.data.ff see end
	.editsec.data.ff selection clear 0 end
	.editsec.data.ff selection set end
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-Home> {
	.editsec.data.ff activate 0
	.editsec.data.ff see 0
	.editsec.data.ff selection clear 0 end
	.editsec.data.ff selection set 0
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-Prior> {
	.editsec.data.ff yview scroll -1 pages
	.editsec.data.ff activate @0,0
	.editsec.data.ff selection clear 0 end
	.editsec.data.ff selection set [.editsec.data.ff index active]	
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }
    bind $f.data.ff <KeyRelease-Next> {
	.editsec.data.ff yview scroll 1 pages
	.editsec.data.ff activate @0,0
	.editsec.data.ff selection clear 0 end
	.editsec.data.ff selection set [.editsec.data.ff index active]	
	UpdateFlatImage .editsec.fflat.im \
		[.editsec.data.ff get [.editsec.data.ff curselection]] 0
    }

    bind $f.data.cf <ButtonRelease-1> {
	focus .editsec.data.cf
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-Up> {
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-Down> {
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-End> {
	.editsec.data.cf activate end
	.editsec.data.cf see end
	.editsec.data.cf selection clear 0 end
	.editsec.data.cf selection set end
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-Home> {
	.editsec.data.cf activate 0
	.editsec.data.cf see 0
	.editsec.data.cf selection clear 0 end
	.editsec.data.cf selection set 0
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-Prior> {
	.editsec.data.cf yview scroll -1 pages
	.editsec.data.cf activate @0,0
	.editsec.data.cf selection clear 0 end
	.editsec.data.cf selection set [.editsec.data.cf index active]	
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }
    bind $f.data.cf <KeyRelease-Next> {
	.editsec.data.cf yview scroll 1 pages
	.editsec.data.cf activate @0,0
	.editsec.data.cf selection clear 0 end
	.editsec.data.cf selection set [.editsec.data.cf index active]	
	UpdateFlatImage .editsec.cflat.im \
		[.editsec.data.cf get [.editsec.data.cf curselection]] 1
    }

    grid rowconfigure $f 0 -weight 1
    grid rowconfigure $f.fflat 2 -weight 1
    grid rowconfigure $f.cflat 2 -weight 1
    grid $f.data -row 0 -column 0 -rowspan 2 -sticky news
    grid $f.fflat -row 0 -column 1 -sticky news
    grid $f.cflat -row 0 -column 2 -sticky news
    grid $f.gamma -row 1 -column 1 -columnspan 2 -sticky news
    grid $f.cntl -row 2 -column 0 -columnspan 3 -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editsec(ok) 0

  $f.data.ff delete 0 end
  $f.data.cf delete 0 end
  foreach id [array names flatslist] {
    lappend i $id
  }
  eval {$f.data.ff insert end} [lsort $i]
  eval {$f.data.cf insert end} [lsort $i]

  set i 0
  foreach flat [$f.data.ff get 0 end] {
    if { [string compare $flat $editsec(floor_flat)] == 0 } {
      $f.data.ff selection set $i
      $f.data.ff activate $i
      $f.data.ff see $i
    }
    if { [string compare $flat $editsec(ceil_flat)] == 0 } {
      $f.data.cf selection set $i
      $f.data.cf activate $i
      $f.data.cf see $i
    }
    incr i
  }

  UpdateFlatImage $f.fflat.im [.editsec.data.ff get active] 0 
  UpdateFlatImage $f.cflat.im [.editsec.data.cf get active] 1

  Dialog_Wait $f editsec(ok) $f.data.fh
  Dialog_Dismiss $f

  # if user clicked on set button update sector data
  if { $editsec(ok) == 1 } {
    set fsel [$f.data.ff get active]
    set csel [$f.data.cf get active]
    set sectors($sec) "$editsec(floor_height) $editsec(ceil_height) \
	$fsel $csel $editsec(light) $editsec(type) $editsec(tag)"
    set mapdata(modified) 1
  }
}

#
# Update the flat image shown on one of the canvases
#
proc UpdateFlatImage { can name ind } {
  global cadconf mapinfo

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set fdir [file join $cadconf(doomconfdir) flats]
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set fdir [file join $cadconf(doom2confdir) flats]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set fdir [file join $cadconf(xdoomconfdir) flats]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set fdir [file join $cadconf(xdoomplusconfdir) flats]
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set fdir [file join $cadconf(hexenconfdir) flats]
  }

  set fn [string tolower $name.ppm]
  if { ![file exists $fn] } {
    set fn [file join $fdir [string tolower $name.ppm]]
    if { ![file exists $fn] } {
      set fn [file join $mapinfo(mapdir) [string tolower $name.ppm]]
    }
  }

  $can delete all

  if { [file exists $fn] } {
    image create photo flat$ind -file $fn -height 64 -width 64 \
	-gamma $cadconf(flat_gamma) -palette 8/8/8
    $can create image 0 0 -image flat$ind -anchor nw
  }
}

#
# Change the gamma correction for the displayed flats
#
proc ChangeFlGamma { val } {
  global cadconf

  if {$val > 0.0 && $cadconf(flat_gamma) < 2.0 } {
    set cadconf(flat_gamma) [expr $cadconf(flat_gamma) + $val]
    UpdateFlatImage .editsec.fflat.im [.editsec.data.ff get active] 0
    UpdateFlatImage .editsec.cflat.im [.editsec.data.cf get active] 1
  } elseif { $val < 0.0 && $cadconf(flat_gamma) > 0.5 } {
    UpdateFlatImage .editsec.fflat.im [.editsec.data.ff get active] 0
    UpdateFlatImage .editsec.cflat.im [.editsec.data.cf get active] 1
    set cadconf(flat_gamma) [expr $cadconf(flat_gamma) + $val]
  }
}

#
# Floor or Ceiling height was modified, recalculate Sector height
#
proc RecalculateSecHeight { var index op } {
  global editsec

  set editsec(sec_height) [expr $editsec(ceil_height) - $editsec(floor_height)]
}

#
# Dialog for selecting sector type
#
proc PickSectorType { var } {
  global editsectype sectypelist

  upvar $var val

  # custom dialog to select the sector type
  set f .picksec
  if [Dialog_Create $f "Sector Type Picker"] {
    frame $f.sec -borderwidth 2 -relief raised
    listbox $f.sec.ty -yscrollcommand {.picksec.sec.sc set} \
	-font input -height 3 -width 60
    scrollbar $f.sec.sc -command {.picksec.sec.ty yview} \
	-orient vertical -width 10
    grid $f.sec.ty $f.sec.sc -sticky nsw
    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "Set" -font widgets \
	-command {set editsectype(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets \
	-command {set editsectype(ok) 0}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.sec -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editsectype(ok) 0

  $f.sec.ty delete 0 end
  foreach {id j} [array get sectypelist] {
    lappend i $j
  }
  eval {$f.sec.ty insert end} [lsort $i]
  $f.sec.ty insert end "UNKNOWN"

  set found 0
  set i 0
  foreach j [$f.sec.ty get 0 end] {
    if { [string compare $j [LookupSectypeDes $val]] == 0 } {
      $f.sec.ty selection set $i
      $f.sec.ty activate $i
      $f.sec.ty see $i
      set found 1
      break
    }
    incr i
  }

  if { !$found } {
    $f.sec.ty selection set end
    $f.sec.ty activate end
    $f.sec.ty see end
  }

  Dialog_Wait $f editsectype(ok) $f.sec.ty
  Dialog_Dismiss $f

  if { $editsectype(ok) == 1 } {
    set sectype [LookupSectypeNum [$f.sec.ty get [$f.sec.ty curselection]]]
    if { $sectype != 99999 } {
      set val $sectype
    }
  }
}

#
# Find next unused tag
#
# For Doom we need to check the tag fields in sectors and lines, usually
# a line has the same tag than a sector, which will be affected in some way.
# So find a tag not used in a sector and not used in a line.
#
# For Hexen lines don't have a tag anymore, only sectors have a tag, so
# just walk the sectors to find next unused one.
#
proc FindTag {} {
  global mapinfo mapdata sectors lines

  for {set i 1} {$i < $mapdata(max_sector_tags)} {incr i} {
    set found 0
    foreach sec [array names sectors] {
      if { $i == [lindex $sectors($sec) 6] } {
	set found 1
	break
      }
    }
    if { $found == 0 } {
      if { [string compare $mapinfo(maptype) $mapinfo(map_ext)] == 0 } {
	# for Hexen we're done, found tag not used in any sector yet
	return $i
      }
      # for Doom we need to check if this tag isn't used in a line already
      foreach lin [array names lines] {
	if { [string first "," $lin] != -1 } {
	  continue
	}
	if { $i == [lindex $lines($lin) 4] } {
	  set found 1
	  break
	}
      }
    }
    if { $found == 0 } {
      return $i
    }
  }
  # uhm, out of tags, return 0
  return 0
}

#
# Thing editor dialog
#
proc EditThing { x y can } {
  global cadconf mapinfo mapdata canvas editthing things thinglist thingpastebuf

  # figure out which thing that was and get its data
  set name [lindex [$can gettags $canvas($can,obj)] 1]
  set thingpastebuf(name) $name
  set editthing(type) [lindex $things($name) 0]
  set editthing(tid) [lindex $things($name) 1]
  set editthing(altitude) [lindex $things($name) 4]
  set editthing(angle) [lindex $things($name) 5]
  set editthing(special) [lindex $things($name) 7]
  set editthing(arg1) [lindex $things($name) 8]
  set editthing(arg2) [lindex $things($name) 9]
  set editthing(arg3) [lindex $things($name) 10]
  set editthing(arg4) [lindex $things($name) 11]
  set editthing(arg5) [lindex $things($name) 12]
  if { [lindex $things($name) 6] & 1 } {
    set editthing(bit0) 1
  } else {
    set editthing(bit0) 0
  }
  if { [lindex $things($name) 6] & 2 } {
    set editthing(bit1) 1
  } else {
    set editthing(bit1) 0
  }
  if { [lindex $things($name) 6] & 4 } {
    set editthing(bit2) 1
  } else {
    set editthing(bit2) 0
  }
  if { [lindex $things($name) 6] & 8 } {
    set editthing(bit3) 1
  } else {
    set editthing(bit3) 0
  }
  if { [lindex $things($name) 6] & 16 } {
    set editthing(bit4) 1
  } else {
    set editthing(bit4) 0
  }
  if { [lindex $things($name) 6] & 32 } {
    set editthing(bit5) 1
  } else {
    set editthing(bit5) 0
  }
  if { [lindex $things($name) 6] & 64 } {
    set editthing(bit6) 1
  } else {
    set editthing(bit6) 0
  }
  if { [lindex $things($name) 6] & 128 } {
    set editthing(bit7) 1
  } else {
    set editthing(bit7) 0
  }
  if { [lindex $things($name) 6] & 256 } {
    set editthing(bit8) 1
  } else {
    set editthing(bit8) 0
  }
  if { [lindex $things($name) 6] & 512 } {
    set editthing(bit9) 1
  } else {
    set editthing(bit9) 0
  }
  if { [lindex $things($name) 6] & 1024 } {
    set editthing(bit10) 1
  } else {
    set editthing(bit10) 0
  }

  # create custom dialog to edit thing
  set f .editthing
  if [Dialog_Create $f "Thing Editor"] {
    frame $f.type -borderwidth 2 -relief raised
    label $f.type.l1 -text "Type" -font widgets
    label $f.type.l2 -text "ID" -font widgets
    set type [listbox $f.type.ty -yscrollcommand {.editthing.type.sc set} \
	-font input -height 3 -width 30]
    scrollbar $f.type.sc -command {.editthing.type.ty yview} \
	-orient vertical -width 10
    entry $f.type.nu -width 5 -relief sunken -textvariable editthing(type) \
	-font input -exportselection 0
    grid $f.type.l1 -sticky nw
    grid $f.type.l2 -row 0 -column 2 -rowspan 1 -padx 15 -sticky nw
    grid $f.type.ty -row 1 -column 0 -rowspan 3 -sticky nsw
    grid $f.type.sc -row 1 -column 1 -rowspan 3 -sticky nsw
    grid $f.type.nu -row 1 -column 2 -rowspan 1 -padx 15 -sticky nw
    grid columnconfigure $f.type 3 -weight 1
    bind $f.type.ty <ButtonRelease-1> {
	focus .editthing.type.ty
	UpdateThingInfo
    }
    bind $f.type.ty <KeyRelease-Up> UpdateThingInfo
    bind $f.type.ty <KeyRelease-Down> UpdateThingInfo
    bind $f.type.ty <KeyRelease-End> {
	.editthing.type.ty activate end
	.editthing.type.ty see end
	.editthing.type.ty selection clear 0 end
	.editthing.type.ty selection set end
	UpdateThingInfo
    }
    bind $f.type.ty <KeyRelease-Home> {
	.editthing.type.ty activate 0
	.editthing.type.ty see 0
	.editthing.type.ty selection clear 0 end
	.editthing.type.ty selection set 0
	UpdateThingInfo
    }
    bind $f.type.ty <KeyRelease-Prior> {
	.editthing.type.ty yview scroll -1 pages
	.editthing.type.ty activate @0,0
	.editthing.type.ty selection clear 0 end
	.editthing.type.ty selection set [.editthing.type.ty index active]
	UpdateThingInfo
    }
    bind $f.type.ty <KeyRelease-Next> {
	.editthing.type.ty yview scroll 1 pages
	.editthing.type.ty activate @0,0
	.editthing.type.ty selection clear 0 end
	.editthing.type.ty selection set [.editthing.type.ty index active]
	UpdateThingInfo
    }

    frame $f.angle -borderwidth 2 -relief raised
    label $f.angle.l1 -text "Angle" -font widgets
    entry $f.angle.an -width 5 -relief sunken -textvariable editthing(angle) \
	-font input -exportselection 0
    set as [tk_optionMenu $f.angle.as editthing(angle_sel) N NE E SE S SW W NW]
    $f.angle.as configure -takefocus 1 -width 4 -font widgets
    label $f.angle.l2 -text "Altitude" -font widgets
    entry $f.angle.al -width 5 -relief sunken -textvariable \
	editthing(altitude) -font input -exportselection 0
    if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
      grid $f.angle.l1 $f.angle.an $f.angle.as -sticky w
    } else {
      grid $f.angle.l1 $f.angle.an $f.angle.as $f.angle.l2 $f.angle.al -sticky w
    }
    grid columnconfigure $f.angle 4 -weight 1

    frame $f.flags -borderwidth 2 -relief raised
    label $f.flags.l1 -text "Flags:" -font widgets

    if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
      # flags for Doom maps
      label $f.flags.l2 -text "Doom" -font widgets
      checkbutton $f.flags.b0 -text "1/2" -font widgets \
	-variable editthing(bit0)
      bind $f.flags.b0 <Enter> {Create_Balloon %W %X %Y "In skill 1 and 2"}
      bind $f.flags.b0 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b1 -text "3" -font widgets -variable editthing(bit1)
      bind $f.flags.b1 <Enter> {Create_Balloon %W %X %Y "In skill 3"}
      bind $f.flags.b1 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b2 -text "4/5" -font widgets \
	-variable editthing(bit2)
      bind $f.flags.b2 <Enter> {Create_Balloon %W %X %Y "In skill 4 and 5"}
      bind $f.flags.b2 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b3 -text "Deaf" -font widgets \
	-variable editthing(bit3)
      bind $f.flags.b3 <Enter> {Create_Balloon %W %X %Y "Monster is deaf"}
      bind $f.flags.b3 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b4 -text "MP" -font widgets -variable editthing(bit4)
      bind $f.flags.b4 <Enter> {Create_Balloon %W %X %Y "In Multiplayer only"}
      bind $f.flags.b4 <Leave> {Delete_Balloon}
      label $f.flags.l3 -text "Ext." -font widgets
      checkbutton $f.flags.b5 -text "ND" -font widgets -variable editthing(bit5)
      bind $f.flags.b5 <Enter> {Create_Balloon %W %X %Y "Not in Deathmatch"}
      bind $f.flags.b5 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b6 -text "NC" -font widgets -variable editthing(bit6)
      bind $f.flags.b6 <Enter> {Create_Balloon %W %X %Y "Not in Cooperative"}
      bind $f.flags.b6 <Leave> {Delete_Balloon}
      grid $f.flags.l1 -sticky w
      grid $f.flags.l2 $f.flags.b0 $f.flags.b1 $f.flags.b2 \
	 $f.flags.b3 $f.flags.b4 -sticky w
      grid $f.flags.l3 $f.flags.b5 $f.flags.b6 -sticky w
    } else {
      # flags for Hexen maps
      checkbutton $f.flags.b0 -text "1/2" -font widgets \
	-variable editthing(bit0)
      bind $f.flags.b0 <Enter> {Create_Balloon %W %X %Y "In skill 1 and 2"}
      bind $f.flags.b0 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b1 -text "3" -font widgets -variable editthing(bit1)
      bind $f.flags.b1 <Enter> {Create_Balloon %W %X %Y "In skill 3"}
      bind $f.flags.b1 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b2 -text "4/5" -font widgets \
	-variable editthing(bit2)
      bind $f.flags.b2 <Enter> {Create_Balloon %W %X %Y "In skill 4 and 5"}
      bind $f.flags.b2 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b3 -text "Deaf" -font widgets \
	-variable editthing(bit3)
      bind $f.flags.b3 <Enter> {Create_Balloon %W %X %Y "Monster is deaf"}
      bind $f.flags.b3 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b4 -text "Dormant" -font widgets \
	-variable editthing(bit4)
      bind $f.flags.b4 <Enter> {Create_Balloon %W %X %Y \
	"Thing doesn't wake up before activated"}
      bind $f.flags.b4 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b5 -text "F" -font widgets \
	-variable editthing(bit5)
      bind $f.flags.b5 <Enter> {Create_Balloon %W %X %Y \
	"Thing appears for Fighter"}
      bind $f.flags.b5 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b6 -text "C" -font widgets \
	-variable editthing(bit6)
      bind $f.flags.b6 <Enter> {Create_Balloon %W %X %Y \
	"Thing appears for Cleric"}
      bind $f.flags.b6 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b7 -text "M" -font widgets \
	-variable editthing(bit7)
      bind $f.flags.b7 <Enter> {Create_Balloon %W %X %Y \
	"Thing appears for Mage"}
      bind $f.flags.b7 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b8 -text "SP" -font widgets -variable editthing(bit8)
      bind $f.flags.b8 <Enter> {Create_Balloon %W %X %Y "In Single player"}
      bind $f.flags.b8 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b9 -text "CO" -font widgets -variable editthing(bit9)
      bind $f.flags.b9 <Enter> {Create_Balloon %W %X %Y "In Cooperative"}
      bind $f.flags.b9 <Leave> {Delete_Balloon}
      checkbutton $f.flags.b10 -text "DM" -font widgets \
	-variable editthing(bit10)
      bind $f.flags.b10 <Enter> {Create_Balloon %W %X %Y "In Deathmatch"}
      bind $f.flags.b10 <Leave> {Delete_Balloon}
      grid $f.flags.l1 -sticky w
      grid $f.flags.b0 $f.flags.b1 $f.flags.b2 $f.flags.b3 -sticky w
      grid $f.flags.b4 -row 1 -column 4 -columnspan 2 -sticky w
      grid $f.flags.b5 $f.flags.b6 $f.flags.b7 $f.flags.b8 $f.flags.b9 \
	$f.flags.b10 -sticky w
      grid columnconfigure $f.flags 7 -weight 1
    }

    # only extended Hexen maps have thing specials and arguments
    if { [string compare $mapinfo(maptype) $mapinfo(map_ext)] == 0 } {
      frame $f.args -borderwidth 2 -relief raised
      label $f.args.l1 -text "Sp" -font widgets
      entry $f.args.sp -width 3 -relief sunken \
	-textvariable editthing(special) -font input -exportselection 0
      label $f.args.l1a -text "TID" -font widgets
      entry $f.args.ti -width 3 -relief sunken \
	-textvariable editthing(tid) -font input -exportselection 0
      button $f.args.fi -text "Find" -command {set editthing(tid) [FindTid]} \
	-font widgets
      bind $f.args.fi <Enter> {Create_Balloon %W %X %Y "Find next unused tid"}
      bind $f.args.fi <Leave> {Delete_Balloon}
      label $f.args.l2 -text "A1" -font widgets
      entry $f.args.a1 -width 3 -relief sunken \
	-textvariable editthing(arg1) -font input -exportselection 0
      label $f.args.l3 -text "A2" -font widgets
      entry $f.args.a2 -width 3 -relief sunken \
	-textvariable editthing(arg2) -font input -exportselection 0
      label $f.args.l4 -text "A3" -font widgets
      entry $f.args.a3 -width 3 -relief sunken \
	-textvariable editthing(arg3) -font input -exportselection 0
      label $f.args.l5 -text "A4" -font widgets
      entry $f.args.a4 -width 3 -relief sunken \
	-textvariable editthing(arg4) -font input -exportselection 0
      label $f.args.l6 -text "A5" -font widgets
      entry $f.args.a5 -width 3 -relief sunken \
	-textvariable editthing(arg5) -font input -exportselection 0
      grid $f.args.l1 $f.args.sp $f.args.l1a $f.args.ti -sticky w
      grid $f.args.fi -row 0 -column 4 -columnspan 2 -sticky w
      grid $f.args.l2 $f.args.a1 $f.args.l3 $f.args.a2 $f.args.l4 $f.args.a3 \
	$f.args.l5 $f.args.a4 $f.args.l6 $f.args.a5 -sticky w
    }

    frame $f.info -borderwidth 2 -relief raised
    label $f.info.l1 -text "Class" -font widgets
    entry $f.info.cl -width 8 -relief sunken -textvariable editthing(class) \
	-font input -exportselection 0
    label $f.info.l2 -text "Height" -font widgets
    entry $f.info.h -width 4 -relief sunken -textvariable editthing(height) \
	-font input -exportselection 0
    label $f.info.l3 -text "Radius" -font widgets
    entry $f.info.r -width 4 -relief sunken -textvariable editthing(radius) \
	-font input -exportselection 0
    grid $f.info.l1 $f.info.cl $f.info.l2 $f.info.h $f.info.l3 $f.info.r \
	-sticky w
    grid columnconfigure $f.info 6 -weight 1
    $f.info.cl config -state disabled
    $f.info.h config -state disabled
    $f.info.r config -state disabled

    frame $f.im -borderwidth 2 -relief raised
    canvas $f.im.c -background $mapinfo(bg) -borderwidth 1 \
	-highlightthickness 0 -width 200 -height 120 -relief sunken
    label $f.im.l1 -text "Gamma" -font widgets
    entry $f.im.ga -width 4 -relief sunken -textvariable cadconf(sprite_gamma) \
	-font input -exportselection 0
    button $f.im.p -text "+" -font widgets -command {ChangeSPGamma +0.1}
    bind $f.im.p <Enter> {Create_Balloon %W %X %Y "Increment gamma correction"}
    bind $f.im.p <Leave> {Delete_Balloon}
    button $f.im.m -text "-" -font widgets -command {ChangeSPGamma -0.1}
    bind $f.im.m <Enter> {Create_Balloon %W %X %Y "Decrement gamma correction"}
    bind $f.im.m <Leave> {Delete_Balloon}
    grid $f.im.c -columnspan 4 -sticky w -pady 2
    grid $f.im.l1 $f.im.ga $f.im.p $f.im.m -sticky w
    $f.im.ga config -state disabled

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets \
	-command {set editthing(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets \
	-command {set editthing(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
      grid $f.type -row 0 -column 0 -sticky news
      grid $f.angle -row 1 -column 0 -sticky news
      grid $f.flags -row 2 -column 0 -sticky news
      grid $f.info -row 3 -column 0 -sticky news
      grid $f.im -row 0 -column 1 -rowspan 4 -sticky news
      grid $f.cntl -row 4 -column 0 -columnspan 2 -sticky news
    } else {
      grid $f.type -row 0 -column 0 -sticky news
      grid $f.angle -row 1 -column 0 -sticky news
      grid $f.flags -row 2 -column 0 -sticky news
      grid $f.args -row 3 -column 0 -sticky news
      grid $f.info -row 4 -column 0 -sticky news
      grid $f.im -row 0 -column 1 -rowspan 5 -sticky news
      grid $f.cntl -row 5 -column 0 -columnspan 2 -sticky news
    }

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editthing(ok) 0

  $f.type.ty delete 0 end
  foreach {id d} [array get thinglist] {
    lappend i [lindex $d 4]
  }
  eval {$f.type.ty insert end} [lsort $i]
  $f.type.ty insert end "UNKNOWN"

  UpdateThingInfoList 0 0 0
  trace variable editthing(type) w UpdateThingInfoList

  set editthing(angle_sel) [Angle2Dir $editthing(angle)]
  trace variable editthing(angle_sel) w AngleSelected
  UpdateThingInfo

  Dialog_Wait $f editthing(ok) $f.type.ty
  Dialog_Dismiss $f

  trace vdelete editthing(angle_sel) w AngleSelected
  trace vdelete editthing(type) w UpdateThingInfoList

  # if user clicked on set button get the new values and update the thing
  if { $editthing(ok) == 1 } {
    set things($name) [lreplace $things($name) 0 0 $editthing(type)]
    set things($name) [lreplace $things($name) 1 1 $editthing(tid)]
    set things($name) [lreplace $things($name) 4 4 $editthing(altitude)]
    set things($name) [lreplace $things($name) 5 5 $editthing(angle)]
    set things($name) [lreplace $things($name) 7 7 $editthing(special)]
    set things($name) [lreplace $things($name) 8 8 $editthing(arg1)]
    set things($name) [lreplace $things($name) 9 9 $editthing(arg2)]
    set things($name) [lreplace $things($name) 10 10 $editthing(arg3)]
    set things($name) [lreplace $things($name) 11 11 $editthing(arg4)]
    set things($name) [lreplace $things($name) 12 12 $editthing(arg5)]
    set things($name) [lreplace $things($name) 6 6 [expr \
      $editthing(bit0)*1 + $editthing(bit1)*2 + $editthing(bit2)*4 + \
      $editthing(bit3)*8 + $editthing(bit4)*16 + $editthing(bit5)*32 + \
      $editthing(bit6)*64 + $editthing(bit7)*128 + $editthing(bit8)*256 + \
      $editthing(bit9)*512 + $editthing(bit10)*1024]]
    # might need to be drawn with different color
    RedrawThing $name $canvas($can,obj)
    set mapdata(modified) 1
  }
}

#
# Update the info for the thing selected
#
proc UpdateThingInfo {} {
  global thinglist editthing

  set thn [.editthing.type.ty get [.editthing.type.ty curselection]]
  set thid [LookupThingNum $thn]
  if { $thid != 99999 } {
    set editthing(type) $thid
    set editthing(class) [lindex $thinglist($thid) 3]
    set editthing(height) [lindex $thinglist($thid) 0]
    set editthing(radius) [lindex $thinglist($thid) 1]

    set sprite [lindex $thinglist($thid) 2]
    UpdateThingImage .editthing.im.c $sprite
  } else {
    .editthing.im.c delete all
  }
}

#
# Update the thing info listbox if thing type was modified
#
proc UpdateThingInfoList { arg1 arg2 arg3 } {
  global thinglist editthing

  .editthing.type.ty selection clear 0 end

  if { [info exists thinglist($editthing(type))] } {
    set i 0
    foreach j [.editthing.type.ty get 0 end] {
      if { [string compare $j [lindex $thinglist($editthing(type)) 4]] == 0 } {
	.editthing.type.ty selection set $i
	.editthing.type.ty activate $i
	.editthing.type.ty see $i
	set sprite [lindex $thinglist($editthing(type)) 2]
	UpdateThingImage .editthing.im.c $sprite
	break
      }
      incr i
    }
  } else {
    .editthing.type.ty selection set end
    .editthing.type.ty activate end
    .editthing.type.ty see end
    .editthing.im.c delete all
  }
}

#
# Update the thing image on a canvas
#
proc UpdateThingImage { can name } {
  global cadconf mapinfo

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set sdir [file join $cadconf(doomconfdir) sprites]
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set sdir [file join $cadconf(doom2confdir) sprites]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set sdir [file join $cadconf(xdoomconfdir) sprites]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set sdir [file join $cadconf(xdoomplusconfdir) sprites]
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set sdir [file join $cadconf(hexenconfdir) sprites]
  }

  set fn [string tolower $name.ppm]
  if { ![file exists $fn] } {
    set fn [file join $sdir [string tolower $name.ppm]]
    if { ![file exists $fn] } {
      set fn [file join $mapinfo(mapdir) [string tolower $name.ppm]]
    }
  }

  $can delete all

  if { [file exists $fn] } {
    image create photo spr -file $fn \
	-gamma $cadconf(sprite_gamma) -palette 8/8/8
    $can create image 100 60 -image spr -anchor center
  }
}

#
# Change the gamma correction for displayed sprites
#
proc ChangeSPGamma { val } {
  global cadconf

  if { $val > 0.0 && $cadconf(sprite_gamma) < 2.0 } {
    set cadconf(sprite_gamma) [expr $cadconf(sprite_gamma) + $val]
    UpdateThingInfo
  } elseif { $val < 0.0 && $cadconf(sprite_gamma) > 0.5 } {
    set cadconf(sprite_gamma) [expr $cadconf(sprite_gamma) + $val]
    UpdateThingInfo
  }
}

#
# The angle option menu in thing editor was used, convert from view
# direction to angle
#
proc AngleSelected { var index op } {
  global editthing

  switch -exact -- $editthing(angle_sel) {
    N  {set editthing(angle) 90}
    NE {set editthing(angle) 45}
    E  {set editthing(angle) 0}
    SE {set editthing(angle) 315}
    S  {set editthing(angle) 270}
    SW {set editthing(angle) 225}
    W  {set editthing(angle) 180}
    NW {set editthing(angle) 135}
  }
}

#
# Find next unused tid for Hexen style maps
#
proc FindTid {} {
  global mapdata things

  for {set i 1} {$i < $mapdata(max_thing_tids)} {incr i} {
    set found 0
    foreach thing [array names things] {
      if { $i == [lindex $things($thing) 1] } {
	set found 1
	break
      }
    }
    if { $found == 0 } {
      return $i
    }
  }
  # uhm, out of tids, return 0
  return 0
}

#
# Dialog to connect two vertices with a new line
#
proc NewLine {} {
  global mapinfo mapata cadconf connline vertices lines

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  # create custom dialog which allows user to enter 2 vertices
  set f .newline
  if [Dialog_Create $f "Line Connect"] {
    frame $f.data -borderwidth 2 -relief raised
    label $f.data.l1 -text "Start Vertex" -font widgets
    entry $f.data.v1 -width 5 -relief sunken -textvariable connline(v1) \
	-font input
    label $f.data.l2 -text "Destination Vertex" -font widgets
    entry $f.data.v2 -width 5 -relief sunken -textvariable connline(v2) \
	-font input
    grid $f.data.l1 $f.data.v1 $f.data.l2 $f.data.v2 -sticky w
    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets \
	-command {set connline(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets -command {set connline(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.data -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set connline(ok) 0

  Dialog_Wait $f connline(ok) $f.data.v1
  Dialog_Dismiss $f

  if { $connline(ok) == 2 } {
    return
  }

  if { ![info exists vertices($connline(v1))] } {
    NoVertexError $connline(v1)
    return
  }

  if { ![info exists vertices($connline(v2))] } {
    NoVertexError $connline(v2)
    return
  }

  if { [string compare vertices($connline(v1)) vertices($connline(v2))] == 0 } {
    ZeroLineError
    return
  }

  set l1 [AddLine $connline(v1) $connline(v2)]
  RedrawLines $connline(v1)

  # set the default texture on the right sidedef
  set lines($l1,rightsdef) \
	[lreplace $lines($l1,rightsdef) 5 5 $cadconf(def_texture)]

  # set linedef flag so that this line is impassable
  set lines($l1) [lreplace $lines($l1) 2 2 1]

  set mapdata(modified) 1
}

#
# Line editor dialog
#
proc EditLine { x y can } {
  global cadconf mapinfo mapdata canvas lines editline

  # figure out which line that was and get its data
  set name [lindex [$can gettags $canvas($can,obj)] 1]
  set editline(name) $name
  set editline(flags) [lindex $lines($name) 2]
  set editline(type) [lindex $lines($name) 3]
  set editline(tag) [lindex $lines($name) 4]
  set editline(arg2) [lindex $lines($name) 5]
  set editline(arg3) [lindex $lines($name) 6]
  set editline(arg4) [lindex $lines($name) 7]
  set editline(arg5) [lindex $lines($name) 8]
  set editline(lenght) [CalcLineLenght $name]
  if {$editline(flags) & 1} {
    set editline(bit0) 1
  } else {
    set editline(bit0) 0
  }
  if {$editline(flags) & 2} {
    set editline(bit1) 1
  } else {
    set editline(bit1) 0
  }
  if {$editline(flags) & 4} {
    set editline(bit2) 1
  } else {
    set editline(bit2) 0
  }
  if {$editline(flags) & 8} {
    set editline(bit3) 1
  } else {
    set editline(bit3) 0
  }
  if {$editline(flags) & 16} {
    set editline(bit4) 1
  } else {
    set editline(bit4) 0
  }
  if {$editline(flags) & 32} {
    set editline(bit5) 1
  } else {
    set editline(bit5) 0
  }
  if {$editline(flags) & 64} {
    set editline(bit6) 1
  } else {
    set editline(bit6) 0
  }
  if {$editline(flags) & 128} {
    set editline(bit7) 1
  } else {
    set editline(bit7) 0
  }
  if {$editline(flags) & 256} {
    set editline(bit8) 1
  } else {
    set editline(bit8) 0
  }
  if {$editline(flags) & 512} {
    set editline(bit9) 1
  } else {
    set editline(bit9) 0
  }
  if {$editline(flags) & 1024} {
    set editline(bit10) 1
  } else {
    set editline(bit10) 0
  }
  if {$editline(flags) & 2048} {
    set editline(bit11) 1
  } else {
    set editline(bit11) 0
  }
  if {$editline(flags) & 4096} {
    set editline(bit12) 1
  } else {
    set editline(bit12) 0
  }
  if {$editline(flags) & 8192} {
    set editline(bit13) 1
  } else {
    set editline(bit13) 0
  }
  if {$editline(flags) & 16384} {
    set editline(bit14) 1
  } else {
    set editline(bit14) 0
  }
  if {$editline(flags) & 32768} {
    set editline(bit15) 1
  } else {
    set editline(bit15) 0
  }

  set editline(rs_sec) [lindex $lines($name,rightsdef) 0]
  set editline(rs_x) [lindex $lines($name,rightsdef) 1]
  set editline(rs_y) [lindex $lines($name,rightsdef) 2]
  set editline(rs_ut) [lindex $lines($name,rightsdef) 3]
  set editline(rs_lt) [lindex $lines($name,rightsdef) 4]
  set editline(rs_mt) [lindex $lines($name,rightsdef) 5]

  # create custom dialog to edit line
  set f .editline
  if [Dialog_Create $f "Line Editor"] {

    # frame for linedef
    frame $f.li -borderwidth 2 -relief raised
    label $f.li.l1 -text "Linedef" -font widgets
    grid $f.li.l1 -sticky n

    frame $f.li.type -borderwidth 2 -relief raised
    label $f.li.type.l1 -text "Type  " -font widgets
    entry $f.li.type.ty -width 6 -relief sunken -textvariable editline(type) \
	-font input
    button $f.li.type.se -text "Select" -font widgets \
	-command {$cadconf(ldefpicker) editline(type)}
    bind $f.li.type.se <Enter> {Create_Balloon %W %X %Y "Select linedef type"}
    bind $f.li.type.se <Leave> {Delete_Balloon}
    grid $f.li.type.l1 $f.li.type.ty $f.li.type.se -sticky w
    grid columnconfigure $f.li.type 3 -weight 1

    frame $f.li.tag -borderwidth 2 -relief raised
    if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
      # tag for Doom style maps
      label $f.li.tag.l1 -text "Tag    " -font widgets
      entry $f.li.tag.ta -width 6 -relief sunken -textvariable editline(tag) \
	-font input
      button $f.li.tag.fi -text "Find" -font widgets \
	-command {set editline(tag) [FindTag]}
      bind $f.li.tag.fi <Enter> {Create_Balloon %W %X %Y "Get next unused tag"}
      bind $f.li.tag.fi <Leave> {Delete_Balloon}
      grid $f.li.tag.l1 $f.li.tag.ta $f.li.tag.fi -sticky w
      grid columnconfigure $f.li.tag 3 -weight 1
    } else {
      # arguments for Hexen style maps
      label $f.li.tag.l0 -text "Arguments:" -font widgets
      label $f.li.tag.l1 -text "A1" -font widgets
      entry $f.li.tag.a1 -width 3 -relief sunken -textvariable editline(tag) \
	-font input
      label $f.li.tag.l2 -text "A2" -font widgets
      entry $f.li.tag.a2 -width 3 -relief sunken -textvariable editline(arg2) \
	-font input
      label $f.li.tag.l3 -text "A3" -font widgets
      entry $f.li.tag.a3 -width 3 -relief sunken -textvariable editline(arg3) \
	-font input
      label $f.li.tag.l4 -text "A4" -font widgets
      entry $f.li.tag.a4 -width 3 -relief sunken -textvariable editline(arg4) \
	-font input
      label $f.li.tag.l5 -text "A5" -font widgets
      entry $f.li.tag.a5 -width 3 -relief sunken -textvariable editline(arg5) \
	-font input
      grid $f.li.tag.l0 $f.li.tag.l1 $f.li.tag.a1 $f.li.tag.l2 $f.li.tag.a2 \
	$f.li.tag.l3 $f.li.tag.a3 $f.li.tag.l4 $f.li.tag.a4 $f.li.tag.l5 \
	$f.li.tag.a5 -sticky w
      grid columnconfigure $f.li.tag 11 -weight 1
    }

    frame $f.li.len -borderwidth 2 -relief raised
    label $f.li.len.l1 -text "Length" -font widgets
    entry $f.li.len.l -width 5 -relief sunken -textvariable editline(lenght) \
	-font input
    $f.li.len.l config -state disabled
    grid $f.li.len.l1 $f.li.len.l -sticky w
    grid columnconfigure $f.li.len 3 -weight 1

    frame $f.li.flags -borderwidth 2 -relief raised
    if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
      # Doom style flags
      label $f.li.flags.l1 -text "Flags:" -font widgets
      label $f.li.flags.l2 -text "Doom" -font widgets
      checkbutton $f.li.flags.b0 -text "Im" -font widgets \
	-variable editline(bit0)
      bind $f.li.flags.b0 <Enter> {Create_Balloon %W %X %Y "Impassible"}
      bind $f.li.flags.b0 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b1 -text "Bm" -font widgets \
	-variable editline(bit1)
      bind $f.li.flags.b1 <Enter> {Create_Balloon %W %X %Y "Block Monster"}
      bind $f.li.flags.b1 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b2 -text "2s" -font widgets \
	-variable editline(bit2)
      bind $f.li.flags.b2 <Enter> {Create_Balloon %W %X %Y "Two-sided"}
      bind $f.li.flags.b2 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b3 -text "Up" -font widgets \
	-variable editline(bit3)
      bind $f.li.flags.b3 <Enter> {Create_Balloon %W %X %Y "Upper unpegged"}
      bind $f.li.flags.b3 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b4 -text "Lo" -font widgets \
	-variable editline(bit4)
      bind $f.li.flags.b4 <Enter> {Create_Balloon %W %X %Y "Lower unpegged"}
      bind $f.li.flags.b4 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b5 -text "Se" -font widgets \
	-variable editline(bit5)
      bind $f.li.flags.b5 <Enter> {Create_Balloon %W %X %Y "Secret"}
      bind $f.li.flags.b5 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b6 -text "Bs" -font widgets \
	-variable editline(bit6)
      bind $f.li.flags.b6 <Enter> {Create_Balloon %W %X %Y "Block sound"}
      bind $f.li.flags.b6 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b7 -text "Nm" -font widgets \
	-variable editline(bit7)
      bind $f.li.flags.b7 <Enter> {Create_Balloon %W %X %Y "Not on map"}
      bind $f.li.flags.b7 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b8 -text "Am" -font widgets \
	-variable editline(bit8)
      bind $f.li.flags.b8 <Enter> {Create_Balloon %W %X %Y "Already on map"}
      bind $f.li.flags.b8 <Leave> {Delete_Balloon}
      label $f.li.flags.l3 -text "Ext." -font widgets
      checkbutton $f.li.flags.b9 -text "Pa" -font widgets \
	-variable editline(bit9)
      bind $f.li.flags.b9 <Enter> {Create_Balloon %W %X %Y \
	"Boom, XDoom: pass trigger thru"}
      bind $f.li.flags.b9 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b10 -text "Tr" -font widgets \
	-variable editline(bit10)
      bind $f.li.flags.b10 <Enter> {Create_Balloon %W %X %Y \
	"XDoom: translucent middle texture"}
      bind $f.li.flags.b10 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b11 -text "Bg" -font widgets \
	-variable editline(bit11)
      bind $f.li.flags.b11 <Enter> {Create_Balloon %W %X %Y \
	"XDoom: Block shoots on 2s"}
      bind $f.li.flags.b11 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b12 -text "Bl" -font widgets \
	-variable editline(bit12)
      bind $f.li.flags.b12 <Enter> {Create_Balloon %W %X %Y \
	"XDoom: Block line of sight on 2s"}
      bind $f.li.flags.b12 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b13 -text "Nu" -font widgets \
	-variable editline(bit13)
      bind $f.li.flags.b13 <Enter> {Create_Balloon %W %X %Y "Not used"}
      bind $f.li.flags.b13 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b14 -text "Nu" -font widgets \
	-variable editline(bit14)
      bind $f.li.flags.b14 <Enter> {Create_Balloon %W %X %Y "Not used"}
      bind $f.li.flags.b14 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b15 -text "Nu" -font widgets \
	-variable editline(bit15)
      bind $f.li.flags.b15 <Enter> {Create_Balloon %W %X %Y "Not used"}
      bind $f.li.flags.b15 <Leave> {Delete_Balloon}
      grid $f.li.flags.l1 -sticky w
      grid $f.li.flags.l2 $f.li.flags.b0 $f.li.flags.b1 $f.li.flags.b2 \
	 $f.li.flags.b3 $f.li.flags.b4 $f.li.flags.b5 $f.li.flags.b6 \
	 $f.li.flags.b7 $f.li.flags.b8 -sticky w
      grid $f.li.flags.l3 $f.li.flags.b9 $f.li.flags.b10 $f.li.flags.b11 \
	 $f.li.flags.b12 $f.li.flags.b13 $f.li.flags.b14 \
	 $f.li.flags.b15 -sticky w
    } else {
      # Hexen style flags
      label $f.li.flags.l1 -text "Flags:" -font widgets
      checkbutton $f.li.flags.b0 -text "Im" -font widgets \
	-variable editline(bit0)
      bind $f.li.flags.b0 <Enter> {Create_Balloon %W %X %Y "Impassible"}
      bind $f.li.flags.b0 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b1 -text "Bm" -font widgets \
	-variable editline(bit1)
      bind $f.li.flags.b1 <Enter> {Create_Balloon %W %X %Y "Block Monster"}
      bind $f.li.flags.b1 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b2 -text "2s" -font widgets \
	-variable editline(bit2)
      bind $f.li.flags.b2 <Enter> {Create_Balloon %W %X %Y "Two-sided"}
      bind $f.li.flags.b2 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b3 -text "Up" -font widgets \
	-variable editline(bit3)
      bind $f.li.flags.b3 <Enter> {Create_Balloon %W %X %Y "Upper unpegged"}
      bind $f.li.flags.b3 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b4 -text "Lo" -font widgets \
	-variable editline(bit4)
      bind $f.li.flags.b4 <Enter> {Create_Balloon %W %X %Y "Lower unpegged"}
      bind $f.li.flags.b4 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b5 -text "Se" -font widgets \
	-variable editline(bit5)
      bind $f.li.flags.b5 <Enter> {Create_Balloon %W %X %Y "Secret"}
      bind $f.li.flags.b5 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b6 -text "Bs" -font widgets \
	-variable editline(bit6)
      bind $f.li.flags.b6 <Enter> {Create_Balloon %W %X %Y "Block sound"}
      bind $f.li.flags.b6 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b7 -text "Nm" -font widgets \
	-variable editline(bit7)
      bind $f.li.flags.b7 <Enter> {Create_Balloon %W %X %Y "Not on map"}
      bind $f.li.flags.b7 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b8 -text "Am" -font widgets \
	-variable editline(bit8)
      bind $f.li.flags.b8 <Enter> {Create_Balloon %W %X %Y "Already on map"}
      bind $f.li.flags.b8 <Leave> {Delete_Balloon}
      button $f.li.flags.ls -text "Sel" -font widgets \
	-command {LineSelAct editline(bit10) editline(bit11) editline(bit12)}
      bind $f.li.flags.ls <Enter> {Create_Balloon %W %X %Y \
	"Edit line's special activation flags"}
      bind $f.li.flags.ls <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b10 -text "S0" -font widgets \
	-variable editline(bit10)
      bind $f.li.flags.b10 <Enter> {Create_Balloon %W %X %Y \
	"Line special activation flag 0, use select button"}
      bind $f.li.flags.b10 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b11 -text "S1" -font widgets \
	-variable editline(bit11)
      bind $f.li.flags.b11 <Enter> {Create_Balloon %W %X %Y \
	"Line special activation flag 1, use select button"}
      bind $f.li.flags.b11 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b12 -text "S2" -font widgets \
	-variable editline(bit12)
      bind $f.li.flags.b12 <Enter> {Create_Balloon %W %X %Y \
	"Line special activation flag 2, use select button"}
      bind $f.li.flags.b12 <Leave> {Delete_Balloon}
      checkbutton $f.li.flags.b9 -text "Rp" -font widgets \
	-variable editline(bit9)
      bind $f.li.flags.b9 <Enter> {Create_Balloon %W %X %Y \
	"Line's special is repeatable"}
      bind $f.li.flags.b9 <Leave> {Delete_Balloon}
      if { [string compare $mapinfo(game) $cadconf(xdoomplus)] } {
        grid $f.li.flags.l1 $f.li.flags.b0 $f.li.flags.b1 $f.li.flags.b2 \
	  $f.li.flags.b3 $f.li.flags.b4 $f.li.flags.b5 $f.li.flags.b6 \
	  $f.li.flags.b7 $f.li.flags.b8 -sticky w
        grid $f.li.flags.ls $f.li.flags.b10 $f.li.flags.b11 $f.li.flags.b12 \
	  $f.li.flags.b9 -sticky w
      } else {
	checkbutton $f.li.flags.b15 -text "Be" -font widgets \
	  -variable editline(bit15)
        bind $f.li.flags.b15 <Enter> {Create_Balloon %W %X %Y \
	  "Block everything"}
        bind $f.li.flags.b15 <Leave> {Delete_Balloon}
        grid $f.li.flags.l1 $f.li.flags.b0 $f.li.flags.b1 $f.li.flags.b2 \
	  $f.li.flags.b3 $f.li.flags.b4 $f.li.flags.b5 $f.li.flags.b6 \
	  $f.li.flags.b7 $f.li.flags.b8 -sticky w
        grid $f.li.flags.ls $f.li.flags.b10 $f.li.flags.b11 $f.li.flags.b12 \
	  $f.li.flags.b9 $f.li.flags.b15 -sticky w
      }
    }

    # frame for left sidedef
    frame $f.ls -borderwidth 2 -relief raised
    label $f.ls.l1 -text "Left sidedef" -font widgets
    grid $f.ls.l1 -sticky n
    frame $f.ls.sec -borderwidth 2 -relief raised
    label $f.ls.sec.l1 -text "Sector" -font widgets
    entry $f.ls.sec.se -width 6 -relief sunken -textvariable editline(ls_sec) \
	-font input
    button $f.ls.sec.es -text Edit -font widgets \
	-command {.editline.ls.sec.se configure -foreground red; \
	EditSector $editline(ls_sec); \
	.editline.ls.sec.se configure -foreground black}
    bind $f.ls.sec.es <Enter> {Create_Balloon %W %X %Y "Edit sector properties"}
    bind $f.ls.sec.es <Leave> {Delete_Balloon}
    grid $f.ls.sec -sticky news
    grid $f.ls.sec.l1 $f.ls.sec.se $f.ls.sec.es -sticky w -padx 5
    grid columnconfigure $f.ls.sec 2 -weight 1
    frame $f.ls.off -borderwidth 2 -relief raised
    label $f.ls.off.l1 -text "X Off." -font widgets
    entry $f.ls.off.x -width 3 -relief sunken -textvariable editline(ls_x) \
	-font input
    label $f.ls.off.l2 -text "Y Off." -font widgets
    entry $f.ls.off.y -width 3 -relief sunken -textvariable editline(ls_y) \
	-font input
    grid $f.ls.off -sticky news
    grid  $f.ls.off.l1 $f.ls.off.x $f.ls.off.l2 $f.ls.off.y -sticky w
    frame $f.ls.tex -borderwidth 2 -relief raised
    label $f.ls.tex.l1 -text "Upper Texture" -font widgets
    entry $f.ls.tex.ut -width 10 -relief sunken -textvariable editline(ls_ut) \
	-font input
    button $f.ls.tex.uts -text "Sel" -font widgets -command { \
	.editline.ls.tex.ut configure -foreground red; \
	WallTexturePick editline(ls_ut); \
	.editline.ls.tex.ut configure -foreground black }
    bind $f.ls.tex.uts <Enter> {Create_Balloon %W %X %Y "Select upper texture"}
    bind $f.ls.tex.uts <Leave> {Delete_Balloon}
    label $f.ls.tex.l2 -text "Middle Texture" -font widgets
    entry $f.ls.tex.mt -width 10 -relief sunken -textvariable editline(ls_mt) \
	-font input
    button $f.ls.tex.mts -text "Sel" -font widgets -command { \
	.editline.ls.tex.mt configure -foreground red; \
	WallTexturePick editline(ls_mt); \
	.editline.ls.tex.mt configure -foreground black }
    bind $f.ls.tex.mts <Enter> {Create_Balloon %W %X %Y "Select middle texture"}
    bind $f.ls.tex.mts <Leave> {Delete_Balloon}
    label $f.ls.tex.l3 -text "Lower Texture" -font widgets
    entry $f.ls.tex.lt -width 10 -relief sunken -textvariable editline(ls_lt) \
	-font input
    button $f.ls.tex.lts -text "Sel" -font widgets -command { \
	.editline.ls.tex.lt configure -foreground red; \
	WallTexturePick editline(ls_lt); \
	.editline.ls.tex.lt configure -foreground black }
    bind $f.ls.tex.lts <Enter> {Create_Balloon %W %X %Y "Select lower texture"}
    bind $f.ls.tex.lts <Leave> {Delete_Balloon}
    grid $f.ls.tex -sticky news
    grid $f.ls.tex.l1 $f.ls.tex.ut $f.ls.tex.uts -sticky w
    grid $f.ls.tex.l2 $f.ls.tex.mt $f.ls.tex.mts -sticky w
    grid $f.ls.tex.l3 $f.ls.tex.lt $f.ls.tex.lts -sticky w
    button $f.ls.conf -command {Change2S} -font widgets
    bind $f.ls.conf <Enter> {Create_Balloon %W %X %Y "Add/delete left sidedef"}
    bind $f.ls.conf <Leave> {Delete_Balloon}
    grid $f.ls.conf -sticky w

    # frame for right sidedef
    frame $f.rs -borderwidth 2 -relief raised
    label $f.rs.l1 -text "Right sidedef" -font widgets
    grid $f.rs.l1 -sticky n
    frame $f.rs.sec -borderwidth 2 -relief raised
    label $f.rs.sec.l1 -text "Sector" -font widgets
    entry $f.rs.sec.se -width 6 -relief sunken -textvariable editline(rs_sec) \
	-font input
    button $f.rs.sec.es -text Edit -font widgets \
	-command {.editline.rs.sec.se configure -foreground red; \
	EditSector $editline(rs_sec); \
	.editline.rs.sec.se configure -foreground black}
    bind $f.rs.sec.es <Enter> {Create_Balloon %W %X %Y "Edit sector properties"}
    bind $f.rs.sec.es <Leave> {Delete_Balloon}
    grid $f.rs.sec -sticky news
    grid $f.rs.sec.l1 $f.rs.sec.se $f.rs.sec.es -sticky w -padx 5
    grid columnconfigure $f.rs.sec 2 -weight 1
    frame $f.rs.off -borderwidth 2 -relief raised
    label $f.rs.off.l1 -text "X Off." -font widgets
    entry $f.rs.off.x -width 3 -relief sunken -textvariable editline(rs_x) \
	-font input
    label $f.rs.off.l2 -text "Y Off." -font widgets
    entry $f.rs.off.y -width 3 -relief sunken -textvariable editline(rs_y) \
	-font input
    grid $f.rs.off -sticky news
    grid  $f.rs.off.l1 $f.rs.off.x $f.rs.off.l2 $f.rs.off.y -sticky w
    frame $f.rs.tex -borderwidth 2 -relief raised
    label $f.rs.tex.l1 -text "Upper Texture" -font widgets
    entry $f.rs.tex.ut -width 10 -relief sunken -textvariable editline(rs_ut) \
	-font input
    button $f.rs.tex.uts -text "Sel" -font widgets -command { \
	.editline.rs.tex.ut configure -foreground red; \
	WallTexturePick editline(rs_ut); \
	.editline.rs.tex.ut configure -foreground black }
    bind $f.rs.tex.uts <Enter> {Create_Balloon %W %X %Y "Select upper texture"}
    bind $f.rs.tex.uts <Leave> {Delete_Balloon}
    label $f.rs.tex.l2 -text "Middle Texture" -font widgets
    entry $f.rs.tex.mt -width 10 -relief sunken -textvariable editline(rs_mt) \
	-font input
    button $f.rs.tex.mts -text "Sel" -font widgets -command { \
	.editline.rs.tex.mt configure -foreground red; \
	WallTexturePick editline(rs_mt); \
	.editline.rs.tex.mt configure -foreground black }
    bind $f.rs.tex.mts <Enter> {Create_Balloon %W %X %Y "Select middle texture"}
    bind $f.rs.tex.mts <Leave> {Delete_Balloon}
    label $f.rs.tex.l3 -text "Lower Texture" -font widgets
    entry $f.rs.tex.lt -width 10 -relief sunken -textvariable editline(rs_lt) \
	-font input
    button $f.rs.tex.lts -text "Sel" -font widgets -command { \
	.editline.rs.tex.lt configure -foreground red; \
	WallTexturePick editline(rs_lt); \
	.editline.rs.tex.lt configure -foreground black }
    bind $f.rs.tex.lts <Enter> {Create_Balloon %W %X %Y "Select lower texture"}
    bind $f.rs.tex.lts <Leave> {Delete_Balloon}
    grid $f.rs.tex -sticky news
    grid $f.rs.tex.l1 $f.rs.tex.ut $f.rs.tex.uts -sticky w
    grid $f.rs.tex.l2 $f.rs.tex.mt $f.rs.tex.mts -sticky w
    grid $f.rs.tex.l3 $f.rs.tex.lt $f.rs.tex.lts -sticky w
    grid rowconfigure $f.rs 4 -weight 1

    # frame for control
    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets \
	-command {set editline(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets -command {set editline(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.li -columnspan 2 -sticky news
    grid $f.li.type -sticky news
    grid $f.li.tag -sticky news
    grid $f.li.len -sticky news
    grid $f.li.flags -sticky news
    grid $f.ls $f.rs -sticky news
    grid $f.cntl -columnspan 2 -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editline(ok) 0
  Setup2S $name

  Dialog_Wait $f editline(ok) $f.li.type.ty
  Dialog_Dismiss $f

  # if user clicked on set button get the new values and update the line
  if { $editline(ok) == 1 } {
    set lines($name) [lreplace $lines($name) 3 3 $editline(type)]
    set lines($name) [lreplace $lines($name) 4 4 $editline(tag)]
    set lines($name) [lreplace $lines($name) 5 5 $editline(arg2)]
    set lines($name) [lreplace $lines($name) 6 6 $editline(arg3)]
    set lines($name) [lreplace $lines($name) 7 7 $editline(arg4)]
    set lines($name) [lreplace $lines($name) 8 8 $editline(arg5)]
    set lines($name) [lreplace $lines($name) 2 2 [expr \
	$editline(bit0)*1 + $editline(bit1)*2 + $editline(bit2)*4 + \
	$editline(bit3)*8 + $editline(bit4)*16 + $editline(bit5)*32 + \
	$editline(bit6)*64 + $editline(bit7)*128 + $editline(bit8)*256 + \
	$editline(bit9)*512 + $editline(bit10)*1024 + $editline(bit11)*2048 + \
	$editline(bit12)*4096 + $editline(bit13)*8192 + \
	$editline(bit14)*16384 + $editline(bit15)*32768]]

    set lines($name,rightsdef) "$editline(rs_sec) $editline(rs_x) \
	$editline(rs_y) $editline(rs_ut) $editline(rs_lt) $editline(rs_mt)"
    if { [string length $editline(ls_sec)] == 0 } {
      set lines($name,leftsdef) "-"
    } else {
      set lines($name,leftsdef) "$editline(ls_sec) $editline(ls_x) \
	$editline(ls_y) $editline(ls_ut) $editline(ls_lt) $editline(ls_mt)"
    }

    # also redraw the line, 2S flag might have been modified
    RedrawLines [lindex $lines($name) 0]

    set mapdata(modified) 1
  }
}

#
# The left sidedef of a linedef is optional, so we need to setup the editor
# widgets for the left sidedef different, depending if the sidedef is there
# or not.
#
proc Setup2S { name } {
  global lines editline

  if { [llength $lines($name,leftsdef)] > 1 } {
    set editline(ls_sec) [lindex $lines($name,leftsdef) 0]
    set editline(ls_x) [lindex $lines($name,leftsdef) 1]
    set editline(ls_y) [lindex $lines($name,leftsdef) 2]
    set editline(ls_ut) [lindex $lines($name,leftsdef) 3]
    set editline(ls_lt) [lindex $lines($name,leftsdef) 4]
    set editline(ls_mt) [lindex $lines($name,leftsdef) 5]
    .editline.ls.sec.se config -state normal
    .editline.ls.sec.es config -state normal
    .editline.ls.off.x config -state normal
    .editline.ls.off.y config -state normal
    .editline.ls.tex.ut config -state normal
    .editline.ls.tex.uts config -state normal
    .editline.ls.tex.mt config -state normal
    .editline.ls.tex.mts config -state normal
    .editline.ls.tex.lt config -state normal
    .editline.ls.tex.lts config -state normal
    .editline.ls.conf configure -text "Remove"
  } else {
    set editline(ls_sec) ""
    set editline(ls_x) ""
    set editline(ls_y) ""
    set editline(ls_ut) ""
    set editline(ls_lt) ""
    set editline(ls_mt) ""
    .editline.ls.sec.se config -state disabled
    .editline.ls.sec.es config -state disabled
    .editline.ls.off.x config -state disabled
    .editline.ls.off.y config -state disabled
    .editline.ls.tex.ut config -state disabled
    .editline.ls.tex.uts config -state disabled
    .editline.ls.tex.mt config -state disabled
    .editline.ls.tex.mts config -state disabled
    .editline.ls.tex.lt config -state disabled
    .editline.ls.tex.lts config -state disabled
    .editline.ls.conf configure -text "  Add  "
  }
}

#
# Add or remove the left sidedef, deppending on current status
#
proc Change2S {} {
  global editline mapdata

  if { [string length $editline(ls_sec)] == 0 } {
    set editline(ls_sec) S0
    set editline(ls_x) 0
    set editline(ls_y) 0
    set editline(ls_ut) "-"
    set editline(ls_mt) "-"
    set editline(ls_lt) "-"
    .editline.ls.sec.se config -state normal
    .editline.ls.sec.es config -state normal
    .editline.ls.off.x config -state normal
    .editline.ls.off.y config -state normal
    .editline.ls.tex.ut config -state normal
    .editline.ls.tex.uts config -state normal
    .editline.ls.tex.mt config -state normal
    .editline.ls.tex.mts config -state normal
    .editline.ls.tex.lt config -state normal
    .editline.ls.tex.lts config -state normal
    .editline.ls.conf configure -text "Remove"
    incr mapdata(no_sdefs)
  } else {
    set editline(ls_sec) ""
    set editline(ls_x) ""
    set editline(ls_y) ""
    set editline(ls_ut) ""
    set editline(ls_mt) ""
    set editline(ls_lt) ""
    .editline.ls.sec.se config -state disabled
    .editline.ls.sec.es config -state disabled
    .editline.ls.off.x config -state disabled
    .editline.ls.off.y config -state disabled
    .editline.ls.tex.ut config -state disabled
    .editline.ls.tex.uts config -state disabled
    .editline.ls.tex.mt config -state disabled
    .editline.ls.tex.mts config -state disabled
    .editline.ls.tex.lt config -state disabled
    .editline.ls.tex.lts config -state disabled
    .editline.ls.conf configure -text "  Add  "
    incr mapdata(no_sdefs) -1
  }
  set mapdata(modified) 1
}

#
# Select line's special activation from a list and set the bits
# appropriate
#
proc LineSelAct { bit0 bit1 bit2} {
  global mapinfo cadconf lspecial

  upvar $bit0 b0
  upvar $bit1 b1
  upvar $bit2 b2

  set f .linespecial
  if [Dialog_Create $f "Select line special activation" -borderwidth 10] {
    if { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
      listbox $f.data -height 6 -width 40 -font input
    } else {
      listbox $f.data -height 7 -width 40 -font input
    }
    button $f.ok -text "Set" -font widgets -command {set lspecial(ok) 1}
    button $f.ca -text "Cancel" -font widgets -command {set lspecial(ok) 0}
    grid $f.data -columnspan 2 -sticky news
    grid $f.ok $f.ca -sticky n -padx 10 -pady 5

    $f.data insert end "Player crosses the line"
    $f.data insert end "Player uses the line"
    $f.data insert end "Monster crosses the line"
    $f.data insert end "Projectile impacts the wall"
    $f.data insert end "Player pushes the wall"
    $f.data insert end "Projectile crosses the line"
    if { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
      $f.data insert end "Player uses line, but pass through usage"
    }

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set lspecial(ok) 0

  $f.data selection clear 0 end
  set val [expr $b0 * 1 + $b1 * 2 + $b2 * 4]
  $f.data selection set $val

  Dialog_Wait $f lspecial(ok) $f.data
  Dialog_Dismiss $f

  if { $lspecial(ok) != 1 } {
    return
  }

  set val [$f.data curselection]

  if { $val & 1 } {
    set b0 1
  } else {
    set b0 0
  }
  if { $val & 2 } {
    set b1 1
  } else {
    set b1 0
  }
  if { $val & 4 } {
    set b2 1
  } else {
    set b2 0
  }
}

#
# Dialog to pick a wall texture
#
proc WallTexturePick { var } {
  global cadconf mapinfo editwtex editline wtexlist

  upvar $var v

  # create custom dialog to pick wall textures
  set f .wtexpick
  if [Dialog_Create $f "Wall Texture Picker"] {
    frame $f.list -borderwidth 2 -relief raised
    set tex [listbox $f.list.li -yscrollcommand {.wtexpick.list.sc set} \
	-font input -height 5 -width 12]
    scrollbar $f.list.sc -command {.wtexpick.list.li yview} -orient vertical \
	-width 10
    grid $f.list.li $f.list.sc -sticky news
    grid columnconfigure $f.list 2 -weight 1
    bind $f.list.li <ButtonRelease-1> UpdateWTexInfo
    bind $f.list.li <KeyRelease-Up> UpdateWTexInfo
    bind $f.list.li <KeyRelease-Down> UpdateWTexInfo
    bind $f.list.li <KeyRelease-End> {
	.wtexpick.list.li activate end
	.wtexpick.list.li see end
	.wtexpick.list.li selection clear 0 end
	.wtexpick.list.li selection set end
	UpdateWTexInfo
    }
    bind $f.list.li <KeyRelease-Home> {
	.wtexpick.list.li activate 0
	.wtexpick.list.li see 0
	.wtexpick.list.li selection clear 0 end
	.wtexpick.list.li selection set 0
	UpdateWTexInfo
    }
    bind $f.list.li <KeyRelease-Prior> {
	.wtexpick.list.li yview scroll -1 pages
	.wtexpick.list.li activate @0,0
	.wtexpick.list.li selection clear 0 end
	.wtexpick.list.li selection set [.wtexpick.list.li index active]
	UpdateWTexInfo
    }
    bind $f.list.li <KeyRelease-Next> {
	.wtexpick.list.li yview scroll 1 pages
	.wtexpick.list.li activate @0,0
	.wtexpick.list.li selection clear 0 end
	.wtexpick.list.li selection set [.wtexpick.list.li index active]
	UpdateWTexInfo
    }
    frame $f.info -borderwidth 2 -relief raised
    label $f.info.l1 -text "Width" -font widgets
    entry $f.info.wi -width 4 -relief sunken -textvariable editwtex(width) \
	-font input -exportselection 0
    label $f.info.l2 -text "Height" -font widgets
    entry $f.info.hi -width 4 -relief sunken -textvariable editwtex(hight) \
	-font input -exportselection 0
    label $f.info.l3 -text "Patches" -font widgets
    entry $f.info.pa -width 4 -relief sunken -textvariable editwtex(patches) \
	-font input -exportselection 0
    grid $f.info.l1 $f.info.wi -sticky w
    grid $f.info.l2 $f.info.hi -sticky w
    grid $f.info.l3 $f.info.pa -sticky w
    grid columnconfigure $f.info 2 -weight 1
    $f.info.wi config -state disabled
    $f.info.hi config -state disabled
    $f.info.pa config -state disabled
    frame $f.im -borderwidth 2 -relief raised
    canvas $f.im.c -background $mapinfo(bg) -borderwidth 1 \
	-highlightthickness 0 -width 256 -height 128 -relief sunken
    label $f.im.l1 -text "Gamma" -font widgets
    entry $f.im.ga -width 4 -relief sunken -textvariable cadconf(wtex_gamma) \
	-font input -exportselection 0
    button $f.im.p -text "+" -font widgets -command {ChangeWTGamma +0.1}
    bind $f.im.p <Enter> {Create_Balloon %W %X %Y "Increment gamma correction"}
    bind $f.im.p <Leave> {Delete_Balloon}
    button $f.im.m -text "-" -font widgets -command {ChangeWTGamma -0.1}
    bind $f.im.m <Enter> {Create_Balloon %W %X %Y "Decrement gamma correction"}
    bind $f.im.m <Leave> {Delete_Balloon}
    grid $f.im.c -columnspan 4 -sticky w -pady 2
    grid $f.im.l1 $f.im.ga $f.im.p $f.im.m -sticky w
    $f.im.ga config -state disabled
    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets \
	-command {set editwtex(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets -command {set editwtex(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.list -row 0 -column 0 -sticky news
    grid $f.info -row 1 -column 0 -sticky news
    grid $f.im -row 0 -column 1 -rowspan 2 -sticky news
    grid $f.cntl -row 2 -column 0 -columnspan 2 -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editwtex(ok) 0

  $f.list.li delete 0 end
  foreach {na va} [array get wtexlist] {
    lappend i $na
  }
  eval {$f.list.li insert end} [lsort $i]

  $f.list.li selection set 0

  set i 0
  foreach j [$f.list.li get 0 end] {
    if { [string compare $j $v] == 0 } {
      $f.list.li selection clear 0 end
      $f.list.li selection set $i
      $f.list.li activate $i
      $f.list.li see $i
      break
    }
    incr i
  }

  UpdateWTexInfo

  Dialog_Wait $f editwtex(ok) $f.list.li
  Dialog_Dismiss $f

  if { $editwtex(ok) == 1 } {
    set $var [$f.list.li get [$f.list.li curselection]]
  }
}

#
# Update the info for wall texture selected
#
proc UpdateWTexInfo {} {
  global cadconf mapinfo editwtex wtexlist

  set tex [.wtexpick.list.li get [.wtexpick.list.li curselection]]

  set editwtex(width) [lindex $wtexlist($tex) 1]
  set editwtex(hight) [lindex $wtexlist($tex) 2]
  set editwtex(patches) [lindex $wtexlist($tex) 3]

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set tdir [file join $cadconf(doomconfdir) textures]
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set tdir [file join $cadconf(doom2confdir) textures]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set tdir [file join $cadconf(xdoomconfdir) textures]
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set tdir [file join $cadconf(xdoomplusconfdir) textures]
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set tdir [file join $cadconf(hexenconfdir) textures]
  }

  set fn [lindex $wtexlist($tex) 0]
  if { ![file exists $fn] } {
    set fn [file join $tdir [lindex $wtexlist($tex) 0]]
    if { ![file exists $fn] } {
      set fn [file join $mapinfo(mapdir) [lindex $wtexlist($tex) 0]]
    }
  }

  .wtexpick.im.c delete all

  if { [file exists $fn] } {
    image create photo texture -file $fn -height 128 -width 256 \
	-gamma $cadconf(wtex_gamma) -palette 8/8/8
    .wtexpick.im.c create image 0 0 -image texture -anchor nw
  }
}

#
# Change the gamma correction for displayed wall textures
#
proc ChangeWTGamma { val } {
  global cadconf

  if { $val > 0.0 && $cadconf(wtex_gamma) < 2.0 } {
    set cadconf(wtex_gamma) [expr $cadconf(wtex_gamma) + $val]
    UpdateWTexInfo
  } elseif { $val < 0.0 && $cadconf(wtex_gamma) > 0.5 } {
    set cadconf(wtex_gamma) [expr $cadconf(wtex_gamma) + $val]
    UpdateWTexInfo
  }
}

#
# Dialog for selecting linedef type, Doom style linedefs
#
proc PickLdefTypeDoom { var } {
  global mapinfo editldeftype ldeftypelist

  upvar $var val

  # custom dialog to select the linedef type
  set f .pickldef
  if [Dialog_Create $f "Linedef Type Picker"] {
    frame $f.sel -borderwidth 2 -relief raised
    listbox $f.sel.ty -yscrollcommand {.pickldef.sel.sc set} -font input \
	-height 3 -width 70
    scrollbar $f.sel.sc -command {.pickldef.sel.ty yview} \
	-orient vertical -width 10
    grid $f.sel.ty $f.sel.sc -sticky nsw -pady 2
    bind $f.sel.ty <ButtonRelease-1> ShowLdefInfoDoom
    bind $f.sel.ty <KeyRelease-Up> ShowLdefInfoDoom
    bind $f.sel.ty <KeyRelease-Down> ShowLdefInfoDoom
    bind $f.sel.ty <KeyRelease-End> {
	.pickldef.sel.ty activate end
	.pickldef.sel.ty see end
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set end
	ShowLdefInfoDoom
    }
    bind $f.sel.ty <KeyRelease-Home> {
	.pickldef.sel.ty activate 0
	.pickldef.sel.ty see 0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set 0
	ShowLdefInfoDoom
    }
    bind $f.sel.ty <KeyRelease-Prior> {
	.pickldef.sel.ty yview scroll -1 pages
	.pickldef.sel.ty activate @0,0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set [.pickldef.sel.ty index active]
	ShowLdefInfoDoom
    }
    bind $f.sel.ty <KeyRelease-Next> {
	.pickldef.sel.ty yview scroll 1 pages
	.pickldef.sel.ty activate @0,0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set [.pickldef.sel.ty index active]
	ShowLdefInfoDoom
    }

    frame $f.info -borderwidth 2 -relief raised
    label $f.info.l1 -text "Type No." -font widgets
    entry $f.info.no -width 4 -relief sunken -textvariable editldeftype(num) \
	-font input -exportselection 0
    $f.info.no config -state disabled
    label $f.info.l2 -text "Class" -font widgets
    entry $f.info.cl -width 10 -relief sunken -textvariable editldeftype(class)\
	-font input -exportselection 0
    $f.info.cl config -state disabled
    label $f.info.l3 -text "Speed" -font widgets
    entry $f.info.sp -width 10 -relief sunken -textvariable editldeftype(speed)\
	-font input -exportselection 0
    $f.info.sp config -state disabled
    label $f.info.l4 -text "Wait" -font widgets
    entry $f.info.wa -width 10 -relief sunken -textvariable editldeftype(wait) \
	-font input -exportselection 0
    $f.info.wa config -state disabled
    label $f.info.l5 -text "Trigger Conditions:" -font widgets
    checkbutton $f.info.b1 -text "No tag" -font widgets \
	-variable editldeftype(trig_tag)
    $f.info.b1 config -state disabled
    checkbutton $f.info.b2 -text "Switch" -font widgets \
	-variable editldeftype(trig_sw)
    $f.info.b2 config -state disabled
    checkbutton $f.info.b3 -text "Walk over" -font widgets \
	-variable editldeftype(trig_wa)
    $f.info.b3 config -state disabled
    checkbutton $f.info.b4 -text "Gunshot" -font widgets \
	-variable editldeftype(trig_ga)
    $f.info.b4 config -state disabled
    checkbutton $f.info.b5 -text "Once" -font widgets \
	-variable editldeftype(trig_once)
    $f.info.b5 config -state disabled
    checkbutton $f.info.b6 -text "Repeatedly" -font widgets \
	-variable editldeftype(trig_rep)
    $f.info.b6 config -state disabled
    checkbutton $f.info.b7 -text "Monster" -font widgets \
	-variable editldeftype(trig_mon)
    $f.info.b7 config -state disabled
    grid $f.info.l1 $f.info.no $f.info.l2 $f.info.cl -sticky w -pady 2 -padx 2
    grid $f.info.l3 $f.info.sp $f.info.l4 $f.info.wa -sticky w -pady 2 -padx 2
    grid $f.info.l5 -row 2 -column 0 -columnspan 2 -sticky w -pady 2
    grid $f.info.b1 -row 2 -column 2 -sticky w -pady 2 -padx 2
    grid $f.info.b2 -row 3 -column 2 -sticky w -pady 2 -padx 2
    grid $f.info.b3 -row 3 -column 3 -sticky w -pady 2 -padx 2
    grid $f.info.b4 -row 3 -column 4 -sticky w -pady 2 -padx 2
    grid $f.info.b5 -row 4 -column 2 -sticky w -pady 2 -padx 2
    grid $f.info.b6 -row 4 -column 3 -sticky w -pady 2 -padx 2
    grid $f.info.b7 -row 4 -column 4 -sticky w -pady 2 -padx 2

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "Set" -font widgets \
	-command {set editldeftype(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets \
	-command {set editldeftype(ok) 0}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.sel -sticky news
    grid $f.info -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editldeftype(ok) 0

  set found 0
  $f.sel.ty delete 0 end
  for {set i 0} {$i < $mapinfo(no_ldeftypes)} {incr i} {
    $f.sel.ty insert end [lindex $ldeftypelist($i) 5]
    if { $val == [lindex $ldeftypelist($i) 0] } {
      $f.sel.ty selection set $i
      $f.sel.ty activate $i
      $f.sel.ty see $i
      set found 1
    }
  }
  $f.sel.ty insert end "UNKNOWN"

  if { !$found } {
    $f.sel.ty selection set end
    $f.sel.ty activate end
    $f.sel.ty see end
  }

  ShowLdefInfoDoom

  Dialog_Wait $f editldeftype(ok) $f.sel.ty
  Dialog_Dismiss $f

  if { $editldeftype(ok) == 1 } {
    set val [lindex $ldeftypelist([$f.sel.ty curselection]) 0]
  }
}

#
# Show the informations about the current selected linedef type
# for Doom style linedefs
#
proc ShowLdefInfoDoom {} {
  global editldeftype ldeftypelist

  if { ![info exists ldeftypelist([.pickldef.sel.ty curselection])] } {
    set editldeftype(num) "-"
    set editldeftype(class) "-"
    set editldeftype(speed) "-"
    set editldeftype(wait) "-"
    return
  }

  set editldeftype(num) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 0]
  set editldeftype(class) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 1]
  set editldeftype(speed) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 3]
  set editldeftype(wait) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 4]

  set trigger [lindex $ldeftypelist([.pickldef.sel.ty curselection]) 2]

  if { [string compare [string index $trigger 0] "N"] == 0 } {
    set editldeftype(trig_tag) 1
  } else {
    set editldeftype(trig_tag) 0
  }

  switch -- [string index $trigger 1] {
    S {
      set editldeftype(trig_sw) 1
      set editldeftype(trig_wa) 0
      set editldeftype(trig_ga) 0
    }
    W {
      set editldeftype(trig_sw) 0
      set editldeftype(trig_wa) 1
      set editldeftype(trig_ga) 0
    }
    G {
      set editldeftype(trig_sw) 0
      set editldeftype(trig_wa) 0
      set editldeftype(trig_ga) 1
    }
    default {
      set editldeftype(trig_sw) 0
      set editldeftype(trig_wa) 0
      set editldeftype(trig_ga) 0
    }
  }

  switch -- [string index $trigger 2] {
    1 {
      set editldeftype(trig_once) 1
      set editldeftype(trig_rep) 0
    }
    R {
      set editldeftype(trig_once) 0
      set editldeftype(trig_rep) 1
    }
    default {
      set editldeftype(trig_once) 0
      set editldeftype(trig_rep) 0
    }
  }

  if { [string compare [string index $trigger 3] "M"] == 0 } {
    set editldeftype(trig_mon) 1
  } else {
    set editldeftype(trig_mon) 0
  }
}

#
# Dialog for selecting linedef type, Hexen style linedefs
#
proc PickLdefTypeHexen { var } {
  global mapinfo editldeftype ldeftypelist

  upvar $var val

  # custom dialog to select linedef type
  set f .pickldef
  if [Dialog_Create $f "Linedef Type Picker"] {
    frame $f.sel -borderwidth 2 -relief raised
    listbox $f.sel.ty -yscrollcommand {.pickldef.sel.sc set} -font input \
	-height 3 -width 70
    scrollbar $f.sel.sc -command {.pickldef.sel.ty yview} \
	-orient vertical -width 10
    grid $f.sel.ty $f.sel.sc -sticky nsw -pady 2
    bind $f.sel.ty <ButtonRelease-1> ShowLdefInfoHexen
    bind $f.sel.ty <KeyRelease-Up> ShowLdefInfoHexen
    bind $f.sel.ty <KeyRelease-Down> ShowLdefInfoHexen
    bind $f.sel.ty <KeyRelease-End> {
	.pickldef.sel.ty activate end
	.pickldef.sel.ty see end
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set end
	ShowLdefInfoHexen
    }
    bind $f.sel.ty <KeyRelease-Home> {
	.pickldef.sel.ty activate 0
	.pickldef.sel.ty see 0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set 0
	ShowLdefInfoHexen
    }
    bind $f.sel.ty <KeyRelease-Prior> {
	.pickldef.sel.ty yview scroll -1 pages
	.pickldef.sel.ty activate @0,0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set [.pickldef.sel.ty index active]
	ShowLdefInfoHexen
    }
    bind $f.sel.ty <KeyRelease-Next> {
	.pickldef.sel.ty yview scroll 1 pages
	.pickldef.sel.ty activate @0,0
	.pickldef.sel.ty selection clear 0 end
	.pickldef.sel.ty selection set [.pickldef.sel.ty index active]
	ShowLdefInfoHexen
    }

    frame $f.info -borderwidth 2 -relief raised
    label $f.info.l1 -text "Type No." -font widgets
    entry $f.info.no -width 4 -relief sunken -textvariable editldeftype(num) \
	-font input -exportselection 0
    $f.info.no config -state disabled
    label $f.info.l2 -text "Class" -font widgets
    entry $f.info.cl -width 8 -relief sunken -textvariable editldeftype(class) \
	-font input -exportselection 0
    $f.info.cl config -state disabled
    label $f.info.l3 -text "Arg1" -font widgets
    entry $f.info.a1 -width 8 -relief sunken -textvariable editldeftype(a1) \
	-font input -exportselection 0
    $f.info.a1 config -state disabled
    label $f.info.l4 -text "Arg2" -font widgets
    entry $f.info.a2 -width 8 -relief sunken -textvariable editldeftype(a2) \
        -font input -exportselection 0
    $f.info.a2 config -state disabled
    label $f.info.l5 -text "Arg3" -font widgets
    entry $f.info.a3 -width 8 -relief sunken -textvariable editldeftype(a3) \
        -font input -exportselection 0
    $f.info.a3 config -state disabled
    label $f.info.l6 -text "Arg4" -font widgets
    entry $f.info.a4 -width 8 -relief sunken -textvariable editldeftype(a4) \
        -font input -exportselection 0
    $f.info.a4 config -state disabled
    label $f.info.l7 -text "Arg5" -font widgets
    entry $f.info.a5 -width 8 -relief sunken -textvariable editldeftype(a5) \
        -font input -exportselection 0
    $f.info.a5 config -state disabled
    grid $f.info.l1 $f.info.no $f.info.l2 $f.info.cl -sticky w -pady 2 -padx 2
    grid $f.info.l3 $f.info.a1 $f.info.l4 $f.info.a2 $f.info.l5 $f.info.a3 \
	$f.info.l6 $f.info.a4 $f.info.l7 $f.info.a5 -sticky w -pady 2 -padx 2

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "Set" -font widgets \
	-command {set editldeftype(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets \
	-command {set editldeftype(ok) 0}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.sel -sticky news
    grid $f.info -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set editldeftype(ok) 0

  set found 0
  $f.sel.ty delete 0 end
  for {set i 0} {$i < $mapinfo(no_ldeftypes)} {incr i} {
    $f.sel.ty insert end [lindex $ldeftypelist($i) 7]
    if { $val == [lindex $ldeftypelist($i) 0] } {
      $f.sel.ty selection set $i
      $f.sel.ty activate $i
      $f.sel.ty see $i
      set found 1
    }
  }
  $f.sel.ty insert end "UNKNOWN"

  if { !$found } {
    $f.sel.ty selection set end
    $f.sel.ty activate end
    $f.sel.ty see end
  }

  ShowLdefInfoHexen

  Dialog_Wait $f editldeftype(ok) $f.sel.ty
  Dialog_Dismiss $f

  if { $editldeftype(ok) == 1 } {
    set val [lindex $ldeftypelist([$f.sel.ty curselection]) 0]
  }
}

#
# Show the informations about the current selected linedef type
# for Hexen style linedefs
#
proc ShowLdefInfoHexen {} {
  global editldeftype ldeftypelist

  if { ![info exists ldeftypelist([.pickldef.sel.ty curselection])] } {
    set editldeftype(num) "-"
    return
  }

  set editldeftype(num) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 0]
  set editldeftype(class) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 1]
  set editldeftype(a1) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 2]
  set editldeftype(a2) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 3]
  set editldeftype(a3) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 4]
  set editldeftype(a4) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 5]
  set editldeftype(a5) \
	[lindex $ldeftypelist([.pickldef.sel.ty curselection]) 6]
}

#
# Prefab Room
#
proc AddRoom {} {
  global cadconf mapinfo mapdata lines addroom
  global min_x min_y max_x max_y scale

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  set addroom(width) $cadconf(def_room_width)
  set addroom(height) $cadconf(def_room_height)

  # create custom dialog for defining the room
  set f .addroom
  if [Dialog_Create $f "Room Prefab"] {
    frame $f.data -borderwidth 2 -relief raised
    label $f.data.l1 -text "Width" -font widgets
    entry $f.data.w -width 5 -relief sunken -textvariable addroom(width) \
	-font input
    label $f.data.l2 -text "Height" -font widgets
    entry $f.data.h -width 5 -relief sunken -textvariable addroom(height) \
	-font input
    grid $f.data.l1 $f.data.w $f.data.l2 $f.data.h -sticky w

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets -command {set addroom(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets -command {set addroom(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.data -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set addroom(ok) 0

  Dialog_Wait $f addroom(ok) $f.data.w
  Dialog_Dismiss $f

  # if user canceled get out here
  if { $addroom(ok) == 2 } {
    return
  }

  # calculate the coordinates of the upper left corner in the view
  set xv0 [expr $min_x + \
	round([lindex [.top.draw.canvas xview] 0] * ($max_x - $min_x))]
  set yv0 [expr $min_y + \
	round([lindex [.top.draw.canvas yview] 0] * ($max_y - $min_y))]
  
  # get current width and height of the drawing canvas
  set w [winfo width .top.draw.canvas]
  set h [winfo height .top.draw.canvas]

  # now calculate upper left corner for the new room, so that it appears
  # arround the center of view
  set x [expr round($xv0 + ($w / 2 / $scale) - ($addroom(width) / 2))]
  set y [expr round($yv0 + ($h / 2 / $scale) - ($addroom(height) / 2))]

  # save this coordinates
  set addroom(cur_x) $x
  set addroom(cur_y) $y

  # outline a red box with the size of the new room at the calculated
  # coordinates
  .top.draw.canvas create rectangle $x $y [expr $x + $addroom(width)] \
	[expr $y + $addroom(height)] -outline red -width 1 -tags newroom

  # save the current bindings of the drawing canvas, we are going to use
  set addroom(old_b1) [bind .top.draw.canvas <Button-1>]
  set addroom(old_motion) [bind .top.draw.canvas <Motion>]
  set addroom(old_esc) [bind .top.draw.canvas <Escape>]

  # now setup new bindings so that the outlined room can be dragged
  bind .top.draw.canvas <Motion> {DragNewRoom %W %x %y}
  bind .top.draw.canvas <Button-1> {NewRoomDone}
  bind .top.draw.canvas <Escape> {NewRoomAborted}

  # wait until user positioned the new room or aborted
  set addroom(ok) 0
  tkwait variable addroom(ok)

  # restore old bindings of the canvas we saved before
  bind .top.draw.canvas <Motion> $addroom(old_motion)
  bind .top.draw.canvas <Button-1> $addroom(old_b1)
  bind .top.draw.canvas <Escape> $addroom(old_esc)

  # remove the outlined room from the drawing canvas
  .top.draw.canvas delete newroom

  # if user aborted with ESC get out here
  if { $addroom(ok) == 2 } {
    return
  }

  # alright, user wants the room, get shovel, concrete... tee hee hee

  set v1 [AddVertex $addroom(cur_x) $addroom(cur_y) .top.draw.canvas 0]
  set v2 [AddVertex [expr $addroom(cur_x) + $addroom(width)] \
	$addroom(cur_y) .top.draw.canvas 0]
  set l1 [AddLine $v1 $v2]
  set v3 [AddVertex [expr $addroom(cur_x) + $addroom(width)] \
	[expr $addroom(cur_y) + $addroom(height)] .top.draw.canvas 0]
  set l2 [AddLine $v2 $v3]
  set v4 [AddVertex $addroom(cur_x) [expr $addroom(cur_y) + $addroom(height)] \
	.top.draw.canvas 0]
  set l3 [AddLine $v3 $v4]
  set l4 [AddLine $v4 $v1]

  # make sure the lines get drawn
  RedrawLines $v1
  RedrawLines $v3

  # ok, that was the shovel part, now off to the concrete...

  # stick the default texture on each right sidedefs middle texture
  # of all new lines
  set lines($l1,rightsdef) \
	[lreplace $lines($l1,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l2,rightsdef) \
	[lreplace $lines($l2,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l3,rightsdef) \
	[lreplace $lines($l3,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l4,rightsdef) \
	[lreplace $lines($l4,rightsdef) 5 5 $cadconf(def_texture)]

  # set linedef flags so that the walls are impassable
  set lines($l1) [lreplace $lines($l1) 2 2 1]
  set lines($l2) [lreplace $lines($l2) 2 2 1]
  set lines($l3) [lreplace $lines($l3) 2 2 1]
  set lines($l4) [lreplace $lines($l4) 2 2 1]

  # so far so good, now the heavy stuff, we need an excavator...

  # create a new sector, let user edit it and make the righ sidedef of
  # all new lines point to this new sector
  set s1 [AddSector]
  set lines($l1,rightsdef) [lreplace $lines($l1,rightsdef) 0 0 $s1]
  set lines($l2,rightsdef) [lreplace $lines($l2,rightsdef) 0 0 $s1]
  set lines($l3,rightsdef) [lreplace $lines($l3,rightsdef) 0 0 $s1]
  set lines($l4,rightsdef) [lreplace $lines($l4,rightsdef) 0 0 $s1]

  # finaly we need to recalculate the map size
  NewMinMax

  # now that was hard work, can we have a beer??
  set mapdata(modified) 1
}

#
# Drag the new outlined room arround on the drawing canvas
#
proc DragNewRoom { can x y } {
  global addroom scale objinfo

  # map from view coordinates to canvas coordinates and snap on grid maybe
  set x [SnapOnX [$can canvasx $x]]
  set y [SnapOnY [$can canvasy $y]]
  set x [expr $x / $scale]
  set y [expr $y / $scale]

  # move the outlined new room
  set dx [expr $x - $addroom(cur_x)]
  set dy [expr $y - $addroom(cur_y)]
  $can move newroom $dx $dy
  set addroom(cur_x) $x
  set addroom(cur_y) $y

  set objinfo(x) $x
  set objinfo(y) [expr -$y]
}

#
# New room positioned, poke variable
#
proc NewRoomDone {} {
  global addroom

  ClearInfo
  set addroom(ok) 1
}

#
# Positioning the new room was aborted with ESC, poke variable
#
proc NewRoomAborted {} {
  global addroom

  ClearInfo
  set addroom(ok) 2
}

#
# Prefab Object
#
proc AddObject {} {
  global cadconf mapinfo mapdata lines addobject
  global min_x min_y max_x max_y scale

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  set addobject(width) $cadconf(def_obj_width)
  set addobject(height) $cadconf(def_obj_height)

  # create custom dialog for defining the object
  set f .addobject
  if [Dialog_Create $f "Object Prefab"] {
    frame $f.data -borderwidth 2 -relief raised
    label $f.data.l1 -text "Width" -font widgets
    entry $f.data.w -width 5 -relief sunken -textvariable addobject(width) \
	-font input
    label $f.data.l2 -text "Height" -font widgets
    entry $f.data.h -width 5 -relief sunken -textvariable addobject(height) \
	-font input
    grid $f.data.l1 $f.data.w $f.data.l2 $f.data.h -sticky w

    frame $f.cntl -borderwidth 2 -relief raised
    button $f.cntl.ok -text "  Set  " -font widgets \
	-command {set addobject(ok) 1}
    button $f.cntl.ca -text "Cancel" -font widgets \
	-command {set addobject(ok) 2}
    grid $f.cntl.ok $f.cntl.ca -sticky w -padx 10 -pady 5

    grid $f.data -sticky news
    grid $f.cntl -sticky news

    wm resizable $f 0 0
    Dialog_Show $f
  }

  set addobject(ok) 0

  Dialog_Wait $f addobject(ok) $f.data.w
  Dialog_Dismiss $f

  # if user canceled get out here
  if { $addobject(ok) == 2 } {
    return
  }

  # calculate the coordinates of the upper left corner in the view
  set xv0 [expr $min_x + \
        round([lindex [.top.draw.canvas xview] 0] * ($max_x - $min_x))]
  set yv0 [expr $min_y + \
        round([lindex [.top.draw.canvas yview] 0] * ($max_y - $min_y))]

  # get current width and height of the drawing canvas
  set w [winfo width .top.draw.canvas]
  set h [winfo height .top.draw.canvas]

  # now calculate upper left corner for the new object, so that it appears
  # arround the center of view
  set x [expr round($xv0 + ($w / 2 / $scale) - ($addobject(width) / 2))]
  set y [expr round($yv0 + ($h / 2 / $scale) - ($addobject(height) / 2))]

  # save this coordinates
  set addobject(cur_x) $x
  set addobject(cur_y) $y

  # outline a red box with the size of the new object at the calculated
  # coordinates
  .top.draw.canvas create rectangle $x $y [expr $x + $addobject(width)] \
	[expr $y + $addobject(height)] -outline red -width 1 -tags newobject

  # save the current bindings of the drawing canvas, we are going to use
  set addobject(old_b1) [bind .top.draw.canvas <Button-1>]
  set addobject(old_motion) [bind .top.draw.canvas <Motion>]
  set addobject(old_esc) [bind .top.draw.canvas <Escape>]

  # now setup new bindings so that the outlined object can be dragged
  bind .top.draw.canvas <Motion> {DragNewObject %W %x %y}
  bind .top.draw.canvas <Button-1> {NewObjectDone}
  bind .top.draw.canvas <Escape> {NewObjectAborted}

  # wait until user positioned the new object or aborted
  set addobject(ok) 0
  tkwait variable addobject(ok)

  # restore old bindings of the canvas we saved before
  bind .top.draw.canvas <Motion> $addobject(old_motion)
  bind .top.draw.canvas <Button-1> $addobject(old_b1)
  bind .top.draw.canvas <Escape> $addobject(old_esc)

  # remove the outlined object from the drawing canvas
  .top.draw.canvas delete newobject

  # if user aborted with ESC get out here
  if { $addobject(ok) == 2 } {
    return
  }

  # construct new object
  set v1 [AddVertex $addobject(cur_x) $addobject(cur_y) .top.draw.canvas 0]
  set v2 [AddVertex [expr $addobject(cur_x) + $addobject(width)] \
	$addobject(cur_y) .top.draw.canvas 0]
  set l1 [AddLine $v2 $v1]
  set v3 [AddVertex [expr $addobject(cur_x) + $addobject(width)] \
        [expr $addobject(cur_y) + $addobject(height)] .top.draw.canvas 0]
  set l2 [AddLine $v3 $v2]
  set v4 [AddVertex $addobject(cur_x) [expr $addobject(cur_y) + \
	$addobject(height)] .top.draw.canvas 0]
  set l3 [AddLine $v4 $v3]
  set l4 [AddLine $v1 $v4]

  # make sure the lines get drawn
  RedrawLines $v1
  RedrawLines $v3

  # stick the default texture on each right sidedefs middle texture
  # of all new lines
  set lines($l1,rightsdef) \
        [lreplace $lines($l1,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l2,rightsdef) \
        [lreplace $lines($l2,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l3,rightsdef) \
        [lreplace $lines($l3,rightsdef) 5 5 $cadconf(def_texture)]
  set lines($l4,rightsdef) \
        [lreplace $lines($l4,rightsdef) 5 5 $cadconf(def_texture)]

  # set linedef flags so that the walls are impassable
  set lines($l1) [lreplace $lines($l1) 2 2 1]
  set lines($l2) [lreplace $lines($l2) 2 2 1]
  set lines($l3) [lreplace $lines($l3) 2 2 1]
  set lines($l4) [lreplace $lines($l4) 2 2 1]

  # we need to recalculate the map size
  NewMinMax

  set mapdata(modified) 1
}

#
# Drag the new outlined object arround on the drawing canvas
#
proc DragNewObject { can x y } {
  global addobject scale objinfo

  # map from view coordinates to canvas coordinates and snap on grid maybe
  set x [SnapOnX [$can canvasx $x]]
  set y [SnapOnY [$can canvasy $y]]
  set x [expr $x / $scale]
  set y [expr $y / $scale]

  # move the outlined new object
  set dx [expr $x - $addobject(cur_x)]
  set dy [expr $y - $addobject(cur_y)]
  $can move newobject $dx $dy
  set addobject(cur_x) $x
  set addobject(cur_y) $y

  set objinfo(x) $x
  set objinfo(y) [expr -$y]
}

#
# New object positioned, poke variable
#
proc NewObjectDone {} {
  global addobject

  ClearInfo
  set addobject(ok) 1
}

#
# Positioning the new object was aborted with ESC, poke variable
#
proc NewObjectAborted {} {
  global addobject

  ClearInfo
  set addobject(ok) 2
}

# ========================================================================
#		Map file read and write routines
# ========================================================================

#
# Open a map file, read the data in and draw it
#
proc ReadMap { f } {
  global cadconf mapinfo mapdata vertices lines sectors things

  set maptype 0

  # no filename? ask for one...
  if { [string length $f] == 0 } {
    if { $mapdata(modified) } {
      set x [MapNsaveError]
    }

    set typelist {
      {"WAD level map file" {".map"}}
    }

    set fn [tk_getOpenFile -initialdir $mapinfo(mapdir) -filetypes $typelist \
            -parent . -title "Open map file"]

    if { [string length $fn] == 0 } {
      return
    }
  } else {
    set fn $f
  }

  if { ![file exists $fn] } {
    NewMap $fn
    return
  }

  . config -cursor watch
  update idletasks

  set mapinfo(mapfile) [file tail $fn]
  if { [string compare [file dirname $fn] "."] != 0 } {
    set mapinfo(mapdir) [file dirname $fn]
  } else {
    set mapinfo(mapdir) [pwd]
  }

  set fd [open $fn r]

  DestroyWorld
  set line [GetNextLine $fd]

  # start parsing the file
  # while{1} abused because lack of goto
  # goto emulated with breaks then, to goto behind the loop
  # yuck, but using various flags is worse here
  while { 1 } {

    # first there must be a level start statement
    set x [scan $line {%s %d %d %d %s} keyword e l maptype game]
    if { $x < 3 || [string compare $keyword "LEVEL_START"] != 0 } {
      MapParseError "LEVEL_START marker missing or corrupt syntax"
      DestroyWorld
      break
    }

    set mapinfo(episode) $e
    set mapinfo(map) $l

    if { [string compare $game $cadconf(doom)] == 0 } {
      set mapinfo(game) $cadconf(doom)
    } elseif { [string compare $game $cadconf(hexen)] == 0 } {
      set mapinfo(game) $cadconf(hexen)
    } elseif { [string compare $game $cadconf(xdoom)] == 0 } {
      set mapinfo(game) $cadconf(xdoom)
    } elseif { [string compare $game $cadconf(xdoomplus)] == 0 } {
      set mapinfo(game) $cadconf(xdoomplus)
    } else {
      set mapinfo(game) $cadconf(doom2)
    }

    GameSelected 0 0 0

    if { $x == 3 } {
      set mapinfo(maptype) $mapinfo(map_std)
    } elseif { $maptype == 0 } {
      set mapinfo(maptype) $mapinfo(map_std)
    } elseif { $maptype == 1 } {
      set mapinfo(maptype) $mapinfo(map_ext)
    } else {
      MapParseError "Unknown map type"
      DestroyWorld
      break
    }

    # Vertices
    set line [GetNextLine $fd]
    if { [string compare $line "VERTEXES_START"] != 0 &&
	 [string compare $line "VERTICES_START"] != 0 } {
      MapParseError "VERTICES_START marker missing"
      DestroyWorld
      break
    } else {
      set lastitem 0
      while { !$lastitem } {
        set line [GetNextLine $fd]
        if { [string compare $line "VERTEXES_END"] == 0 ||
	     [string compare $line "VERTICES_END"] == 0 } {
	  set lastitem 1
        } else {
	  set n [scan $line {%s : %d %d} v x y]
	  set vertices($v) "$x [expr -$y]"
	  set vertices($v,lines) {}
	  if { $x < $mapinfo(min_x) } {
	    set mapinfo(min_x) $x
          } elseif { $x > $mapinfo(max_x) } {
	    set mapinfo(max_x) $x
	  }
	  if { $y < $mapinfo(min_y) } {
	    set mapinfo(min_y) $y
          } elseif { $y > $mapinfo(max_y) } {
	    set mapinfo(max_y) $y
	  }
          incr mapdata(no_vertices)
        }
      }
    }

    # Sectors
    set line [GetNextLine $fd]
    if { [string compare $line "SECTORS_START"] != 0 } {
      MapParseError "SECTORS_START marker missing"
      DestroyWorld
      break
    } else {
      set lastitem 0
      while { !$lastitem } {
	set line [GetNextLine $fd]
        if { [string compare $line "SECTORS_END"] == 0 } {
          set lastitem 1
        } else {
	  set n [scan $line {%s : %d %d %s %s %d %d %d} sn fh ch ft ct br fl ta]
	  set sectors($sn) "$fh $ch $ft $ct $br $fl $ta"
	  incr mapdata(no_sectors)
        }
      }
    }

    # Linedefs
    set line [GetNextLine $fd]
    if { [string compare $line "LINEDEFS_START"] != 0 } {
      MapParseError "LINEDEFS_START marker missing"
      DestroyWorld
      break
    } else {
      set lastitem 0
      set numline 0
      while { !$lastitem } {
	set line [GetNextLine $fd]
	if { [string compare $line "LINEDEFS_END"] == 0 } {
	  set lastitem 1
	} else {
	  if { $maptype == 0 } {
	    set n [scan $line {%s %s : %d %d %d} v1 v2 fl ty ta]
	    set lines(L$numline) "$v1 $v2 $fl $ty $ta 0 0 0 0"
	  } else {
	    set n [scan $line {%s %s : %d %d %d %d %d %d %d} v1 v2 fl ty \
				a1 a2 a3 a4 a5]
	    set lines(L$numline) "$v1 $v2 $fl $ty $a1 $a2 $a3 $a4 $a5"
	  }
	  # right sidedef
          set line [GetNextLine $fd]
	  set n [scan $line {%s %d %d %s %s %s} sn x y ut lt nt]
	  set lines(L$numline,rightsdef) "$sn $x $y $ut $lt $nt"
	  incr mapdata(no_sdefs)
	  # left sidedef
	  set line [GetNextLine $fd]
	  set n [scan $line {%s %d %d %s %s %s} sn x y ut lt nt]
	  if { $n > 1 } {
	    set lines(L$numline,leftsdef) "$sn $x $y $ut $lt $nt"
	    incr mapdata(no_sdefs)
	  } else {
	    set lines(L$numline,leftsdef) $sn
	  }
	  # line reference in vertices
	  lappend vertices($v1,lines) L$numline
	  lappend vertices($v2,lines) L$numline
	  incr mapdata(no_lines)
	  incr numline
	}
      }
    }

    # Things
    set line [GetNextLine $fd]
    if { [string compare $line "THINGS_START"] != 0 } {
      MapParseError "THINGS_START marker missing"
      DestroyWorld
      break
    } else {
      set lastitem 0
      set numthing 0
      while { !$lastitem } {
	set line [GetNextLine $fd]
	if { [string compare $line "THINGS_END"] == 0 } {
	  set lastitem 1
	} else {
	  if { $maptype == 0 } {
	    set n [scan $line {%d : %d %d %d %d} ty x y ang fl]
	    set things($numthing) "$ty 0 $x [expr -$y] 0 $ang $fl 0 0 0 0 0 0"
	  } else {
	    set n [scan $line {%d : %d %d %d %d %d %d %d %d %d %d %d %d} ty \
		tid x y z ang fl sp a1 a2 a3 a4 a5]
	    set things($numthing) "$ty $tid $x [expr -$y] $z $ang $fl $sp \
				   $a1 $a2 $a3 $a4 $a5"
	  }
	  incr mapdata(no_things)
	  incr numthing
	}
      }
    }

    # debugging
    # parray mapdata
    # parray vertices
    # parray lines
    # parray sectors
    # parray things

    # we never wanted to loop, get out here
    break

  }

  close $fd

  DrawWorld
  CenterMap

  set mapdata(modified) 0
  . config -cursor top_left_arrow
  update idletasks
}

#
# Save the map
#
proc WriteMap {} {
  global mapinfo mapdata vertices lines sectors things

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  set fn [file join $mapinfo(mapdir) $mapinfo(mapfile)]

  if { [file exists $fn] } {
    set fb [file join $mapinfo(mapdir) [file rootname $mapinfo(mapfile)].bak]
    file rename -force $fn $fb
  }

  set fd [open $fn w]

  if { ![string compare $mapinfo(maptype) $mapinfo(map_std)] } {
    set maptype 0
  } else {
    set maptype 1
  }

  puts $fd "# This map file was created with tkwadcad\n"
  puts $fd [format "LEVEL_START %d %d %d %s\n" $mapinfo(episode) $mapinfo(map) \
					    $maptype $mapinfo(game)]

  puts $fd " VERTEXES_START"
  # sort by vertex name, helps to diff files, but order doesn't matter
  foreach name [lsort -dictionary [array names vertices]] {
    if { [string first "," $name] != -1 } {
      continue
    }
    set value $vertices($name)
    set y [lindex $value 1]
    set value [lreplace $value 1 1 [expr -$y]]
    puts $fd [format "  %s : %d %d" $name [expr round([lindex $value 0])] \
					[expr round([lindex $value 1])]]
  }
  puts $fd " VERTEXES_END\n"

  puts $fd " SECTORS_START"
  # save the sectors sorted by name, order does matter!
  foreach name [lsort -dictionary [array names sectors]] {
    puts $fd [format "  %s : %s" $name $sectors($name)]
  }
  puts $fd " SECTORS_END\n"

  puts $fd " LINEDEFS_START"
  # save sorted by linedef name, order does matter!
  foreach name [lsort -dictionary [array names lines]] {
    if { [string first "," $name] != -1 } {
      continue
    }
    if { $maptype == 0 } {
      puts $fd [format "  %s %s : %d %d %d" [lindex $lines($name) 0] \
					    [lindex $lines($name) 1] \
					    [lindex $lines($name) 2] \
					    [lindex $lines($name) 3] \
					    [lindex $lines($name) 4]]
    } else {
      set value $lines($name)
      set value [linsert $value 2 ":"]
      puts $fd [format "  %s" $value]
    }
    puts $fd [format "   %s" $lines($name,rightsdef)]
    puts $fd [format "   %s" $lines($name,leftsdef)]
  }
  puts $fd " LINEDEFS_END\n"

  puts $fd " THINGS_START"
  # sort by thing number, helps to diff files, but order doesn't matter
  foreach name [lsort -dictionary [array names things]] {
    set value $things($name)
    set y [lindex $value 3]
    set value [lreplace $value 3 3 [expr -$y]]
    if { $maptype == 0 } {
      puts $fd [format "  %d : %d %d %d %d" [expr int([lindex $value 0])] \
					    [expr round([lindex $value 2])] \
					    [expr round([lindex $value 3])] \
					    [expr int([lindex $value 5])] \
					    [expr int([lindex $value 6])]]
    } else {
      puts $fd [format "  %d : %d %d %d %d %d %d %d %d %d %d %d %d" \
					    [expr int([lindex $value 0])] \
					    [expr int([lindex $value 1])] \
					    [expr round([lindex $value 2])] \
					    [expr round([lindex $value 3])] \
					    [expr round([lindex $value 4])] \
					    [expr int([lindex $value 5])] \
					    [expr int([lindex $value 6])] \
					    [expr int([lindex $value 7])] \
					    [expr int([lindex $value 8])] \
					    [expr int([lindex $value 9])] \
					    [expr int([lindex $value 10])] \
					    [expr int([lindex $value 11])] \
					    [expr int([lindex $value 12])]]
    }
  }
  puts $fd " THINGS_END\n"

  puts $fd "LEVEL_END"
  close $fd

  set mapdata(modified) 0
}

#
# Save map with different filename
#
proc SaveAsMap {} {
  global mapinfo

  set typelist {
    {"WAD level map file" {".map"}}
  }

  set fn [tk_getSaveFile -initialdir $mapinfo(mapdir) -filetypes $typelist \
	  -parent . -title "Save map file"]

  if { [string length $fn] == 0 } {
    return
  }

  set mapinfo(mapfile) [file tail $fn]
  if { [string compare [file dirname $fn] "."] != 0 } {
    set mapinfo(mapdir) [file dirname $fn]
  } else {
    set mapinfo(mapdir) [pwd]
  }

  WriteMap
}

#
# Create a new empty map
#
proc NewMap { fn } {
  global mapinfo mapdata

  if { $mapdata(modified) } {
    MapNsaveError
  }

  DestroyWorld
  ReadSectorList
  ReadLdefList
  ReadThingList
  ReadFlatsList
  ReadWallTextureList
  set mapinfo(mapfile) [file tail $fn]
  set mapinfo(mapdir) [file dirname $fn]
  set mapdata(modified) 0
}

# ========================================================================
#		Consistency checking
# ========================================================================

#
# Check if any sector is not referenced or has invalid sector type
#
proc CheckSectors {} {
  global sectors lines

  . config -cursor watch
  update idletasks

  # loop over all sectors
  foreach sec [array names sectors] {
    if { [string first "," $sec] != -1 } {
      continue
    }

    # check if sector type is valid
    set t [lindex $sectors($sec) 5]
    if { ![string compare [LookupSectypeDes $t] "???"] } {
      set x [SecInvalidTypeError $sec $t]
      update idletasks
      if { $x } {
	break
      }
    }

    # now loop through the lines and see if this sector is referenced
    set found 0
    foreach lin [array names lines] {
      if { [string first "," $lin] != -1 } {
	continue
      }
      if { [string compare $sec [lindex $lines($lin,leftsdef) 0]] == 0 } {
	set found 1
	break
      }
      if { [string compare $sec [lindex $lines($lin,rightsdef) 0]] == 0 } {
	set found 1
	break
      }
    }

    # sector not referenced?
    if { ! $found } {
      set x [SecNoRefError $sec]
      update idletasks
      if { $x } {
	break
      }
    }
  }

  . config -cursor top_left_arrow
  update idletasks
}

#
# Check linedef references
#
proc CheckLineRefs {} {
  global mapinfo cadconf vertices lines sectors ldeftypelist

  . config -cursor watch
  update idletasks

  # loop over all lines
  foreach lin [array names lines] {
    if { [string first "," $lin] != -1 } {
      continue
    }

    # get the vertices
    set v1 [lindex $lines($lin) 0]
    set v2 [lindex $lines($lin) 1]

    # check if the vertices exist
    if { ![info exists vertices($v1)] } {
      set x [CheckVertexError $lin $v1]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }
    if { ![info exists vertices($v2)] } {
      set x [CheckVertexError $lin $v2]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }

    # check the line references in the vertices
    set found 0
    foreach ref $vertices($v1,lines) {
      if { ![string compare $ref $lin] } {
	set found 1
	break
      }
    }
    if { !$found } {
      set x [CheckVertexLrefError $lin $v1]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }
    set found 0
    foreach ref $vertices($v2,lines) {
      if { ![string compare $ref $lin] } {
	set found 1
	break
      }
    }
    if { !$found } {
      set x [CheckVertexLrefError $lin $v2]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }

    # check if the linedef type is valid
    set t [lindex $lines($lin) 3]
    set found 0
    if { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 &&
	 $t >= 12160 && $t <= 32767 } {
      set found 1
    } else {
      for {set i 0} {$i < $mapinfo(no_ldeftypes)} {incr i} {
        if { $t == [lindex $ldeftypelist($i) 0] } {
	  set found 1
	  break
        }
      }
    }
    if { !$found } {
      set x [CheckInvalidLinetypeError $lin $t]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }

    # check if the sectors in the sidedefs exist
    if { ![array exists sectors] } {
      continue
    }
    set found 0
    foreach sec [array names sectors] {
      if { [string first "," $sec] != -1 } {
	continue
      }
      if { [string compare $sec [lindex $lines($lin,rightsdef) 0]] == 0 } {
	set found 1
	break
      }
    }
    if { !$found } {
      set x [CheckSecrefError $lin $sec "right"]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }
    if { [string compare [lindex $lines($lin,leftsdef) 0] "-"] != 0 } {
      set found 0
      foreach sec [array names sectors] {
        if { [string first "," $sec] != -1 } {
	  continue
        }
        if { [string compare $sec [lindex $lines($lin,leftsdef) 0]] == 0 } {
	  set found 1
	  break
        }
      }
      if { !$found } {
        set x [CheckSecrefError $lin $sec "left"]
        if { $x } {
	  . config -cursor top_left_arrow
	  update idletasks
	  return
        }
	update idletasks
      }
    }

  }

  . config -cursor top_left_arrow
  update idletasks
}

#
# Check the tags consistency
#
proc CheckTags {} {
  global sectors lines

  . config -cursor watch
  update idletasks

  # loop over all sectors and check if their tags are referenced
  foreach sec [array names sectors] {
    if { [string first "," $sec] != -1 } {
      continue
    }
    # if the tag != 0 see if it's referenced in a line
    set t [lindex $sectors($sec) 6]
    if { $t != 0 } {
      set found 0
      foreach lin [array names lines] {
	if { [string first "," $lin] != -1 } {
	  continue
	}
	if { [string compare $t [lindex $lines($lin) 4]] == 0 } {
	  set found 1
	  break
	}
      }
      if { !$found } {
	set x [SecTagRefError $sec $t]
	if { $x } {
	  . config -cursor top_left_arrow
	  update idletasks
	  return
	}
	update idletasks
      }
    }
  }

  # and now the other way arround
  foreach lin [array names lines] {
    if { [string first "," $lin] != -1 } {
      continue
    }
    # if the tag != 0 see if it's referenced in a sector
    set t [lindex $lines($lin) 4]
    if { [string compare $t "0"] != 0 } {
      # if it has a tag it should have a type too
      if { [string compare [lindex $lines($lin) 3] "0"] == 0 } {
	set x [LinNoTypeError $lin $t]
	if { $x } {
	  . config -cursor top_left_arrow
	  update idletasks
	  return
	}
	update idletasks
      }
      set found 0
      foreach sec [array names sectors] {
	if { [string first "," $sec] != -1 } {
	  continue
	}
	if { [string compare $t [lindex $sectors($sec) 6]] == 0 } {
	  set found 1
	}
      }
      if { !$found } {
        set x [LinTagRefError $lin $t]
        if { $x } {
	  . config -cursor top_left_arrow
	  update idletasks
	  return
        }
	update idletasks
      }
    }
  }

  . config -cursor top_left_arrow
  update idletasks
}

#
# Check all thing id's
#
proc CheckThings {} {
  global things

  . config -cursor watch
  update idletasks

  # loop over all things and check for valid id
  foreach t [array names things] {
    set id [LookupThingName [lindex $things($t) 0]]
    if { ![string compare $id "???"] } {
      set x [ThingIdError $t [lindex $things($t) 0]]
      if { $x } {
	. config -cursor top_left_arrow
	update idletasks
	return
      }
      update idletasks
    }
  }

  . config -cursor top_left_arrow
  update idletasks
}

#
# Delete all unreferenced Vertices
#
proc DelUnusedVertices {} {
  global mapdata vertices lines

  . config -cursor watch
  update idletasks

  # loop over all vertices
  foreach vert [array names vertices] {
    if { [string first "," $vert] != -1 } {
      continue
    }

    # does the vertex reference a line and if not so, delete it
    if { [string length $vertices($vert,lines)] == 0 } {
      unset vertices($vert)
      unset vertices($vert,lines)
      .top.draw.canvas delete $vert
      incr mapdata(no_vertices) -1
      set mapdata(modified) 1
    }
  }

  if { $mapdata(modified) } {
    NewMinMax
  }

  . config -cursor top_left_arrow
  update idletasks
}

# ========================================================================
#               Event handling 
# ========================================================================

#
# Game was selected, setup game dependend lists and default stuff
#
proc GameSelected { arg1 arg2 arg3 } {
  global mapinfo cadconf options

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set options(runscript) $options(pref_doom)
    set cadconf(defaultthing) 2014
    set cadconf(defsecfloor) "FLOOR0_3"
    set cadconf(defsecceil) "FLAT2"
    set cadconf(def_texture) "GRAY4"
    set cadconf(ldefpicker) PickLdefTypeDoom
    set mapinfo(maptype) $mapinfo(map_std)
    set mapinfo(bg) $mapinfo(bg_doom)
    .top.info.ep config -state normal
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set options(runscript) $options(pref_doom)
    set cadconf(defaultthing) 2014
    set cadconf(defsecfloor) "FLOOR0_3"
    set cadconf(defsecceil) "FLAT2"
    set cadconf(def_texture) "GRAY4"
    set cadconf(ldefpicker) PickLdefTypeDoom
    set mapinfo(maptype) $mapinfo(map_std)
    set mapinfo(episode) 0
    set mapinfo(bg) $mapinfo(bg_doom)
    .top.info.ep config -state disabled
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set options(runscript) $options(pref_doom)
    set cadconf(defaultthing) 2014
    set cadconf(defsecfloor) "FLOOR0_3"
    set cadconf(defsecceil) "FLAT2"
    set cadconf(def_texture) "GRAY4"
    set cadconf(ldefpicker) PickLdefTypeDoom
    set mapinfo(maptype) $mapinfo(map_std)
    set mapinfo(episode) 0
    set mapinfo(bg) $mapinfo(bg_doom)
    .top.info.ep config -state disabled
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set options(runscript) $options(pref_doom)
    set cadconf(defaultthing) 2014
    set cadconf(defsecfloor) "FLOOR0_3"
    set cadconf(defsecceil) "FLAT2"
    set cadconf(def_texture) "GRAY4"
    set cadconf(ldefpicker) PickLdefTypeHexen
    set mapinfo(maptype) $mapinfo(map_ext)
    set mapinfo(episode) 0
    set mapinfo(bg) $mapinfo(bg_doom)
    .top.info.ep config -state disabled
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set options(runscript) $options(pref_hexen)
    set cadconf(defaultthing) 10120
    set cadconf(defsecfloor) "F_001"
    set cadconf(defsecceil) "F_037"
    set cadconf(def_texture) "MONK02"
    set cadconf(ldefpicker) PickLdefTypeHexen
    set mapinfo(maptype) $mapinfo(map_ext)
    set cadconf(episode) 0
    set mapinfo(bg) $mapinfo(bg_hexen)
    .top.info.ep config -state disabled
  }
  .top.img.c configure -background $mapinfo(bg)

  # thing and line edit dialogs depend on the game, destroy them
  # to make sure that the correct dialog will be created next time
  catch { destroy .editthing }
  catch { destroy .editline }
  catch { destroy .pickldef }

  ReadSectorList
  ReadLdefList
  ReadThingList
  ReadFlatsList
  ReadWallTextureList
}

#
# Fontsize was changed
#
proc FontConf {} {
	global options winsize

	font configure widgets -size $options(fontsize)
	font configure input -size $options(fontsize)

	# drats, we have to destroy all the unmapped windows, I have
	# no clue how to resize them for the new font size, while
	# they are unmapped
	catch { destroy .compile }
	catch { destroy .run }
	catch { destroy .editsec }
	catch { destroy .picksec }
	catch { destroy .editthing }
	catch { destroy .newline }
	catch { destroy .editline }
	catch { destroy .linespecial }
	catch { destroy .wtexpick }
	catch { destroy .pickldef }
	catch { destroy .addroom }
	catch { destroy .addobject }

	update idletasks
	set winsize(x) [winfo width .]
	set winsize(y) [winfo height .]
	wm minsize . $winsize(x) [expr $winsize(y) + 30]
}

#
# Show x/y coordinates in canvas
#
proc ShowXY { x y can } {
  global objinfo scale

  # map from view coordinates to canvas coordinates
  set x [$can canvasx $x]
  set y [$can canvasy $y]

  set objinfo(x) [expr round($x / $scale)]
  set objinfo(y) [expr -round($y / $scale)]
}

#
# Rescale drawing canvas
#
proc Rescale { f } {
  global scale grid min_x min_y max_x max_y

  if { $scale <= 0.25 && $f == -0.25 } {
    return
  }
  if { $scale >= 3.0 && $f == 0.25 } {
    return
  }

  . config -cursor watch
  update idletasks

  set xv [lindex [.top.draw.canvas xview] 0]
  set yv [lindex [.top.draw.canvas yview] 0]

  set scale [expr $scale + $f]

  destroy .top.draw

  Scrolled_Canvas .top.draw [expr 12 * 64] [expr 9 * 64] $scale \
		$min_x $min_y $max_x $max_y
  grid .top.draw -row 0 -column 0 -rowspan 3 -sticky news
  grid rowconfigure .top 0 -weight 1
  grid columnconfigure .top 0 -weight 1

  GameSelected 0 0 0

  DrawGrid .top.draw $grid $min_x $min_y $max_x $max_y
  DrawWorld

  .top.draw.canvas xview moveto $xv
  .top.draw.canvas yview moveto $yv

  . config -cursor top_left_arrow
  update idletasks
}

#
# Mark canvas for dragging
#
proc MarkCanvas { can x y } {
  global canvas

  set canvas(can_mark_x) $x
  set canvas(can_mark_y) $y
  $can scan mark $x $y
}

#
# Drag the canvas
#
proc DragCanvas { can x y } {
  global canvas

  set x [expr $canvas(can_mark_x) + ($x - $canvas(can_mark_x)) / 5]
  set y [expr $canvas(can_mark_y) + ($y - $canvas(can_mark_y)) / 5]
  $can scan dragto $x $y
}

#
# Something on the canvas was marked
#
proc MarkObject { x y can } {
  global canvas

  # map from view coordinates to canvas coordinates
  set x [$can canvasx $x]
  set y [$can canvasy $y]

  # remember the object and its location
  set canvas($can,obj) [$can find withtag current]
  set canvas($can,x) $x
  set canvas($can,y) $y
}

#
# Pointer set onto a vertex
#
proc InfoVertex { x y can } {
  global objinfo vertices

  # find the vertex
  set obj [$can find withtag current]

  # get name and coordinates of the vertex
  set name [lindex [$can gettags $obj] 1]
  set x [lindex $vertices($name) 0]
  set y [lindex $vertices($name) 1]

  # print info about the vertex
  set objinfo(info) [format "Vertex %s" $name]
  set objinfo(x) [expr round($x)]
  set objinfo(y) [expr -round($y)]
}

#
# A vertex was dragged
#
proc DragVertex { x y can } {
  global mapdata objinfo canvas vertices options scale grid

  # map from view coordinates to canvas coordinates and maybe snap on grid
  set x [SnapOnX [$can canvasx $x]]
  set y [SnapOnY [$can canvasy $y]]

  # move the vertex
  set dx [expr ($x - $canvas($can,x)) / $scale]
  set dy [expr ($y - $canvas($can,y)) / $scale]
  $can move $canvas($can,obj) $dx $dy
  set canvas($can,x) $x
  set canvas($can,y) $y

  # find the vertex and update its coordinates
  set name [lindex [$can gettags $canvas($can,obj)] 1]
  set vertices($name) [lreplace $vertices($name) 0 1 \
		[expr $x / $scale] [expr $y / $scale]]

  # redraw all lines using the vertex
  RedrawLines $name

  # world size might have changed
  NewMinMax

  set objinfo(info) [format "Vertex %s" $name]
  set objinfo(x) [expr round($x / $scale)]
  set objinfo(y) [expr -round($y / $scale)]

  set mapdata(modified) 1
}

#
# Add a new Vertex
#
proc AddVertex { x y can map } {
  global mapinfo mapdata scale vertices

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  # map from view coordinates to canvas coordinates and snap on grid maybe?
  if { $map > 0 } {
    set x [SnapOnX [$can canvasx $x]]
    set y [SnapOnY [$can canvasy $y]]
    set x [expr $x / $scale]
    set y [expr $y / $scale]
  }

  # find next free vertex no. and create new vertex in memory
  for {set i 0} {$i < $mapdata(max_vertices)} {incr i} {
    if { ![info exists vertices(V$i)] } {
      break
    }
  }
  set vertices(V$i) "$x $y"
  set vertices(V$i,lines) {}

  # draw new vertice and setup bindings just in case...
  set x1 [expr $x - 3]
  set y1 [expr $y - 3]
  set x2 [expr $x + 3]
  set y2 [expr $y + 3]
  .top.draw.canvas create rectangle $x1 $y1 $x2 $y2 -fill red \
				    -tags [list vertex V$i]
  SetVerticesBinding

  # world size might have changed
  NewMinMax

  incr mapdata(no_vertices)
  set mapdata(modified) 1

  return V$i
}

#
# Delete a Vertex
#
proc DeleteVertex { x y can } {
  global mapdata vertices lines

  # find the vertex
  set obj [$can find withtag current]
  set v1 [lindex [$can gettags $obj] 1]

  # lines connected to this vertex?
  set lins $vertices($v1,lines)
  if { [string length $lins] == 0 } {
    # nope, just delete it
    .top.draw.canvas delete $obj
    unset vertices($v1)
    unset vertices($v1,lines)
    ClearInfo
    NewMinMax
    incr mapdata(no_vertices) -1
    set mapdata(modified) 1
  } elseif { [llength $lins] == 2 } {
    # two lines connected to the vertex, merge lines into one
    set l1 [lindex $lins 0]
    set l2 [lindex $lins 1]
    # delete the line which has the vertex as destination, keep the other
    if { [string compare $v1 [lindex $lines($l1) 1]] == 0 } {
      set dl $l1
      set kl $l2
    } else {
      set dl $l2
      set kl $l1
    }
    # the new from vertex for the line to keep
    set v2 [lindex $lines($dl) 0]
    # remove reference for the line to delete
    RemoveLineRef $v2 $dl
    # decrement no. of sidedefs
    incr mapdata(no_sdefs) -1
    if { [string compare [lindex $lines($dl,leftsdef) 0] "-"] != 0 } {
      incr mapdata(no_sdefs) -1
    }
    # remove line
    .top.draw.canvas delete $dl
    unset lines($dl)
    unset lines($dl,rightsdef)
    unset lines($dl,leftsdef)
    incr mapdata(no_lines) -1
    # remove vertex
    .top.draw.canvas delete $v1
    unset vertices($v1)
    unset vertices($v1,lines)
    incr mapdata(no_vertices) -1
    # fix up the line we keep
    lappend vertices($v2,lines) $kl
    set lines($kl) [lreplace $lines($kl) 0 0 $v2]
    RedrawLines $v2
    NewMinMax
    set mapdata(modified) 1
  }
}

#
# Pointer set onto a line
#
proc InfoLine { x y can } {
  global mapinfo cadconf options objinfo scale lines wtexlist

  # map from view coordinates to canvas coordinates
  set x [$can canvasx $x]
  set y [$can canvasy $y]

  # find the line
  set obj [$can find withtag current]

  # get line data
  set name [lindex [$can gettags $obj] 1]
  set v1 [lindex $lines($name) 0]
  set v2 [lindex $lines($name) 1]
  set s1 [lindex $lines($name,rightsdef) 0]
  set s2 [lindex $lines($name,leftsdef) 0]

  # calculate lenght
  set len [CalcLineLenght $name]

  # print info about the line
  set objinfo(info) \
	[format "Line %s: Vertices %s -> %s, Length %d, Sectors %s/%s" \
	$name $v1 $v2 $len $s2 $s1]
  set objinfo(x) [expr round($x / $scale)]
  set objinfo(y) [expr -round($y / $scale)]

  # show texture image if checkbutton is active
  if { $options(textureimg) } {
    # first try middle texture
    set texture [lindex $lines($name,rightsdef) 5]
    if { [string compare $texture "-"] == 0 } {
      # then try lower texture
      set texture [lindex $lines($name,rightsdef) 4]
    }
    if { [string compare $texture "-"] == 0 } {
      # finaly try upper texture
      set texture [lindex $lines($name,rightsdef) 3]
    }

    if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
      set tdir [file join $cadconf(doomconfdir) textures]
    } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
      set tdir [file join $cadconf(doom2confdir) textures]
    } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
      set tdir [file join $cadconf(xdoomconfdir) textures]
    } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
      set tdir [file join $cadconf(xdoomplusconfdir) textures]
    } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
      set tdir [file join $cadconf(hexenconfdir) textures]
    }

    # don't try to access texture which is not in the list
    if { ![info exists wtexlist($texture)] } {
      return
    }

    set fn [lindex $wtexlist($texture) 0]
    if { ![file exists $fn] } {
      set fn [file join $tdir [lindex $wtexlist($texture) 0]]
      if { ![file exists $fn] } {
	set fn [file join $mapinfo(mapdir) [lindex $wtexlist($texture) 0]]
      }
    }

    .top.img.c delete all

    if { [file exists $fn] } {
      image create photo texture -file $fn -height 128 -width 256 \
	  -gamma $cadconf(wtex_gamma) -palette 8/8/8
      .top.img.c create image 0 0 -image texture -anchor nw
    }
  }
}

#
# Add a new line with a default right sidedef
#
proc AddLine { v1 v2 } {
  global mapinfo mapdata lines vertices

    if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  # find next free line no.
  for {set i 0} {$i < $mapdata(max_lines)} {incr i} {
    if { ![info exists lines(L$i)] } {
      break
    }
  }

  # add the linedef to memory
  set lines(L$i) "$v1 $v2 0 0 0 0 0 0 0"
  set lines(L$i,rightsdef) "S0 0 0 - - -"
  set lines(L$i,leftsdef) "-"

  # add references to its vertices
  lappend vertices($v1,lines) L$i
  lappend vertices($v2,lines) L$i

  SetLinesBinding

  incr mapdata(no_lines)
  incr mapdata(no_sdefs)
  set mapdata(modified) 1

  return L$i
}

#
# Delete a line
#
proc DeleteLine { x y can } {
  global mapdata lines

  # find the line
  set obj [$can find withtag current]

  # don't try to delete grid lines
  if { [string compare [lindex [$can gettags $obj] 0] "grid"] == 0 } {
    return
  }

  # get its data
  set l1 [lindex [$can gettags $obj] 1]
  set v1 [lindex $lines($l1) 0]
  set v2 [lindex $lines($l1) 1]

  # decrement no. of sidedefs
  incr mapdata(no_sdefs) -1
  if { [string compare [lindex $lines($l1,leftsdef) 0] "-"] != 0 } {
    incr mapdata(no_sdefs) -1
  }

  # remove line
  .top.draw.canvas delete $l1
  unset lines($l1)
  unset lines($l1,rightsdef)
  unset lines($l1,leftsdef)

  # remove line links from its vertices
  RemoveLineRef $v1 $l1
  RemoveLineRef $v2 $l1

  ClearInfo
  incr mapdata(no_lines) -1
  set mapdata(modified) 1
}

#
# Split line
#
proc SplitLine { x y can } {
  global mapdata lines vertices

  # map from view coordinates to canvas coordinates
  set xv [$can canvasx $x]
  set yv [$can canvasy $y]

  # find the line
  set obj [$can find withtag current]

  # check if this is a line, don't try to split grid lines
  if { [string compare [lindex [$can gettags $obj] 0] "line"] } {
    return
  }

  # get line no. and its vertices
  set l1 [lindex [$can gettags $obj] 1]
  set v1 [lindex $lines($l1) 0]
  set v2 [lindex $lines($l1) 1]

  # remove line from canvas and add the new vertex
  .top.draw.canvas delete $l1
  set v3 [AddVertex $x $y $can 1]

  # add line reference of the splitted line to the new vertex
  lappend vertices($v3,lines) $l1

  # remove line reference of the splitted line from its second vertex
  RemoveLineRef $v2 $l1

  # replace second vertice of the line with the new one
  set lines($l1) [lreplace $lines($l1) 1 1 $v3]

  # insert a new line from the new vertex to the old second vertex
  set l2 [AddLine $v3 $v2]

  # copy flags and both sidedefs from original line to new one
  set lines($l2) [lreplace $lines($l2) 2 2 [lindex $lines($l1) 2]]
  set lines($l2,rightsdef) $lines($l1,rightsdef)
  set lines($l2,leftsdef) $lines($l1,leftsdef)

  # redraw lines referencing the new vertex
  RedrawLines $v3

  set mapdata(modified) 1
}

#
# Flip Line
#
proc FlipLine { x y can } {
  global mapdata lines vertices

  # find the line
  set obj [$can find withtag current]

  # check if this is a line, don't try to flip grid lines
  if { [string compare [lindex [$can gettags $obj] 0] "line"] } {
    return
  }

  # get line no. and its vertices
  set l1 [lindex [$can gettags $obj] 1]
  set v1 [lindex $lines($l1) 0]
  set v2 [lindex $lines($l1) 1]

  # now flip the vertices in the linedef
  set lines($l1) [lreplace $lines($l1) 0 0 $v2]
  set lines($l1) [lreplace $lines($l1) 1 1 $v1]

  # for 2s lines we need to flip the sidedefs too
  if { [string compare [lindex $lines($l1,leftsdef) 0] "-"] != 0 } {
    set rs $lines($l1,rightsdef)
    set lines($l1,rightsdef) $lines($l1,leftsdef)
    set lines($l1,leftsdef) $rs
  }

  # redraw the line
  RedrawLines $v1

  set mapdata(modified) 1
}

#
# Flip sidedefs
#
proc FlipSdefs { x y can } {
  global mapdata lines

  # find the line
  set obj [$can find withtag current]

  # check if this is a line, don't try to flip on grid lines
  if { [string compare [lindex [$can gettags $obj] 0] "line"] } {
    return
  }

  # get line number
  set l [lindex [$can gettags $obj] 1]

  # flip the sidedefs if line is 2s
  if { [string compare [lindex $lines($l,leftsdef) 0] "-"] != 0 } {
    set rs $lines($l,rightsdef)
    set lines($l,rightsdef) $lines($l,leftsdef)
    set lines($l,leftsdef) $rs
    set mapdata(modified) 1
    InfoLine $x $y $can
  }
}

#
# Copy line/linedef properties into copy/paste buffer
#
proc CopyLine { x y can } {
  global canvas lines linepastebuf

  # find the line
  set obj [$can find withtag current]
  set name [lindex [$can gettags $obj] 1]

  # copy line properties into paste buffer
  set linepastebuf(flags) [lindex $lines($name) 2]

  # copy right sidedef properties into paste buffer
  set linepastebuf(rs_x) [lindex $lines($name,rightsdef) 1]
  set linepastebuf(rs_y) [lindex $lines($name,rightsdef) 2]
  set linepastebuf(rs_ut) [lindex $lines($name,rightsdef) 3]
  set linepastebuf(rs_lt) [lindex $lines($name,rightsdef) 4]
  set linepastebuf(rs_mt) [lindex $lines($name,rightsdef) 5]

  # conditionally copy left sidedef properties into paste buffer
  if { [llength $lines($name,leftsdef)] > 1 } {
    set linepastebuf(ls_x) [lindex $lines($name,leftsdef) 1]
    set linepastebuf(ls_y) [lindex $lines($name,leftsdef) 2]
    set linepastebuf(ls_ut) [lindex $lines($name,leftsdef) 3]
    set linepastebuf(ls_lt) [lindex $lines($name,leftsdef) 4]
    set linepastebuf(ls_mt) [lindex $lines($name,leftsdef) 5]
  } else {
    set linepastebuf(ls_x) ""
    set linepastebuf(ls_y) ""
    set linepastebuf(ls_ut) ""
    set linepastebuf(ls_lt) ""
    set linepastebuf(ls_mt) ""
  }
}

#
# Paste line/linedef properties from copy/paste buffer
#
proc PasteLine { x y can } {
  global mapdata canvas lines linepastebuf

  # Copied line properties before?
  if { ![info exists linepastebuf(flags)] } {
    LinePasteError
    return
  }

  # find the line
  set obj [$can find withtag current]
  set name [lindex [$can gettags $obj] 1]

  # set line properties from paste buffer
  set lines($name) [lreplace $lines($name) 2 2 $linepastebuf(flags)]

  # save sectors of both sidedefs
  set rsec [lindex $lines($name,rightsdef) 0]
  set lsec [lindex $lines($name,leftsdef) 0]

  # set right linedef properties from paste buffer
  set lines($name,rightsdef) "$rsec $linepastebuf(rs_x) \
	$linepastebuf(rs_y) $linepastebuf(rs_ut) $linepastebuf(rs_lt) \
	$linepastebuf(rs_mt)"

  # conditionally set left sidedef properties from paste buffer
  if { [string compare $lsec "-"] != 0 &&
       [string length $linepastebuf(ls_x)] != 0 } {
    set lines($name,leftsdef) "$lsec $linepastebuf(ls_x) \
	$linepastebuf(ls_y) $linepastebuf(ls_ut) $linepastebuf(ls_lt) \
	$linepastebuf(ls_mt)"
  }

  RedrawLines [lindex $lines($name) 0]
  set mapdata(modified) 1
}

#
# Pointer set onto a thing
#
proc InfoThing { x y can } {
  global options objinfo things thinglist

  # find the thing
  set obj [$can find withtag current]

  # get thing no. and type
  set name [lindex [$can gettags $obj] 1]
  set type [lindex $things($name) 0]
  set x [lindex $things($name) 2]
  set y [lindex $things($name) 3]
  set ang [lindex $things($name) 5]

  # print info about the thing
  set objinfo(info) [ format "Thing #%s: %s facing %s" $name \
	[LookupThingName $type] [Angle2Dir $ang] ]
  set objinfo(x) [expr round($x)]
  set objinfo(y) [expr -round($y)]

  # show thing image if checkbutton is active
  if { $options(thingimg) && [info exists thinglist($type)] } {
    set sprite [lindex $thinglist($type) 2]
    UpdateThingImage .top.img.c $sprite
  }
}

#
# A thing was dragged
#
proc DragThing { x y can } {
  global mapdata objinfo canvas things scale

  # map from view coordinates to canvas coordinates and maybe snap on grid
  set x [SnapOnX [$can canvasx $x]]
  set y [SnapOnY [$can canvasy $y]]

  # move the thing
  set dx [expr ($x - $canvas($can,x)) / $scale]
  set dy [expr ($y - $canvas($can,y)) / $scale]
  $can move $canvas($can,obj) $dx $dy
  set canvas($can,x) $x
  set canvas($can,y) $y

  # figure out which thing that was and update its coordinates
  set name [lindex [$can gettags $canvas($can,obj)] 1]
  set things($name) [lreplace $things($name) 2 3 \
		[expr $x / $scale] [expr $y / $scale]]

  set objinfo(x) [expr round($x / $scale)]
  set objinfo(y) [expr -round($y / $scale)]

  set mapdata(modified) 1
}

#
# Delete a thing
#
proc DeleteThing { x y can } {
  global mapdata canvas things

  # find the thing
  set obj [$can find withtag current]
  set name [lindex [$can gettags $obj] 1]

  # delete it from canvas and memory
  .top.draw.canvas delete $obj
  unset things($name)
  ClearInfo

  set mapdata(no_things) [expr $mapdata(no_things) - 1]
  set mapdata(modified) 1
}

#
# Add a new thing
#
proc AddThing { x y can } {
  global cadconf mapinfo mapdata things scale

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  # map from view coordinates to canvas coordinates and maybe snap on grid
  set x [SnapOnX [$can canvasx $x]]
  set y [SnapOnY [$can canvasy $y]]
  set x [expr $x / $scale]
  set y [expr $y / $scale]

  # find next free thing no.
  for {set i 0} {$i < $mapdata(max_things)} {incr i} {
    if { ![info exists things($i)] } {
      break
    }
  }

  # add default thing to the things in memory at the pointer position
  if { [string compare $mapinfo(maptype) $mapinfo(map_std)] == 0 } {
    # Doom things
    set things($i) "$cadconf(defaultthing) 0 $x $y 0 0 7 0 0 0 0 0 0"
  } else {
    # Hexen things
    set things($i) "$cadconf(defaultthing) 0 $x $y 0 0 2023 0 0 0 0 0 0"
  }

  # get color for this thing
  set color [ThingColor $cadconf(defaultthing)]

  # and draw new thing
  set x1 [expr $x - 5]
  set y1 [expr $y - 5]
  set x2 [expr $x + 5]
  set y2 [expr $y + 5]
  $can create oval $x1 $y1 $x2 $y2 -fill $color -tags [list thing $i]
  SetThingsBinding

  incr mapdata(no_things)
  set mapdata(modified) 1
}

#
# Rotate a thing
#
proc RotateThing { x y can ang } {
  global mapdata things

  # get the object marked
  set obj [$can find withtag current]

  # if no object marked ignore
  if { [string length $obj] == 0 } {
    return
  }

  # check if the object is a thing and if, process
  if { [string compare [lindex [$can gettags $obj] 0] "thing"] == 0 } {
    set name [lindex [$can gettags $obj] 1]
    set newang  [expr [lindex $things($name) 5] + $ang ]
    if { $newang < 0 } {
      set newang 315
    } elseif { $newang > 315 } {
      set newang 0
    }
    set things($name) [lreplace $things($name) 5 5 $newang]
    InfoThing $x $y $can
    set mapdata(modified) 1
  }
}

#
# Copy thing properties into copy/paste buffer
#
proc CopyThing { x y can } {
  global canvas things thingpastebuf

  # find the thing
  set obj [$can find withtag current]
  set name [lindex [$can gettags $obj] 1]

  set thingpastebuf(type) [lindex $things($name) 0]
  set thingpastebuf(altitude) [lindex $things($name) 4]
  set thingpastebuf(angle) [lindex $things($name) 5]
  set thingpastebuf(flags) [lindex $things($name) 6]
  set thingpastebuf(special) [lindex $things($name) 7]
  set thingpastebuf(arg1) [lindex $things($name) 8]
  set thingpastebuf(arg2) [lindex $things($name) 9]
  set thingpastebuf(arg3) [lindex $things($name) 10]
  set thingpastebuf(arg4) [lindex $things($name) 11]
  set thingpastebuf(arg5) [lindex $things($name) 12]
}

#
# Paste thing properties from copy/paste buffer
#
proc PasteThing { x y can } {
  global mapdata canvas things thingpastebuf

  # Copied thing properties before?
  if { ![info exists thingpastebuf(type)] } {
    ThingPasteError
    return
  }

  # find the thing
  set obj [$can find withtag current]
  set name [lindex [$can gettags $obj] 1]

  set things($name) [lreplace $things($name) 0 0 $thingpastebuf(type)]
  set things($name) [lreplace $things($name) 4 4 $thingpastebuf(altitude)]
  set things($name) [lreplace $things($name) 5 5 $thingpastebuf(angle)]
  set things($name) [lreplace $things($name) 6 6 $thingpastebuf(flags)]
  set things($name) [lreplace $things($name) 7 7 $thingpastebuf(special)]
  set things($name) [lreplace $things($name) 8 8 $thingpastebuf(arg1)]
  set things($name) [lreplace $things($name) 9 9 $thingpastebuf(arg2)]
  set things($name) [lreplace $things($name) 10 10 $thingpastebuf(arg3)]
  set things($name) [lreplace $things($name) 11 11 $thingpastebuf(arg4)]
  set things($name) [lreplace $things($name) 12 12 $thingpastebuf(arg5)]

  RedrawThing $name $obj
  set mapdata(modified) 1
}

#
# Delete key was pressed on the canvas. Find out what's close to the pointer
# and delete it if possible.
#
proc DeleteSomething { x y can } {

  # get the object marked
  set obj [$can find withtag current]

  # if no object was marked, ignore
  if { [string length $obj] == 0 } {
    return
  }

  # check if the object is a vertex and if, delete it
  if { [string compare [lindex [$can gettags $obj] 0] "vertex"] == 0 } {
    DeleteVertex $x $y $can
    return
  }

  # check if the object is a line and if, delete it
  if { [string compare [lindex [$can gettags $obj] 0] "line"] == 0 } {
    DeleteLine $x $y $can
    return
  }

  # check if the object is a thing and if, delete it
  if { [string compare [lindex [$can gettags $obj] 0] "thing"] == 0 } {
    DeleteThing $x $y $can
    return
  }
}

#
# Return key was pressed on the canvas. Find out what's close to the pointer
# and edit its properties if possible.
#
proc EditSomething { x y can } {

  # get object marked
  set obj [$can find withtag current]

  # if no object was marked, ignore
  if { [string length $obj] == 0 } {
    return
  }

  MarkObject $x $y $can

  # check if the object is a line and if, edit its properties
  if { [string compare [lindex [$can gettags $obj] 0] "line"] == 0 } {
    EditLine $x $y $can
    return
  }

  # check if the object is a thing and if, edit its properties
  if { [string compare [lindex [$can gettags $obj] 0] "thing"] == 0 } {
    EditThing $x $y $can
    return
  }
}

#
# CNTL-C key was pressed on the canvas. Find out what's close to the pointer
# and copy its properties if possible.
#
proc CopySomething { x y can } {

  # get object marked
  set obj [$can find withtag current]

  # if no object was marked, ignore
  if { [string length $obj] == 0 } {
    return
  }

  # check if the object is a thing and if, copy its properties
  if { [string compare [lindex [$can gettags $obj] 0] "thing"] == 0 } {
    CopyThing $x $y $can
    return
  }

  # check if the object is a line and if, copy its properties
  if { [string compare [lindex [$can gettags $obj] 0] "line"] == 0 } {
    CopyLine $x $y $can
    return
  }
}

#
# CNTL-P key was pressed on the canvas. Find out what's close to the pointer
# and paste properties if possible.
#
proc PasteSomething { x y can } {

  # get object marked
  set obj [$can find withtag current]

  # if no object was marked, ignore
  if { [string length $obj] == 0 } {
    return
  }

  # check if the object is a thing and if, paste properties
  if { [string compare [lindex [$can gettags $obj] 0] "thing"] == 0 } {
    PasteThing $x $y $can
    return
  }

  # check if the object is a line and if, paste properties
  if { [string compare [lindex [$can gettags $obj] 0] "line"] == 0 } {
    PasteLine $x $y $can
    return
  }
}

#
# Find an unused sector no., create sector with default settings and
# enter sector editor.
#
proc AddSector {} {
  global cadconf mapinfo mapdata sectors

  if { [string length $mapinfo(mapfile)] == 0 } {
    NoMapError
    return
  }

  # find next free sector no.
  for {set i 0} {$i < $mapdata(max_sectors)} {incr i} {
    if { ![info exists sectors(S$i)] } {
      break
    }
  }

  # add sector with default settings
  set sectors(S$i) "0 128 $cadconf(defsecfloor) $cadconf(defsecceil) 144 0 0"

  # edit this sector
  EditSector S$i

  incr mapdata(no_sectors)
  set mapdata(modified) 1

  return S$i
}

#
# Connect two existing vertices with a new line
#
proc ConnectVertices { x y can } {
  global cadconf connline vertices lines
  
  # map from view coordinates to canvas coordinates
  set x [$can canvasx $x]
  set y [$can canvasy $y]

  # get the object marked
  set connline(obj1) [$can find withtag current]

  # check if this is a vertex
  if { [string compare [lindex [$can gettags $connline(obj1)] 0] "vertex"] } {
    return
  }

  # ok, get its name and coordinates
  set v1 [lindex [$can gettags $connline(obj1)] 1]
  set connline(x1) [lindex $vertices($v1) 0]
  set connline(y1) [lindex $vertices($v1) 1]
  set connline(x2) $connline(x1)
  set connline(y2) $connline(y1)

  # draw a temporary line we'll drag arround
  .top.draw.canvas create line $connline(x1) $connline(y1) \
	$connline(x2) $connline(y2) -fill red -width 1 -tags newline

  # save the current bindings of the drawing canvas, we are going to use
  set connline(old_b1) [bind .top.draw.canvas <Button-1>]
  set connline(old_motion) [bind .top.draw.canvas <Motion>]
  set connline(old_esc) [bind .top.draw.canvas <Escape>]

  # now setup new bindings, so that a line can be dragged arround
  bind .top.draw.canvas <Motion> {DragNewLine %W %x %y}
  bind .top.draw.canvas <Button-1> {NewLineDone}
  bind .top.draw.canvas <Escape> {NewLineAborted}

  # wait until user connected to a second vertex or aborted
  set connline(ok) 0
  tkwait variable connline(ok)

  # restore old bindings of the canvas we saved before
  bind .top.draw.canvas <Motion> $connline(old_motion)
  bind .top.draw.canvas <Button-1> $connline(old_b1)
  bind .top.draw.canvas <Escape> $connline(old_esc)

  # remove the temorary line we used
  .top.draw.canvas delete newline

  # if user aborted with ESC get outta here
  if { $connline(ok) == 2 } {
    return
  }

  # now, where did the user connect that line too?
  set connline(obj2) [$can find closest $connline(x2) $connline(y2)]
  if { [string compare [lindex [$can gettags $connline(obj2)] 0] "vertex"] } {
    return
  }

  # ok, is a vertex, get its name and coordinates
  set v2 [lindex [$can gettags $connline(obj2)] 1]

  # both vertices the same?
  if { [string compare $v1 $v2] == 0 } {
    return
  }

  # add the new line into the world
  set l [AddLine $v1 $v2]
  RedrawLines $v1

  # set the default texture on the right sidedef
  set lines($l,rightsdef) \
	[lreplace $lines($l,rightsdef) 5 5 $cadconf(def_texture)]

  # set linedef flag so that this line is impassable
  set lines($l) [lreplace $lines($l) 2 2 1]

  set mapdata(modified) 1
}

#
# Drag the new line arround on the drawing canvas
#
proc DragNewLine { can x y } {
  global connline scale

  # map from view coordinates to canvas coordinates
  set x [expr round([$can canvasx $x] / $scale)]
  set y [expr round([$can canvasy $y] / $scale)]

  # redraw the new line
  .top.draw.canvas delete newline
  set connline(x2) $x
  set connline(y2) $y
  .top.draw.canvas create line $connline(x1) $connline(y1) \
	$connline(x2) $connline(y2) -fill red -width 1 -tags newline
}

#
# New line positioned, poke variable
#
proc NewLineDone {} {
  global connline

  set connline(ok) 1
}

#
# Connecting line with another vertex was aborted with ESC, poke variable
#
proc NewLineAborted {} {
  global connline

  set connline(ok) 2
}

#
# Grid step changed
#
proc NewGrid { f } {
  global grid min_x min_y max_x max_y

  if { $grid <= 4.0 && $f == -1.0 } {
    return
  }
  if { $grid >= 256.0 && $f == +1.0 } {
    return
  }

  if { $f == -1.0 } {
    set grid [expr $grid / 2]
  } else {
    set grid [expr $grid * 2]
  }

  . config -cursor watch
  update idletasks

  .top.draw.canvas delete line
  .top.draw.canvas delete vertex
  .top.draw.canvas delete thing
  .top.draw.canvas delete grid

  DrawGrid .top.draw $grid $min_x $min_y $max_x $max_y
  DrawWorld

  . config -cursor top_left_arrow
  update idletasks
}

#
# Set grid to absolute size
#
proc SetGrid { s } {
  global grid min_x min_y max_x max_y

  set grid $s

  . config -cursor watch
  update idletasks

  .top.draw.canvas delete line
  .top.draw.canvas delete vertex
  .top.draw.canvas delete thing
  .top.draw.canvas delete grid

  DrawGrid .top.draw $grid $min_x $min_y $max_x $max_y
  DrawWorld

  . config -cursor top_left_arrow
  update idletasks
}

#
# Show Vertices option modified
#
proc ShowVertices {} {
  global options

  if { $options(show_vertices) == 0 } {
    .top.draw.canvas delete vertex
  } else {
    DrawVertices
  }
}

#
# Vertices option flipped with hotkey
#
proc FlipVerticesOption {} {
  global options

  if { $options(show_vertices) == 0 } {
    set options(show_vertices) 1
    DrawVertices
  } else {
    set options(show_vertices) 0
    .top.draw.canvas delete vertex
  }
}

#
# Show Things option modified
#
proc ShowThings {} {
  global options

  if { $options(show_things) == 0 } {
    .top.draw.canvas delete thing
  } else {
    DrawThings
  }
}

#
# Things option flipped with hotkey
#
proc FlipThingsOption {} {
  global options

  if { $options(show_things) == 0 } {
    set options(show_things) 1
    DrawThings
  } else {
    set options(show_things) 0
    .top.draw.canvas delete thing
  }
}

#
# Show Arrows option modified
#
proc ShowArrows {} {
  .top.draw.canvas delete line
  DrawLines
}

#
# Arrows option flipped with hotkey
#
proc FlipArrowsOption {} {
  global options

  if { $options(show_arrows) == 0 } {
    set options(show_arrows) 1
  } else {
    set options(show_arrows) 0
  }
  .top.draw.canvas delete line
  DrawLines
}

#
# Set map modified status information
#
proc MapModified { var index op } {
  global mapdata

  if { $mapdata(modified) } {
    set mapdata(modstat) "Y"
  } else {
    set mapdata(modstat) "N"
  }
}

#
# Terminate program
#
proc Bye {} {
  global mapdata

  if { $mapdata(modified) } {
    MapNsaveError
  }
  exit
}

# ========================================================================
#               Various subroutines
# ========================================================================

#
# Remove comments from string
#
proc RemoveComment { s } {
  set x [string first "#" $s]
  if { $x < 0 } {
    return $s
  } elseif { $x == 0 } {
    return ""
  } else {
    return [string range $s 0 [expr $x - 1]]
  }
}

#
# Read file until line with no comment, remove leading and trailing whitespace
#
proc GetNextLine { f } {
  while { [gets $f line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] != 0 } {
      break
    }
  }
  return $line
}

#
# Push procedure for a stack
#
proc Push { stack value } {
  upvar $stack s
  if { ![info exists s(top)] } {
    set s(top) 0
  }
  set s($s(top)) $value
  incr s(top)
}

#
# Pop procedure for a stack
#
proc Pop { stack } {
  upvar $stack s
  if { ![info exists s(top)] } {
    return {}
  }
  if { $s(top) == 0 } {
    return {}
  } else {
    incr s(top) -1
    set x $s($s(top))
    unset s($s(top))
    return $x
  }
}

#
# Read sector type list depending on game
#
proc ReadSectorList {} {
  global cadconf mapinfo sectypelist

  if { [array exists sectypelist] } {
    unset sectypelist
  }

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set x $cadconf(doomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set x $cadconf(doom2confdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set x $cadconf(xdoomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set x $cadconf(xdoomplusconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set x $cadconf(hexenconfdir)
  }

  set fn [file join $x $cadconf(sectypelist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    scan $line {%d} num
    set sectypelist($num) \
	[ string range $line [expr [string first ":" $line] + 2] \
	[expr [string length $line] - 1] ]
  }

  close $fd

  # debugging
  # parray sectypelist
}

#
# Lookup sector type description in sector type list
#
proc LookupSectypeDes { num } {
  global sectypelist

  if { [info exists sectypelist($num)] } {
    return $sectypelist($num)
  } else {
    return "???"
  }
}

#
# Lookup sector type no. in sector type list
#
proc LookupSectypeNum { name } {
  global sectypelist

  foreach { i n } [array get sectypelist] {
    if { [string compare $n $name] == 0 } {
      return $i
    }
  }
  return 99999
}

#
# Read linedef type list depending on game
#
proc ReadLdefList {} {
  global cadconf mapinfo ldeftypelist

  if { [array exists ldeftypelist] } {
    unset ldeftypelist
  }

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set x $cadconf(doomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set x $cadconf(doom2confdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set x $cadconf(xdoomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set x $cadconf(xdoomplusconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set x $cadconf(hexenconfdir)
  }

  set fn [file join $x $cadconf(ldeftypelist)]
  if { ![file exist $fn] } {
    return
  }

  set fd [open $fn r]

  set x 0
  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    if { ![string compare $mapinfo(maptype) $mapinfo(map_std)] } {
      scan $line { %d %s %s %s %s } nu cl tr sp wa
      set ldeftypelist($x) "$nu $cl $tr $sp $wa \
	{[string range $line [expr [string first ":" $line] + 2] \
	[expr [string length $line] - 1]]}"
    } else {
      scan $line { %d %s %s %s %s %s %s } nu cl a1 a2 a3 a4 a5
      set ldeftypelist($x) "$nu $cl $a1 $a2 $a3 $a4 $a5 \
	{[string range $line [expr [string first ":" $line] + 2] \
	[expr [string length $line] - 1]]}"
    }
    incr x
  }

  close $fd
  set mapinfo(no_ldeftypes) $x

  # debugging
  # parray ldeftypelist
}

#
# Read thing list depending on game
#
proc ReadThingList {} {
  global cadconf mapinfo thinglist

  if { [array exists thinglist] } {
    unset thinglist
  }

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set x $cadconf(doomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set x $cadconf(doom2confdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set x $cadconf(xdoomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set x $cadconf(xdoomplusconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set x $cadconf(hexenconfdir)
  }

  set fn [file join $x $cadconf(thinglist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    scan $line {%d %d %d %s %s } num height radius sprite class
    set thinglist($num) "$height $radius $sprite $class \
	{[string range $line [expr [string first ":" $line] + 2] \
	[expr [string length $line] - 1]]}"
  }

  close $fd

  set fn [file join $mapinfo(mapdir) $cadconf(ltexlist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  set reading 0
  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    if { !$reading && ![string compare $line {[THINGS]}] } {
      set reading 1
      continue
    }
    if { $reading } {
      scan $line {%s %s} num sprite
      if { [string compare [string index $num 0] {[}] == 0 } {
	set reading 0
	continue
      }
      if { [info exists thinglist($num)] } {
	set thinglist($num) [lreplace $thinglist($num) 2 2 $sprite]
      }
    }
  }

  # debugging
  # parray thinglist
}

#
# Lookup thing name in thinglist
#
proc LookupThingName { num } {
  global thinglist

  if { [info exists thinglist($num)] } {
    return [lindex $thinglist($num) 4]
  } else {
    return "???"
  }
}

#
# Lookup thing no. in thinglist
#
proc LookupThingNum { name } {
  global thinglist

  foreach { i n } [array get thinglist] {
    if { [string compare [lindex $n 4] $name] == 0 } {
      return $i
    }
  }
  return 99999
}

#
# Read wall texture list depending on game and project local texture list
#
proc ReadWallTextureList {} {
  global cadconf mapinfo wtexlist

  if { [array exists wtexlist] } {
    unset wtexlist
  }

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set x $cadconf(doomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set x $cadconf(doom2confdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set x $cadconf(xdoomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set x $cadconf(xdoomplusconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set x $cadconf(hexenconfdir)
  }

  set fn [file join $x $cadconf(wtexlist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    scan $line {%s %s %d %d %s} name fname width height patch
    set wtexlist($name) "$fname $width $height $patch"
  }

  close $fd

  set fn [file join $mapinfo(mapdir) $cadconf(ltexlist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  set reading 0
  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    if { !$reading && ![string compare $line {[TEXTURES]}] } {
      set reading 1
      continue
    }
    if { $reading } {
      scan $line {%s %s %d %d %s} name fname width height patch
      if { [string compare [string index $name 0] {[}] == 0 } {
	set reading 0
	continue
      }
      set wtexlist($name) "$fname $width $height $patch"
    }
  }

  close $fd

  # debugging
  # parray wtexlist
}

#
# Read flats list depending on game
#
proc ReadFlatsList {} {
  global cadconf mapinfo flatslist

  if { [array exists flatslist] } {
    unset flatslist
  }

  if { [string compare $mapinfo(game) $cadconf(doom)] == 0 } {
    set x $cadconf(doomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(doom2)] == 0 } {
    set x $cadconf(doom2confdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoom)] == 0 } {
    set x $cadconf(xdoomconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(xdoomplus)] == 0 } {
    set x $cadconf(xdoomplusconfdir)
  } elseif { [string compare $mapinfo(game) $cadconf(hexen)] == 0 } {
    set x $cadconf(hexenconfdir)
  }

  set fn [file join $x $cadconf(flatslist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    scan $line {%s %s} name fname
    set flatslist($name) ""
  }

  close $fd

  set fn [file join $mapinfo(mapdir) $cadconf(ltexlist)]
  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r ]

  set reading 0
  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    if { !$reading && ![string compare $line {[FLATS]}] } {
      set reading 1
      continue
    }
    if { $reading } {
      scan $line {%s %s} name fname
      if { [string compare [string index $name 0] {[}] == 0 } {
	set reading 0
	continue
      }
      set flatslist($name) ""
    }
  }

  # debugging
  # parray flatslist
}

#
# Read the list with the WAD engines which can be executed
#
proc ReadEngineList {} {
  global cadconf enginelist

  if { [array exists enginelist] } {
    unset enginelist
  }

  set fn [file join $cadconf(confdir) $cadconf(enginelist)]

  if { ![file exists $fn] } {
    return
  }

  set fd [open $fn r]

  while { [gets $fd line] != -1 } {
    set line [string trim $line]
    set line [RemoveComment $line]
    if { [string length $line] == 0 } {
      continue
    }
    scan $line { %s %s } name script
    set enginelist($name) $script
  }

  close $fd

  # debugging
  # parray enginelist
}

#
# Convert angle in degree to view direction
#
proc Angle2Dir { angle } {
  if {$angle >= 0 && $angle < 45} {
    return E
  } elseif {$angle >=45 && $angle < 90} {
    return NE
  } elseif {$angle >= 90 && $angle < 135} {
    return N
  } elseif {$angle >= 135 && $angle < 180} {
    return NW
  } elseif {$angle >= 180 && $angle < 225} {
    return W
  } elseif {$angle >= 225 && $angle < 270} {
    return SW
  } elseif {$angle >= 270 && $angle < 315} {
    return S
  } else {
    return SE
  }
}

#
# Return color to draw a thing with, depending on thing class
#
proc ThingColor { type } {
  global thinglist

  # for unknown things just return 'green'
  if { ![info exists thinglist($type)] } {
    return "green"
  }

  # get things class
  set class [lindex $thinglist($type) 3]

  # player starts, teleports
  if { [string compare $class "Player"] == 0 } {
    return "gray"

  # weapons
  } elseif { [string compare $class "Weapon"] == 0 } {
    return gold

  # monsters
  } elseif { [string compare $class "Monster"] == 0 } {
    return "brown"

  # all the other stuff
  } else {
    return "green"
  }

}

#
# Return color to draw a line with
#
proc LineColor { id } {
  global lines

  if { [lindex $lines($id) 3] != 0 && [lindex $lines($id) 4] != 0} {
    return "magenta"
  } elseif { [lindex $lines($id) 3] != 0 && [lindex $lines($id) 4] == 0} {
    return "green"
  } elseif { [string compare [lindex $lines($id,leftsdef) 0] "-"] != 0 } {
    return "yellow"
  } else {
    return "white"
  }
}

#
# Clear object info
#
proc ClearInfo {} {
  global objinfo

  set objinfo(info) ""
  set objinfo(x) ""
  set objinfo(y) ""

  # well, thing image canvas too
  .top.img.c delete all
}

#
# Destroy the world
#
proc DestroyWorld {} {
  global mapdata mapinfo vertices lines sectors things

  .top.draw.canvas delete vertex
  .top.draw.canvas delete line
  .top.draw.canvas delete thing

  if { [array exists vertices] } {
    unset vertices
  }
  set mapdata(no_vertices)  0

  if { [array exists lines] } {
    unset lines
  }
  set mapdata(no_lines) 0
  set mapdata(no_sdefs) 0

  if { [array exists sectors] } {
    unset sectors
  }
  set mapdata(no_sectors)  0

  if { [array exists things] } {
    unset things
  }
  set mapdata(no_things) 0

  set mapinfo(min_x) 0
  set mapinfo(min_y) 0
  set mapinfo(max_x) 0
  set mapinfo(max_y) 0
  set mapdata(modified) 0
}

#
# Draw the world and setup bindings for objects
#
proc DrawWorld {} {
  # draw vertices
  DrawVertices
  SetVerticesBinding

  # draw lines
  SetLinesBinding
  DrawLines

  # draw things
  DrawThings
  SetThingsBinding
}

#
# Draw Vertices
#
proc DrawVertices {} {
  global options vertices

  if { $options(show_vertices) == 0 } {
    return
  }

  if { [array exists vertices] } {
    foreach i [array names vertices] {
      if { [string first "," $i] != -1 } {
        continue
      }
      set x [lindex $vertices($i) 0]
      set y [lindex $vertices($i) 1]
      set x1 [expr $x - 3]
      set y1 [expr $y - 3]
      set x2 [expr $x + 3]
      set y2 [expr $y + 3]
      .top.draw.canvas create rectangle $x1 $y1 $x2 $y2 -fill red \
					-tags [list vertex $i]
    }
  }
}

#
# Setup bindings for vertices drawn on the canvas
#
proc SetVerticesBinding {} {
  .top.draw.canvas bind vertex <Button-1> {MarkObject %x %y %W}
  .top.draw.canvas bind vertex <B1-Motion> {DragVertex %x %y %W}
  .top.draw.canvas bind vertex <ButtonRelease-1> {NewMinMax}
  .top.draw.canvas bind vertex <Button-3> {DeleteVertex %x %y %W}
  .top.draw.canvas bind vertex <Enter> {InfoVertex %x %y %W}
  .top.draw.canvas bind vertex <Leave> {ClearInfo}
}

#
# Draw Lines
#
proc DrawLines {} {
  global options vertices lines

  if { [array exists lines] && [array exists vertices] } {
    foreach i [array names lines] {
      if { [string first "," $i] != -1 } {
	continue
      }
      set v1 [lindex $lines($i) 0]
      set v2 [lindex $lines($i) 1]
      set x1 [lindex $vertices($v1) 0]
      set y1 [lindex $vertices($v1) 1]
      set x2 [lindex $vertices($v2) 0]
      set y2 [lindex $vertices($v2) 1]
      set color [LineColor $i]
      if { $options(show_arrows) == 1 } {
        .top.draw.canvas create line $x1 $y1 $x2 $y2 -fill $color -arrow last \
					-tags [list line $i]
      } else {
        .top.draw.canvas create line $x1 $y1 $x2 $y2 -fill $color \
					-tags [list line $i]
      }
    }
  }
}

#
# Setup bindings for lines drawn on the canvas
#
proc SetLinesBinding {} {
  .top.draw.canvas bind line <Button-1> {MarkObject %x %y %W}
  .top.draw.canvas bind line <Double-1> {EditLine %x %y %W}
  .top.draw.canvas bind line <Button-2> {SplitLine %x %y %W}
  .top.draw.canvas bind line <Button-3> {DeleteLine %x %y %W}
  .top.draw.canvas bind line <Enter> {InfoLine %x %y %W}
  .top.draw.canvas bind line <Motion> {InfoLine %x %y %W}
  .top.draw.canvas bind line <Leave> {ClearInfo}
}

#
# Draw things
#
proc DrawThings {} {
  global options things

  if { $options(show_things) == 0 } {
    return
  }

  if { [array exists things] } {
    foreach i [array names things] {
      set id [lindex $things($i) 0]
      set x [lindex $things($i) 2]
      set y [lindex $things($i) 3]
      set x1 [expr $x - 5]
      set y1 [expr $y - 5]
      set x2 [expr $x + 5]
      set y2 [expr $y + 5]
      set color [ThingColor $id]
      .top.draw.canvas create oval $x1 $y1 $x2 $y2 -fill $color \
					-tags [list thing $i]
    }
  }
}

#
# Setup bindings for things drawn on the canvas
#
proc SetThingsBinding {} {
  .top.draw.canvas bind thing <Button-1> {MarkObject %x %y %W}
  .top.draw.canvas bind thing <B1-Motion> {DragThing %x %y %W}
  .top.draw.canvas bind thing <Double-1> {EditThing %x %y %W}
  .top.draw.canvas bind thing <Button-3> {DeleteThing %x %y %W}
  .top.draw.canvas bind thing <Enter> {InfoThing %x %y %W}
  .top.draw.canvas bind thing <Leave> {ClearInfo}
}

#
# Redraw the whole map
#
proc RedrawMap {} {
  . config -cursor watch
  update idletasks

  .top.draw.canvas delete line
  .top.draw.canvas delete vertex
  .top.draw.canvas delete thing
  DrawWorld

  . config -cursor top_left_arrow
  update idletasks
}

#
# Redraw all lines using the vertex v.
#
proc RedrawLines { v } {
  global lines vertices options

  foreach line $vertices($v,lines) {

    .top.draw.canvas delete $line

    set v1 [lindex $lines($line) 0]
    set v2 [lindex $lines($line) 1]

    set x1 [lindex $vertices($v1) 0]
    set y1 [lindex $vertices($v1) 1]
    set x2 [lindex $vertices($v2) 0]
    set y2 [lindex $vertices($v2) 1]
    set color [LineColor $line]
    if { $options(show_arrows) == 1 } {
      .top.draw.canvas create line $x1 $y1 $x2 $y2 -fill $color -arrow last \
                                      -tags [list line $line]
    } else {
      .top.draw.canvas create line $x1 $y1 $x2 $y2 -fill $color \
                                      -tags [list line $line]
    }
  }
}

#
# Remove a line reference from a vertex
#
proc RemoveLineRef { vertex line } {
  global vertices

  # get the current line references
  set ref $vertices($vertex,lines)

  # delete all references
  set vertices($vertex,lines) {}

  # add all old references but $line
  foreach l $ref {
    if { [string compare $l $line] } {
      lappend vertices($vertex,lines) $l
    }
  }
}

#
# Redraw a thing, maybe type was modified and different color needed
#
proc RedrawThing { thing objid } {
   global things

  .top.draw.canvas delete $objid

  set id [lindex $things($thing) 0]
  set x [lindex $things($thing) 2]
  set y [lindex $things($thing) 3]
  set x1 [expr $x - 5]
  set y1 [expr $y - 5]
  set x2 [expr $x + 5]
  set y2 [expr $y + 5]
  set color [ThingColor $id]

  .top.draw.canvas create oval $x1 $y1 $x2 $y2 -fill $color \
		-tags [list thing $thing]
}

#
# Move the view of the drawing canvas, so that center of the map
# is in center of view. Take current scale and canvas size into account,
# the canvas resizes if the application window size is changed.
#
proc CenterMap {} {
  global mapinfo max_x min_x max_y min_y scale

  set w [winfo width .top.draw.canvas]
  set h [winfo height .top.draw.canvas]

  set x1 [expr ($mapinfo(max_x) - $mapinfo(min_x)) / 2]
  set x2 [expr $mapinfo(min_x) + $x1]

  set x3 [expr ($max_x - $min_x) / 2] 
  set x4 [expr double($x3 + $x2 - ($w / 2 / $scale)) / double($max_x - $min_x)]

  .top.draw.canvas xview moveto $x4

  set y1 [expr ($mapinfo(max_y) - $mapinfo(min_y)) / 2]
  set y2 [expr $mapinfo(min_y) + $y1]

  set y3 [expr ($max_y - $min_y) / 2]
  set y4 [expr double($y3 - $y2 - ($h / 2 / $scale)) / double($max_y - $min_y)]

  .top.draw.canvas yview moveto $y4
}

#
# Move view of the drawing canvas, so that center of the map shows
# player 1 start.
#
proc GotoStart {} {
  global things scale mapinfo max_x min_x max_y min_y

  set found 0
  if { [array exists things] } {
    foreach i [array names things] {
      if { [lindex $things($i) 0] == 1} {
	set found 1
	break
      }
    }
  }
  if { $found == 0 } {
    return
  }

  set x [lindex $things($i) 2]
  set y [lindex $things($i) 3]

  set w [winfo width .top.draw.canvas]
  set h [winfo height .top.draw.canvas]

  .top.draw.canvas xview moveto [expr double($x + abs($min_x) - $w \
	/ 2 / $scale) / double($max_x - $min_x)]
  .top.draw.canvas yview moveto [expr double($y + abs($min_y) - $h \
	/ 2 / $scale) / double($max_y - $min_y)]
}

#
# Find new map max/min coordinates, vertex was dragged or object added, etc.
#
proc NewMinMax {} {
  global mapinfo vertices

  set mapinfo(min_x) 0
  set mapinfo(max_x) 0
  set mapinfo(min_y) 0
  set mapinfo(max_y) 0

  foreach v [array names vertices] {
    if { [string first "," $v] != -1 } {
      continue
    }
    set x [lindex $vertices($v) 0]
    set y [expr -[lindex $vertices($v) 1]]
    if { $x < $mapinfo(min_x) } {
      set mapinfo(min_x) $x
    } elseif { $x > $mapinfo(max_x) } {
      set mapinfo(max_x) $x
    }
    if { $y < $mapinfo(min_y) } {
      set mapinfo(min_y) $y
    } elseif { $y > $mapinfo(max_y) } {
      set mapinfo(max_y) $y
    }
  }
}

#
# snap x coordinate on grid
#
proc SnapOnX { x } {
  global options grid scale

  if { !$options(gridsnap) } {
    return $x
  }

  if { $x >= 0 } {
    return [expr round(($grid * $scale) * int(($x + ($grid * $scale) / 2) / \
	($grid * $scale)))]
  } else {
    return [expr round(($grid * $scale) * int(($x - ($grid * $scale) / 2) / \
	($grid * $scale)))]
  }
}

#
# Snap y coordinate on grid
#
proc SnapOnY { y } {
  global options grid scale

  if { !$options(gridsnap) } {
    return $y
  }

  if { $y >= 0 } {
    return [expr round(($grid * $scale) * int(($y + ($grid * $scale) / 2) / \
	($grid * $scale)))]
  } else {
    return [expr round(($grid * $scale) * int(($y - ($grid * $scale) / 2) / \
	($grid * $scale)))]
  }
}

#
# Calculate lenght of a line
#
proc CalcLineLenght { lin } {
  global lines vertices

  # get vertices of the line
  set v1 [lindex $lines($lin) 0]
  set v2 [lindex $lines($lin) 1]

  # get x/y coordinates of the vertices
  set x1 [lindex $vertices($v1) 0]
  set y1 [lindex $vertices($v1) 1]
  set x2 [lindex $vertices($v2) 0]
  set y2 [lindex $vertices($v2) 1]

  # now calulate length
  if { $x1 == $x2 } {
    set len [expr abs($y1 - $y2)]
  } elseif { $y1 == $y2 } {
    set len [expr abs($x1 - $x2)]
  } else {
    set a [expr abs($x1 - $x2)]
    set b [expr abs($y1 - $y2)]
    set len [expr round(sqrt(pow($a,2) + pow($b,2)))]
  }
  return [expr int($len)]
}

# ========================================================================
#		Process arguments, if any
# ========================================================================

proc Usage { a } {
  puts [format "Unkown option %s\n" $a]
  puts {Usage: tkwadcad [-debug] [filename.map]}
  exit
}

set debugflag 0

set read_map ""
foreach arg $argv {
  if { [regexp {\-} $arg] } {
    switch -glob -- $arg {
      -debug	{set debugflag 1}
      default	{Usage $arg}
    }
  } else {
    set read_map $arg
  }
}

# For debugging under Windows we need a console, not so under UNIX/X,
# xterm is fine there.
if { [string compare $tcl_platform(platform) windows] == 0 && $debugflag == 1 } {
  console show
}

# ========================================================================
#                               GUI
# ========================================================================

#
# Set window title
#
wm title . "TkWadCad"

#
# Define our own fonts
#
font create widgets -family helvetica -size $options(fontsize) -weight bold
font create input -family fixed -size $options(fontsize)

#
# Read lists which are needed for the GUI
#
ReadEngineList

#
# Create a scrolling canvas for drawing the map
#
proc Scrolled_Canvas { c w h s x1 y1 x2 y2 } {
  global tcl_platform options scale canvas

  tk scaling $scale
  frame $c -borderwidth 2 -relief raised
  canvas $c.canvas -background black \
         -xscrollcommand [list $c.xscroll set] \
	 -yscrollcommand [list $c.yscroll set] \
	 -takefocus 1 \
	 -highlightthickness 2 \
	 -borderwidth 0 \
	 -width $w \
	 -height $h \
	 -scrollregion "[expr $x1 * $s] [expr $y1 * $s] \
			[expr $x2 * $s] [expr $y2 * $s]"
  scrollbar $c.xscroll -orient horizontal -width 10 \
	    -command [list $c.canvas xview]
  scrollbar $c.yscroll -orient vertical -width 10 \
	    -command [list $c.canvas yview]
  grid $c.canvas $c.yscroll -sticky news
  grid $c.xscroll -sticky ew
  grid rowconfigure $c 0 -weight 1
  grid columnconfigure $c 0 -weight 1
  tk scaling 1.0
  bind $c <Enter> {set canvas(of) [focus -displayof .]; focus .top.draw.canvas}
  bind $c <Leave> {focus $canvas(of)}
  bind $c.canvas <Motion> {ShowXY %x %y %W}
  bind $c.canvas <Button-2> {MarkCanvas %W %x %y}
  bind $c.canvas <B2-Motion> {DragCanvas %W %x %y}
  bind $c.canvas <Key-plus> {Rescale +0.25}
  bind $c.canvas <Key-minus> {Rescale -0.25}
  bind $c.canvas <Key-g> {NewGrid -1.0}
  bind $c.canvas <Key-G> {NewGrid +1.0}
  bind $c.canvas <Key-Right> {%W xview scroll 1 units}
  bind $c.canvas <Key-Left> {%W xview scroll -1 units}
  bind $c.canvas <Key-Up> {%W yview scroll -1 units}
  bind $c.canvas <Key-Down> {%W yview scroll 1 units}
  bind $c.canvas <Key-Delete> "DeleteSomething %x %y %W"
  # Hm, no KP_Delete under Windows, funny
  if { [string compare $tcl_platform(platform) windows] != 0 } {
    bind $c.canvas <Key-KP_Delete> "DeleteSomething %x %y %W"
  }
  bind $c.canvas <Key-Return> "EditSomething %x %y %W"
  bind $c.canvas <Control-t> "AddThing %x %y %W"
  bind $c.canvas <Control-l> "ConnectVertices %x %y %W"
  bind $c.canvas <Control-s> "SplitLine %x %y %W"
  bind $c.canvas <Control-f> "FlipLine %x %y %W"
  bind $c.canvas <Control-d> "FlipSdefs %x %y %W"
  bind $c.canvas <Control-v> "AddVertex %x %y %W 1"
  bind $c.canvas <Key-less> "RotateThing %x %y %W 45"
  bind $c.canvas <Key-greater> "RotateThing %x %y %W -45"
  bind $c.canvas <Control-c> "CopySomething %x %y %W"
  bind $c.canvas <Control-p> "PasteSomething %x %y %W"
  bind $c.canvas <Control-m> {MakeMap}
  bind $c.canvas <Control-b> {Compile_Dialog}
  bind $c.canvas <Control-r> {RunMap}
  bind $c.canvas <Key-F1> "WCHelp::HelpKeys"
  bind $c.canvas <Key-q> {Bye}
  bind $c.canvas <Key-v> {FlipVerticesOption}
  bind $c.canvas <Key-t> {FlipThingsOption}
  bind $c.canvas <Key-a> {FlipArrowsOption}
}

#
# Draw grid on the canvas
#
proc DrawGrid { c g x1 y1 x2 y2 } {
  set start [expr $x1 + $g]
  set end [expr $x2 - $g]
  for {set i $start} {$i <= $end} {incr i $g} {
    $c.canvas create line $i $y1 $i $y2 -fill blue -tags grid
  }
  set start [expr $y1 + $g]
  set end [expr $y2 - $g]
  for {set i $start} {$i <= $end} {incr i $g} {
    $c.canvas create line $x1 $i $x2 $i -fill blue -tags grid
  }
}

#
# Create the info frame
#
proc CreateInfo {} {
  global mapinfo cadconf

  frame .top.info -borderwidth 2 -relief raised
  label .top.info.l1 -text "Game" -font widgets
  set x [tk_optionMenu .top.info.ga mapinfo(game) $cadconf(doom) \
	$cadconf(doom2) $cadconf(xdoom) $cadconf(xdoomplus) $cadconf(hexen)]
  .top.info.ga configure -takefocus 1 -width 10 -font widgets
  label .top.info.l1a -text "Map type" -font widgets
  set y [tk_optionMenu .top.info.ty mapinfo(maptype) \
	$mapinfo(map_std) $mapinfo(map_ext) ]
  .top.info.ty configure -takefocus 1 -width 10 -font widgets
  label .top.info.l2 -text "Map File" -font widgets
  entry .top.info.me -width 15 -relief sunken -textvariable mapinfo(mapfile) \
	-font input
  label .top.info.l3 -text "Episode" -font widgets
  entry .top.info.ep -width 3 -relief sunken -textvariable mapinfo(episode) \
	-font input
  label .top.info.l4 -text "Level" -font widgets
  entry .top.info.lv -width 3 -relief sunken -textvariable mapinfo(map) \
	-font input
  label .top.info.l5 -text "Vertices" -font widgets
  entry .top.info.ve -width 5 -relief sunken -textvariable mapdata(no_vertices)\
	-font input
  label .top.info.l6 -text "Linedefs" -font widgets
  entry .top.info.li -width 5 -relief sunken -textvariable mapdata(no_lines) \
	-font input
  label .top.info.l7 -text "Sidedefs" -font widgets
  entry .top.info.si -width 5 -relief sunken -textvariable mapdata(no_sdefs) \
	-font input
  label .top.info.l8 -text "Sectors" -font widgets
  entry .top.info.se -width 5 -relief sunken -textvariable mapdata(no_sectors) \
	-font input
  label .top.info.l9 -text "Things" -font widgets
  entry .top.info.th -width 5 -relief sunken -textvariable mapdata(no_things) \
	-font input

  grid .top.info.l1 .top.info.ga -sticky w -pady 5
  grid .top.info.l1a .top.info.ty -sticky w -pady 5
  grid .top.info.l2 .top.info.me -sticky w -pady 5
  grid .top.info.l3 .top.info.ep -sticky w -pady 5
  grid .top.info.l4 .top.info.lv -sticky w -pady 5
  grid .top.info.l5 .top.info.ve -sticky w -pady 5
  grid .top.info.l6 .top.info.li -sticky w -pady 5
  grid .top.info.l7 .top.info.si -sticky w -pady 5
  grid .top.info.l8 .top.info.se -sticky w -pady 5
  grid .top.info.l9 .top.info.th -sticky w -pady 5
  grid columnconfigure .top.info 2 -weight 1
  grid rowconfigure .top.info 10 -weight 1

  # binding to tk_optionMenu doesn't work under Windows, trace variable
  #bind $x <Leave> GameSelected
  trace variable mapinfo(game) w GameSelected
  .top.info.me config -state disabled
  .top.info.ep config -state disabled
  .top.info.ve config -state disabled
  .top.info.li config -state disabled
  .top.info.si config -state disabled
  .top.info.se config -state disabled
  .top.info.th config -state disabled
}

#
# Create thing/texture image frame
#
proc CreateImgFrame {} {
  global mapinfo

  frame .top.img -borderwidth 2 -relief raised
  checkbutton .top.img.ti -text "Show Thing Image" -font widgets \
	-variable options(thingimg)
  checkbutton .top.img.te -text "Show Texture Image" -font widgets \
	-variable options(textureimg)
  canvas .top.img.c -background $mapinfo(bg) -borderwidth 1 \
	-highlightthickness 0 -width 200 -height 120 -relief sunken

  grid .top.img.ti -sticky w -pady 5 -padx 3
  grid .top.img.te -sticky w -pady 5 -padx 3
  grid .top.img.c -sticky w -pady 5 -padx 3
}

#
# Create toolbox frame
#
proc CreateToolbox {} {
  frame .top.tool -borderwidth 2 -relief raised
  checkbutton .top.tool.snap -text "Snap on grid" -font widgets \
	-variable options(gridsnap)
  button .top.tool.cen -text "Center" -font widgets -command {CenterMap}
  bind .top.tool.cen <Enter> {Create_Balloon %W %X %Y "Center map"}
  bind .top.tool.cen <Leave> {Delete_Balloon}
  button .top.tool.sta -text "Start" -font widgets -command {GotoStart}
  bind .top.tool.sta <Enter> {Create_Balloon %W %X %Y "Goto Player 1 start"}
  bind .top.tool.sta <Leave> {Delete_Balloon}
  button .top.tool.red -text "Redraw" -font widgets -command {RedrawMap}
  bind .top.tool.red <Enter> {Create_Balloon %W %X %Y "Redraw map"}
  bind .top.tool.red <Leave> {Delete_Balloon}

  grid .top.tool.snap -columnspan 2 -sticky w -pady 5
  grid .top.tool.cen .top.tool.sta .top.tool.red -sticky w -pady 5 -padx 3
  grid columnconfigure .top.tool 3 -weight 1
}

#
# Create the map/object info frame
#
proc CreateStatus {} {
  global mapdata scale

  frame .top.status -borderwidth 2 -relief raised
  label .top.status.l1 -text "Scale" -font widgets
  entry .top.status.sc -width 5 -relief sunken -textvariable scale -font input
  label .top.status.l2 -text "Grid" -font widgets
  entry .top.status.gr -width 5 -relief sunken -textvariable grid -font input
  label .top.status.l3 -text "Modified" -font widgets
  entry .top.status.mo -width 1 -relief sunken -textvariable mapdata(modstat) \
	-font input
  label .top.status.l4 -text "Info" -font widgets
  entry .top.status.in -width 75 -relief sunken -textvariable objinfo(info) \
	-font input
  label .top.status.l5 -text "X" -font widgets
  entry .top.status.x -width 6 -relief sunken -textvariable objinfo(x) \
	-font input
  label .top.status.l6 -text "Y" -font widgets
  entry .top.status.y -width 6 -relief sunken -textvariable objinfo(y) \
	-font input

  grid .top.status.l1 .top.status.sc .top.status.l2 .top.status.gr \
       .top.status.l3 .top.status.mo .top.status.l4 .top.status.in \
       .top.status.l5 .top.status.x .top.status.l6 .top.status.y -sticky w
  grid columnconfigure .top.status 12 -weight 1
  grid rowconfigure .top.status 1 -weight 1

  .top.status.sc config -state disabled
  .top.status.gr config -state disabled
  .top.status.mo config -state disabled
  .top.status.in config -state disabled
  .top.status.x config -state disabled
  .top.status.y config -state disabled

  trace variable mapdata(modified) w MapModified
}

#
# Menu for the program
#
menu .menubar
. config -menu .menubar

foreach m {File Map Sectors Lines Vertices Prefabs Check Options} {
  set menu$m [menu .menubar.m$m -title "tkwadcad: $m"]
  .menubar add cascade -label $m -font widgets -menu .menubar.m$m -underline 0
}

# Help menu under UNIX is special, right justified
set m help
set menuHelp [menu .menubar.$m]
.menubar add cascade -label Help -font widgets -menu .menubar.$m -underline 0

$menuFile add command -label "Open" -font widgets -command {ReadMap ""} \
	-underline 0
$menuFile add command -label "New" -font widgets -command {NewMap noname.map} \
	-underline 0
$menuFile add separator
$menuFile add command -label "Save" -font widgets -command WriteMap -underline 0
$menuFile add command -label "Save as" -font widgets -command SaveAsMap \
	-underline 5
$menuFile add separator
$menuFile add command -label "Quit" -font widgets -command Bye -underline 0 \
	-accelerator "q"

$menuMap add command -label "Zoom in" -font widgets -command {Rescale +0.25} \
	-underline 5 -accelerator "+"
$menuMap add command -label "Zoom out" -font widgets -command {Rescale -0.25} \
	-underline 5 -accelerator "-"
$menuMap add cascade -label "Zoom factor" -font widgets \
	-menu $menuMap.zoom -underline 0
menu $menuMap.zoom -title "tkwadcad: zoom scale"
$menuMap.zoom add command -label "0.25" -font widgets -command \
	{Rescale [expr -($scale - 0.25)]}
$menuMap.zoom add command -label "0.50" -font widgets -command \
	{Rescale [expr -($scale - 0.5)]}
$menuMap.zoom add command -label "0.75" -font widgets -command \
	{Rescale [expr -($scale - 0.75)]}
$menuMap.zoom add command -label "1.00" -font widgets -command \
	{Rescale [expr -($scale - 1.0)]}
$menuMap.zoom add command -label "1.25" -font widgets -command \
	{Rescale [expr -($scale - 1.25)]}
$menuMap.zoom add command -label "1.50" -font widgets -command \
	{Rescale [expr -($scale - 1.5)]}
$menuMap.zoom add command -label "1.75" -font widgets -command \
	{Rescale [expr -($scale - 1.75)]}
$menuMap.zoom add command -label "2.00" -font widgets -command \
	{Rescale [expr -($scale - 2.0)]}
$menuMap.zoom add command -label "2.25" -font widgets -command \
	{Rescale [expr -($scale - 2.25)]}
$menuMap.zoom add command -label "2.50" -font widgets -command \
	{Rescale [expr -($scale - 2.5)]}
$menuMap.zoom add command -label "2.75" -font widgets -command \
	{Rescale [expr -($scale - 2.75)]}
$menuMap.zoom add command -label "3.00" -font widgets -command \
	{Rescale [expr -($scale - 3.0)]}
$menuMap add separator
$menuMap add command -label "Dec. grid step" -font widgets \
	-command {NewGrid -1.0} -underline 0 -accelerator "g"
$menuMap add command -label "Inc. grid step" -font widgets \
	-command {NewGrid +1.0} -underline 1 -accelerator "G"
$menuMap add cascade -label "Grid size" -font widgets \
	-menu $menuMap.grid -underline 0
menu $menuMap.grid -title "tkwadcad: grid size"
$menuMap.grid add command -label "4" -font widgets -command \
	{SetGrid 4}
$menuMap.grid add command -label "8" -font widgets -command \
	{SetGrid 8}
$menuMap.grid add command -label "16" -font widgets -command \
	{SetGrid 16}
$menuMap.grid add command -label "32" -font widgets -command \
	{SetGrid 32}
$menuMap.grid add command -label "64" -font widgets -command \
	{SetGrid 64}
$menuMap.grid add command -label "128" -font widgets -command \
	{SetGrid 128}
$menuMap.grid add command -label "256" -font widgets -command \
	{SetGrid 256}
$menuMap add separator
$menuMap add command -label "Make" -font widgets -command MakeMap \
	-underline 0 -accelerator "CTRL-M"
$menuMap add command -label "Build" -font widgets -command Compile_Dialog \
	-underline 0 -accelerator "CTRL-B"
$menuMap add command -label "Run" -font widgets -command RunMap -underline 0 \
	-accelerator "CTRL-R"

$menuSectors add command -label "Create" -font widgets -command AddSector \
	-underline 0

$menuLines add command -label "Create" -font widgets -command NewLine \
	-underline 0 -accelerator "CTRL-L"

$menuVertices add command -label "Delete unused" -font widgets \
	-command DelUnusedVertices -underline 0

$menuPrefabs add command -label "Room" -font widgets \
	-command AddRoom -underline 0
$menuPrefabs add command -label "Object" -font widgets \
	-command AddObject -underline 0

$menuCheck add command -label "Sectors" -font widgets \
	-command CheckSectors -underline 0
$menuCheck add command -label "Linedef References" -font widgets \
	-command CheckLineRefs -underline 0
$menuCheck add command -label "Tag References" -font widgets \
	-command CheckTags -underline 0
$menuCheck add command -label "Things" -font widgets \
	-command CheckThings -underline 1

$menuOptions add check -label "Show Vertices" -variable options(show_vertices) \
	-font widgets -command ShowVertices -underline 5 -accelerator "v"
$menuOptions add check -label "Show Things" -variable options(show_things) \
	-font widgets -command ShowThings -underline 5 -accelerator "t"
$menuOptions add check -label "Show Arrows" -variable options(show_arrows) \
	-font widgets -command ShowArrows -underline 5 -accelerator "a"
$menuOptions add separator
$menuOptions add cascade -label "Node Builder" -font widgets \
	-menu $menuOptions.bsp -underline 0
menu $menuOptions.bsp -tearoff 0
$menuOptions.bsp add radio -label "idbsp" -variable options(node_builder) \
	-value 1 -font widgets -underline 0
$menuOptions.bsp add radio -label "bsp" -variable options(node_builder) \
	-value 2 -font widgets -underline 0
$menuOptions.bsp add radio -label "warm" -variable options(node_builder) \
	-value 3 -font widgets -underline 0
$menuOptions add cascade -label "WAD Engine" -font widgets \
	-menu $menuOptions.engine -underline 0
menu $menuOptions.engine -tearoff 0
foreach eng [lsort [array names enginelist]] {
  $menuOptions.engine add radio -label $eng -variable options(runscript) \
	-value $enginelist($eng) -font widgets
}
$menuOptions add cascade -label "Engine Options" -font widgets \
	-menu $menuOptions.engopt -underline 0
menu $menuOptions.engopt -tearoff 0
$menuOptions.engopt add check -label "No monsters" \
	-variable options(nomonsters) -font widgets -underline 0
$menuOptions.engopt add check -label "Developer mode" \
	-variable options(devparm) -font widgets -underline 0
$menuOptions.engopt add check -label "No music" \
	-variable options(nomusic) -font widgets -underline 3
$menuOptions.engopt add cascade -label "Skill" -font widgets \
	-menu $menuOptions.engopt.skill -underline 0
menu $menuOptions.engopt.skill -tearoff 0
$menuOptions.engopt.skill add radio -label "1" -variable options(skill) \
	-value 1 -font widgets
$menuOptions.engopt.skill add radio -label "2" -variable options(skill) \
	-value 2 -font widgets
$menuOptions.engopt.skill add radio -label "3" -variable options(skill) \
	-value 3 -font widgets
$menuOptions.engopt.skill add radio -label "4" -variable options(skill) \
	-value 4 -font widgets
$menuOptions.engopt.skill add radio -label "5" -variable options(skill) \
	-value 5 -font widgets
$menuOptions add separator
$menuOptions add cascade -label Fontsize -font widgets \
	-menu $menuOptions.fsize -underline 0
menu $menuOptions.fsize -tearoff 0
$menuOptions.fsize add radio -label 8 -variable options(fontsize) -value 8 \
	-command FontConf -font widgets
$menuOptions.fsize add radio -label 10 -variable options(fontsize) -value 10 \
	-command FontConf -font widgets
$menuOptions.fsize add radio -label 12 -variable options(fontsize) -value 12 \
	-command FontConf -font widgets
$menuOptions.fsize add radio -label 16 -variable options(fontsize) -value 16 \
	-command FontConf -font widgets

$menuHelp add command -label "Keys" -font widgets -command WCHelp::HelpKeys \
	-underline 0 -accelerator "F1"
$menuHelp add command -label "Mouse" -font widgets -command WCHelp::HelpMouse \
	-underline 0
$menuHelp add separator
$menuHelp add command -label "About" -font widgets -command WCHelp::About \
	-underline 0

#
# Create all frames for the root window
#
frame .top
Scrolled_Canvas .top.draw [expr 12 * 64] [expr 9 * 64] $scale \
		$min_x $min_y $max_x $max_y
CreateInfo
CreateImgFrame
CreateToolbox
CreateStatus

#
# Place all frames on root window
#
grid .top -sticky news
grid .top.draw -row 0 -column 0 -rowspan 3 -sticky news
grid .top.info -row 0 -column 1 -sticky news
grid .top.img -row 1 -column 1 -sticky news
grid .top.tool -row 2 -column 1 -sticky news
grid .top.status -row 3 -columnspan 2 -sticky news
grid rowconfigure . 0 -weight 1
grid rowconfigure .top 0 -weight 1
grid columnconfigure . 0 -weight 1
grid columnconfigure .top 0 -weight 1

#
# Bring up the GUI
#
font configure widgets -size $options(fontsize)
font configure input -size $options(fontsize)
update idletasks
set winsize(x) [winfo width .]
set winsize(y) [winfo height .]
if { [string compare $tcl_platform(platform) windows] == 0 } {
    wm minsize . 950 650
} else {
    wm minsize . $winsize(x) [expr $winsize(y) + 30]
}
wm protocol . WM_DELETE_WINDOW Bye

DrawGrid .top.draw $grid $min_x $min_y $max_x $max_y

#
# Read map file if one was given as argument
#
if {[string length $read_map] != 0} {
    ReadMap $read_map
}
