#!/usr/bin/X11/wishx -f 

# set this to the full path you want to install the editor in
set installdir /home/user/chris/src/wt/edit

# set this to thepath where you keep your textures
set texturedir /home/user/chris/src/wt/edit/textures

# this is the initial path for the world file selector box
set wpath [pwd]

# set this to 1 if you want to give areas a try
set doAreas 0
proc CreateWidgets {} {
    global scale mode
    wm minsize . 500 400 
    wm geometry . 800x550
    frame .menu -relief raised
    frame .edit -relief raised
    frame .bottom -relief raised
    label .bottom.msg -text "Ready." -relief sunken
    label .bottom.mode -textvariable mode -relief sunken
    canvas [set canvas .edit.canvas] \
	-xscroll ".edit.xscroll set" \
	-yscroll ".edit.v.yscroll set" \
	-relief sunken -background white
    
    frame .edit.v -borderwidth 0
    scrollbar .edit.v.yscroll -orient vertical -command "$canvas yview"
    scrollbar .edit.xscroll -orient horizontal -command "$canvas xview"
    label .edit.v.corner
    menubutton .menu.file -text "File" \
	-menu [set filemenu .menu.file.b] \
	-underline 0
    menu $filemenu
    $filemenu add command -label "New" \
	-command "ClearWorld $canvas" \
	-underline 0

    $filemenu add command -label "Open ..." \
	-command "LoadWorld $canvas" \
	-underline 0

    $filemenu add command -label "Save" \
	-command "SaveWorld" \
	-underline 0
    
    $filemenu add command -label "Exit" \
	-command "destroy ." \
	-underline 0
    menubutton .menu.options -text "Mode" \
	-menu [set opmenu .menu.options.b] \
	-underline 0

    menu $opmenu
    set mode select
    $opmenu add radiobutton -label "Vertex" -value vertex -variable mode \
	-command "SwitchMode $canvas vertex" -underline 1

    $opmenu add radiobutton -label "Wall" -value wall -variable mode \
	-command "SwitchMode $canvas wall" -underline 1

    $opmenu add radiobutton -label "Select" -value select -variable mode \
	-command "SwitchMode $canvas select" -underline 1

    menubutton .menu.magstep -text "Magstep" \
	-menu [set magmenu .menu.magstep.b] \
	-underline 3
    menu $magmenu
    $magmenu add radiobutton -label "1" -value 1 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "5" -value 5 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "10" -value 10 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "20" -value 20 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "30" -value 30 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "40" -value 40 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "50" -value 50 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "75" -value 75 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "100" -value 100 -variable scale \
	-command "DrawObjects $canvas"
    $magmenu add radiobutton -label "200" -value 200 -variable scale \
	-command "DrawObjects $canvas"
    set scale 10
    menubutton .menu.misc -text "Misc" \
	-menu [set miscmenu .menu.misc.b] \
	-underline 1
    menu $miscmenu
    set bgcolor [option get . background *]
    $miscmenu add command -label "Textures" \
	-command {
	    wm deiconify .txdlg
	    raise .txdlg
	} \
    -underline 0
    
    $miscmenu add command -label "Preferences" \
	-command {
	    wm deiconify .prefsdlg
	    raise .prefsdlg
	} \
    -underline 0
    
    $miscmenu add command -label "Regions" \
	-command {
	    wm deiconify .regdlg
	    raise .regdlg
	} \
    -underline 0
    
    $miscmenu add command -label "xmag" -command "exec xmag -bg $bgcolor &" \
	-underline 0

    menubutton .menu.ck -text "Check" \
	-menu [set ckmenu .menu.ck.b] \
	-underline 1
    menu $ckmenu
    $ckmenu add command -label "Textures" -command "CheckTextures" \
	-underline 0
    
    tk_menuBar .menu .menu.file .menu.options .menu.magstep .menu.misc .menu.ck
    tk_bindForTraversal .
    pack .menu -side top -fill x
    pack .menu.file .menu.options .menu.magstep .menu.misc .menu.ck -in .menu -side left
    pack .edit -side top -fill both -expand yes
    pack .edit.v.yscroll -expand yes -fill y
    pack .edit.v.corner -fill both
    pack .edit.v -side right -fill y
    pack .edit.xscroll -side bottom -fill x
    pack $canvas -side right -fill both -expand yes
    pack .bottom.msg -side left -expand yes -fill x 
    pack .bottom.mode -expand no -side right
    pack .bottom -side bottom -fill x
    CreateObjectInfo
    follow_mouse .edit.canvas 1
    ClearWorld $canvas
    SwitchMode $canvas select

    $canvas bind vertex <3> "itemStartDrag $canvas %x %y"
    $canvas bind vertex <B3-Motion> "itemDrag $canvas %x %y"
    $canvas bind start <3> "itemStartDrag $canvas %x %y"
    $canvas bind start <B3-Motion> "itemDrag $canvas %x %y"
    bind $canvas <Key-Escape> "StopDrag $canvas"
    bind $canvas <Key-t> "UpdateWallTexture $canvas"
    bind $canvas <Key-f> "FlipWall $canvas"
    bind $canvas <Key-r> "UpdateWallRegion $canvas"
    bind $canvas <Key-s> "SortWalls $canvas"
    bind $canvas <Key-S> "UpdateWallScales $canvas"
    bind $canvas <Key-p> "UpdateWallPhases $canvas"
    bind $canvas <Key-x> "SetWallXTile $canvas"
    bind $canvas <Key-y> "SetWallYTile $canvas"
    bind $canvas <Key-a> "AlignWallBottom $canvas"
    bind $canvas <Key-Delete> "DeleteWall $canvas"
    bind $canvas <Key-BackSpace> "DeleteWall $canvas"
    bind $canvas <Any-Enter> "focus $canvas"
    bind $canvas <Any-Leave> "focus ."
    scale_canvas $canvas
    focus default .
}

