#
#	tkMOO
#	map.tcl
#

# tkMOO-light is Copyright (c) Andrew Wilson 1994,1995,1996,1997
#
#	All Rights Reserved
#
# Permission is hereby granted to use this software for private, academic
# and non-commercial use. No commercial or profitable use of this
# software may be made without the prior permission of the author.
# 
# THIS SOFTWARE IS PROVIDED BY ANDREW WILSON ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT ANDREW WILSON BE LIABLE FOR
# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

proc xmcp11.do_xmap* {} {
    if { [xmcp11.authenticated silent] == 1 } {
	request.set current xmcp11_multiline_procedure "xmap*"
    }
}

proc xmcp11.do_callback_xmap* {} {
    map.set_map
}

proc map.you_are_here oid {
    global map_oid_to_item map_data map_title
    set m .map
    if { [winfo exists $m] == 1 } {
#        puts "you are here ($oid)"
	$m.c itemconfigure box -fill blue
	$m.c itemconfigure $map_oid_to_item($oid) -fill red
	$m.c raise $map_oid_to_item($oid)
	# show location
	set map_title ""
	catch { set map_title $map_data($oid,title) }
#	puts "title= >$map_title<"
	$m.title configure -text [rose.clip $map_title 30] -foreground red
#	puts "title set..."
    }
}

proc map.set_map {} {
    global map_oid_to_item map_data
    set m .map

    # destroy

    catch { destroy $m };

    # create
    toplevel $m

    set title "[worlds.get [worlds.get_current] Name]"
    wm title $m "Map: $title"
    wm iconname $m "Map: $title"

    set canvas_width 200
    set canvas_height 200

    set border 5

    canvas $m.c -width $canvas_width -height $canvas_height

    pack configure $m.c -side top -in $m

    label $m.title -text "" -relief groove -bd 2 -highlightthickness 0
    pack configure $m.title -side bottom -fill x -in $m

    # fill
    set which [request.current]
    set lines [request.get $which _lines]
#    puts "lines= $lines"

    set location [request.get $which location]
#    puts "location= $location"
    set room_index 1
    catch { unset map_data }
    set exits {}
    set maxx 0
    set maxy 0
    foreach line $lines {
#	puts "line= $line"
	if { [regexp {^(#[0-9]+):(.+),(.+)$} $line all oid x y] == 1 } {
	    set map_data($room_index,oid) $oid
	    set map_data($room_index,x)	$x
	    set map_data($room_index,y)	$y
	    if { $x > $maxx } { set maxx $x }
	    if { $y > $maxy } { set maxy $y }
	    incr room_index
	    continue
	}
	if { [regexp {^([0-9]+),([0-9]+)$} $line all from to] == 1 } {
	    lappend exits [list $from $to]
	    continue
	}
	if { [regexp {^(#[0-9]+)/(.+)$} $line all oid title] == 1 } {
	    set map_data($oid,title) $title
	}
    }

    # calculate scale
    set scalex [expr ($canvas_width - 2*$border) / $maxx]
    set scaley [expr ($canvas_height - 2*$border) / $maxy]

    set side 3
    set X 10
    set Y 10
    set X 0
    set Y 0

    for { set i 1 } { $i < $room_index } { incr i } {
	set x1 [expr $map_data($i,x)]
	set y1 [expr $map_data($i,y)]
	set x2 [expr $map_data($i,x)]
	set y2 [expr $map_data($i,y)]
	# scale stuff
	set x1 [expr $x1 * $scalex]
	set y1 [expr $y1 * $scaley]
	set x2 [expr $x2 * $scalex]
	set y2 [expr $y2 * $scaley]
	# sides
        set x1 [expr $x1 - $side]     
        set y1 [expr $y1 - $side]     
        set x2 [expr $x2 + $side]     
        set y2 [expr $y2 + $side]     
	# border offset
	set x1 [expr $x1 + $border]
	set y1 [expr $y1 + $border]
	set x2 [expr $x2 + $border]
	set y2 [expr $y2 + $border]

	if { $location == $map_data($i,oid) } {
	    set colour red
	} {
	    set colour blue
	}
	set map_room($i) [$m.c create rectangle $x1 $y1 $x2 $y2 -fill $colour -tags box]
	set map_oid_to_item($map_data($i,oid)) $map_room($i)
	$m.c bind $map_room($i) <B1-ButtonRelease> "io.outgoing \"walk to $map_data($i,oid)\""
	set title ""
	catch { set title $map_data($map_data($i,oid),title) }
	if { $title != "" } {
	    $m.c bind $map_room($i) <Enter> "map.show_title \{$title\}"
	    $m.c bind $map_room($i) <Leave> "map.show_title \{\}"
	}
    }

    set line_width 2
    foreach exit $exits {
	set from [lindex $exit 0]
	set to   [lindex $exit 1]
	set fx [expr $map_data($from,x) * $scalex]
	set fy [expr $map_data($from,y) * $scaley]
	set tx [expr $map_data($to,x) * $scalex]
	set ty [expr $map_data($to,y) * $scaley]
	# border offset
	set fx [expr $fx + $border]
	set fy [expr $fy + $border]
	set tx [expr $tx + $border]
	set ty [expr $ty + $border]
	# repeat last set of points and use splines for better lines
	# we're drawing lines both ways, perhaps that's what makes
	# non splined lines look so aweful?
	set l [$m.c create line $fx $fy $tx $ty $tx $ty \
	       -smooth 1 -arrow last -width $line_width]
	$m.c lower $l
    }

    map.you_are_here $location
}

proc map.show_title { title } {
    global map_title
    set m .map
    if { $title == "" } {
    catch { set title $map_title }
        $m.title configure -text [rose.clip $title 30] -foreground red
    } {
        $m.title configure -text [rose.clip $title 30] -foreground black
    }
}