proc GetNumber { s } {
    return [string range [lindex $s 0] 1 end]
}

proc CreateObjectInfo {} {
    toplevel .info
    wm minsize .info 350 250
    wm geometry .info 450x250
    wm title .info Info
    frame .info.top -relief raised
    frame .info.bot -relief raised
    text .info.top.text -wrap none \
	-yscrollcommand ".info.top.scrolly set" \
	-font 9x15bold
    scrollbar .info.top.scrolly -orient vertical \
	-command ".info.top.text yview"
    button .info.bot.btn -text "Close" -command "wm withdraw .info"
    pack .info.top.scrolly -side right -fill y
    pack .info.top.text
    pack .info.bot.btn
    pack .info.bot -side bottom -expand yes -fill x
    pack .info.top -side top -expand yes -fill both
    wm withdraw .info
}

proc SwitchMode { canvas m } {
    global mode
    set mode $m
    switch $mode {
	vertex { 
	    bind $canvas <1> {
		CreateVertex .edit.canvas \
		    [expr [.edit.canvas canvasx %x].0/$scale] \
		    [expr [.edit.canvas canvasy %y].0/$scale]
	    }
	}
	wall { 
	    bind $canvas <1> "ConnectPoints $canvas" 
	}
	select {
	    bind $canvas <1> "ObjectInfo $canvas"
	}	    
	default {}
    }
}

proc ObjectInfo { canvas } {
    global wall area vertex area_region
    SelectItem $canvas
    set w .info.top.text
    $w delete 0.0 end
    if { "[$canvas find withtag current]" != "" } {
	set item [$canvas find withtag current]
	wm deiconify .info
	raise .info
	set tags [$canvas gettags current]
	set id [lindex $tags 0]
	$w delete 0.0 end
	$w insert insert $tags\n
	switch [lindex $tags 1] {
	    wall { 
		WallInfo $w [GetNumber $id]
	    }
	    area {
		$w insert insert $area([GetNumber [lindex $tags 0]])\n
		$w insert insert $area_region([GetNumber [lindex $tags 0]])\n
		echo $canvas lower [lindex $tags 0]
		$canvas lower [lindex $tags 0]
	    }
	    vertex {
		$w insert insert $vertex([GetNumber [lindex $tags 0]])
	    }
	    default {}
	}	
    }
}

proc SelectItem { canvas } {
    global selection scolor
    set item [$canvas find withtag current]
    if {[info exists selection]} {
	$canvas itemconfigure $selection -fill $scolor
    }
    set scolor [lindex [$canvas itemconf $item -fill] 4]
    set selection $item
    $canvas itemconfigure $item -fill orange
}
    

proc ClearWorld { canvas } {
    $canvas delete all
    global maxx maxy minx miny vindex windex tindex rindex aindex
    global texture vertex wall region default wall area p1 p2 start
    set maxx 5
    set maxy 5
    set minx 0 
    set miny 0
    set vindex 0
    set windex 0
    set tindex 0
    set rindex 0
    set aindex 0
    if { [info exists vertex] } {
	unset vertex
    }
    if { [info exists wall] } {
	unset wall
    }
    if { [info exists texture] } {
	unset texture
    }
    if { [info exists region] } {
	unset region
    }
    if { [info exists region] } {
	unset area
    }
    if { [info exists p1] } {
	unset p1
    }
    if { [info exists p2] } {
	unset p2
    }
    if {[info exists area]} {
	unset area
    }
    set default(texture) "Undefined"
    set default(freg) 1
    set default(breg) 0
    set default(xscale) 0.1
    set default(yscale) 0.1
    set default(xphase) 0
    set default(yphase) 0
    set start "0 0"
    scale_canvas $canvas
    DrawStart $canvas
}

proc LoadWorld { canvas } {
    global wpath
    set fn [FSBox "Select world file" "*.world" "" "$wpath"]
    if { "$fn" != "" } {
	ReadWorld $fn $canvas
    }
    set wpath [file dirname $fn]
}


proc ReadWorld { fn canvas } {
    global texture tindex region rindex default wall doAreas start
    global catfile xfile
    setbusy 1 "Loading $fn ..."
    set fd [open $fn "r"]
    ClearWorld $canvas
    while { ![eof $fd] } {
	set line [gets $fd]
	switch  -- [lindex $line 0] {
            start {
  		set start "[lindex $line 1] [expr -[lindex $line 2]]"
            }
	    texture {
		set texture($tindex) "[lindex $line 1] [lindex $line 2]"
		incr tindex
	    }
	    vertex { 
		CreateVertex $canvas [lindex $line 1] [expr -[lindex $line 2]]
	    }
	    wall {
		while {[llength $line]<10} {
		    set line [concat $line [gets $fd]]
		}
		eval "CreateWall $canvas [lrange $line 1 9]"
	    }
	    region {
		set region($rindex) \
		    "[lindex $line 1] [lindex $line 2] \
                     [lindex $line 3] [lindex $line 4]"
		incr rindex
	    }
	    ";" {}
	    default {}
	}
    }
    close $fd
    $canvas delete start
    UpdateTextures
    UpdateRegions
    if { $doAreas } {
      UpdateAreas $canvas
    }
    if {[info exists texture]} {
	set default(texture) [lindex $texture(0) 0]
    }
    $canvas delete start
    scale_canvas $canvas
    DrawStart $canvas
    setbusy 0
}

proc SaveWorld { } {
    global wpath
    set fn [FSBox "Select Worldfile" "*.world" "" "$wpath"]
    if { "$fn" != "" } {
	WriteWorld $fn
    }
    set wpath [file dirname $fn]
}

proc WriteWorld { fn } {
    global texture vertex wall region tclformat
    global tindex vindex windex rindex start
    setbusy 1 "Saving $fn ..."
    set fd [open $fn "w"]
    puts $fd "start [lindex $start 0] [expr -[lindex $start 1]]"
    if { $tclformat } {
	puts  $fd "\n\# texture\n"
    } else {
	puts  $fd "\n; texture\n"
    }
    if { [info exists texture] } {
	for { set i 0 } { $i<$tindex } { incr i } {
	    if { $tclformat } {
		puts $fd "\# t$i"
		puts $fd "set [lindex $texture($i) 0] \
		\[ texture [lindex $texture($i) 1]\]"
	    } else {
		puts $fd "texture $texture($i)\t; t$i"
	    }
	}
    }
    if { $tclformat } {
	puts $fd "\n\# vertex\n"
    } else {
	puts $fd "\n; vertex\n"
    }
    if { [info exists vertex] } {
	for { set i 0 } { $i<$vindex } { incr i } {
	    if { $tclformat } {
		puts $fd "\# v$i"
		puts $fd "vertex [lindex $vertex($i) 0] [expr -[lindex $vertex($i) 1]]\t"
	    } else {
		puts $fd "vertex  [lindex $vertex($i) 0] [expr -[lindex $vertex($i) 1]]\t; v$i"
	    }
	}
    }
    if { $tclformat } {
	puts $fd "\n\# region\n"
    } else {
	puts $fd "\n; region\n"
    }
    if { [info exists region] } {
	for { set i 0 } { $i<$rindex } { incr i } {
	    if { $tclformat } {
		puts $fd "\# r$i"
		puts $fd "region [lrange $region($i) 0 1] \
                             \$[lindex $region($i) 2] \
                             \$[lindex $region($i) 3]"
	    } else {
		puts $fd "region $region($i)\t; r$i"
	    }
	}
    }
    if { $tclformat } {
	puts $fd "\n\# wall\n"
    } else {
	puts $fd "\n; wall\n"
    }
    if { [info exists wall] } {
	for { set i 0 } { $i<$windex } { incr i } {
	    if { $tclformat } {
		puts $fd "\# w$i"
		puts $fd "wall [lrange $wall($i) 0 1] \
                           \$[lindex $wall($i) 2] \
                           [lrange $wall($i) 3 4] \
		[lrange $wall($i) 5 8]"
	    } else {
		puts $fd "wall [lrange $wall($i) 0 2] \
	    [lrange $wall($i) 3 4] \
	[lrange $wall($i) 5 8]\t; w$i"
	    }
	}
    }
    close $fd
    setbusy 0
}

proc DrawVertex { canvas x y index } {
    global scale
    $canvas create oval \
	[expr ($x*$scale)-3] \
	[expr ($y*$scale)-3] \
	[expr ($x*$scale)+3] \
	[expr ($y*$scale)+3] \
	-fill red \
	-tags "[format v%d $index] vertex"
}

proc DrawStart { canvas } {
    global scale start
    set x [lindex $start 0]
    set y [lindex $start 1]
    $canvas create oval \
	[expr ($x*$scale)-5] \
	[expr ($y*$scale)-5] \
	[expr ($x*$scale)+5] \
	[expr ($y*$scale)+5] \
	-fill green \
	-tags start
}

proc CreateVertex { canvas x y } {
    global scale maxx maxy minx miny vertex vindex selection
    SelectItem $canvas
    set maxx [max $maxx $x]
    set maxy [max $maxy $y]
    set minx [min $minx $x]
    set miny [min $miny $y]
    set vertex($vindex) "$x $y"
    DrawVertex $canvas $x $y $vindex
    if {[info exists selection]} {
	set tags [$canvas gettags $selection]
	if {"[lindex $tags 1]"=="wall"} {
	    SplitWall $canvas [GetNumber [lindex $tags 0]] $vindex
	}
    }
    incr vindex
}

set busycnt 0
proc setbusy { onoff args } {
    global installdir busycnt
    if { $onoff } {
	incr busycnt
	if { $busycnt==1 } {
#	    grab set .edit
	    . configure -cursor "@$installdir/hourglass.mask \
			      $installdir/hourglass \
		              red white"
	}
    } else {
	incr busycnt -1
	if { $busycnt==0 } {
	    . configure -cursor ""
#	    grab release .edit
	}
    }
    if { $args == "" } {
	.bottom.msg configure -text "Ready."
	follow_mouse .edit.canvas 1
    } else {
	eval .bottom.msg configure -text $args
	follow_mouse .edit.canvas 0
    }
    update idletasks
}


proc follow_mouse { canvas state } {
    if { $state } {
	bind $canvas <Motion> [list update_mpos $canvas %x %y]
    } else {
	bind $canvas <Motion> ""
    }
}

# update mouse position display in status line
proc update_mpos { canvas x y } {
    global scale
    .bottom.msg configure \
	-text [format "x % 8.2f y % 8.2f" \
	       [expr [$canvas canvasx $x].0/$scale] \
	       [expr [$canvas canvasy $y].0/$scale]]
}


proc itemStartDrag {c x y} {
    global lastX lastY
    set lastX [$c canvasx $x]
    set lastY [$c canvasy $y]
}

proc itemDrag {c x y} {
    global lastX lastY p1 p2 wall vertex scale start
    set x [$c canvasx $x]
    set y [$c canvasy $y]
    set item [$c find withtag current]
    if { "[lindex [$c gettags current] 1]"=="vertex"} {
	$c move $item [expr $x-$lastX] [expr $y-$lastY]
	set vnum [GetNumber [lindex [$c gettags current] 0]]
	set vertex($vnum) "[expr $x.0/$scale] [expr $y.0/$scale]"
	if {[info exists p1($vnum)]} {
	    foreach i $p1($vnum) {
		set w [format w%d $i]
		set coords [$c coords $w]
	        $c coords $w $x $y [lindex $coords 2] [lindex $coords 3]
	    }
	}
	if {[info exists p2($vnum)]} {
	    foreach i $p2($vnum) {
		set w [format w%d $i]
		set coords [$c coords $w]
	        $c coords $w [lindex $coords 0] [lindex $coords 1] $x $y
	    }
	}
	set lastX $x
	set lastY $y
    } else {
	if { "[lindex [$c gettags current] 0]"=="start"} {
	    $c move $item [expr $x-$lastX] [expr $y-$lastY]
	    set start "[expr $x.0/$scale] [expr $y.0/$scale]"
	    set lastX $x
	    set lastY $y
	}
    }
}

proc StopDrag { canvas } {
    global vfirst vprev
    catch {
	unset vfirst 
	unset vprev
	$canvas delete current
    }
    follow_mouse $canvas 1
}

proc itemEnter {c} {
    global restoreCmd

    if {[tk colormodel $c] != "color"} {
	set restoreCmd {}
	return
    }
    set type [$c type current]
    if {$type == "bitmap"} {
	set bg [lindex [$c itemconf current -background] 4]
	set restoreCmd [list $c itemconfig current -background $bg]
	$c itemconfig current -background SteelBlue2
	return
    }
    set fill [lindex [$c itemconfig current -fill] 4]
    if {(($type == "rectangle") 
         || ($type == "oval") 
         || ($type == "arc"))
	    && ($fill == "")} {
	set outline [lindex [$c itemconfig current -outline] 4]
	set restoreCmd "$c itemconfig current -outline $outline"
	$c itemconfig current -outline SteelBlue2
    } else {
	set restoreCmd "$c itemconfig current -fill $fill"
	$c itemconfig current -fill SteelBlue2
    }
}

proc itemLeave {c} {
    global restoreCmd
    eval $restoreCmd
}

proc DrawObjects { canvas } {
    global scale vertex wall start
    scale_canvas $canvas
    $canvas delete all
    if {[info exists vertex]} {
	foreach i [array names vertex] {
	    DrawVertex $canvas [lindex $vertex($i) 0] [lindex $vertex($i) 1] $i
	}
    }
    if {[info exists wall]} {
	foreach i [array names wall] {
	    DrawWall $canvas $i
	}
    }
    if {[info exists area]} {
	for { set i 0 } { $i<$aindex } { incr i } {
	    DrawPolygon $canvas $i
	}
    }
    DrawStart $canvas
}

proc scale_canvas { canvas } {
    global scale maxx maxy minx miny
    $canvas configure -scrollregion \
	" [expr $minx*$scale-50] [expr $miny*$scale-50] \
	[expr $maxx*$scale+50] [expr $maxy*$scale+50]"
}

set auto_path "$installdir $auto_path"
source $installdir/Gray14.tcl

CreateTxDlg
CreatePrefsDlg
CreateRegionDlg
CreateWidgets

