# This proc lets you map areas on the mud and do other neat things.
# Of course the action patterns will be different for every mud...

# Syntax:
# An id represents a room and is of the form "row,col"
#
# on
#       start mapping
# off
#       stop mapping
# print ?id1? ?id2?
#       print map with id1 as top left and id2 and bottom right
#       defaults to whole map
# topleft
#       return id of top left room
# bot_right
#       return id of bottom right room
# rooms
#       return list of all rooms
# descript id
#       return descript of id
# exits id
#       return list of exits of id
# find pattern
#       return list of rooms with descript matching pattern
# dump file
#       write map to file
# path
#       return list of dirs from last mark
# mark
#       mark beginning of path
# pos
#       return id of current room

proc map {args} {
    global _map _map_grid
     
    set dirs {n e w s ne nw se sw}

    set syntax {
	on {}
	off {}
	print {{? id1} {? id2}}
	top_left {}
	bot_right {}
	find {{+ pattern}}
	descript {{+ id}}
	exits {{+ id}}
	dump {{+ file}}
	rooms {}
	pos {}
	mark {}
	path {}
    }
    
    switch -exact [check -opts map $syntax $args] {
	on {
	    foreach d $dirs {
		alias set -group map -- $d [list _map_move $d]
	    }

	    action set -group map -- {%^%s [%w].} {
		_map_got_room [split $3 ,] $2
	    }

	   array set _map {
	       x 0
	       y 0
	       tl_x 0
	       tl_y 0
	       br_x 0
	       br_y 0
	       path {}
	   }
       } off {
	   group delete map
	   catch {unset _map _map_grid}
       } print {
	   if {![info exists arg(id1)]} {
	       set arg(id1) $_map(tl_y),$_map(tl_x)
	   }
	   if {![info exists arg(id2)]} {
	       set arg(id2) $_map(br_y),$_map(br_x)
	   }
	   
	   echo
	   echo [_map_dump $arg(id1) $arg(id2) 1]
       } dump {
	   set fd [open $arg(file) w]
	   puts $fd [_map_dump $_map(tl_y),$_map(tl_x) $_map(br_y),$_map(br_x)]
	   flush $fd
	   close $fd
       } top_left {
	   return $_map(tl_y),$_map(tl_x)
       } bot_right {
	   return $_map(br_y),$_map(br_x)
       } find {
	   set res {}
	   foreach id [array names _map_grid] {
	       if {[string match $pattern [lindex $_map_grid($id) 1]]} {
		   lappend res $id
	       }
	   }
	   return $res
       } rooms {
	   return [array names _map_grid]
       } descript {
	   return [lindex $_map_grid($arg(id)) 1]
       } exits {
	   return [lindex $_map_grid($arg(id)) 0]
       } mark {
	   set _map(path) {}
       } path {
	   return $_map(path)
       } pos {
	   return $_map(y),$_map(x)
       }
   }
   
   return
}

# indicate we moved to a new room
proc _map_move {d} {
    global _map
    
    set _map(dir) $d
    write $d
}

# return map rep. as a string
proc _map_dump {r1 r2 {ansi 0}} {
    global _map_grid _map
    
    foreach {y1 x1} [split $r1 ,] break
    foreach {y2 x2} [split $r2 ,] break

    for {set j $y1} {$j <= $y2} {incr j} {
	for {set k 0} {$k < 3} {incr k} {
	    for {set i $x1} {$i <= $x2} {incr i} {
		if {[info exists _map_grid($j,$i)]} {
		    if {$ansi && $i == $_map(x) && $j == $_map(y)} {
			append str [color [_map_room_row $k\
				[lindex $_map_grid($j,$i) 0]] {bold red}]
		    } else {
			append str [_map_room_row $k\
				[lindex $_map_grid($j,$i) 0]]
		    }
		} else {
		    append str "   "
		}
	    }
	    append str \n
	}
    }
    
    return $str
}

# each room is 3 lines of this form:
# \|/
# -o-
# /|\

# Return 1 row of the room

proc _map_room_row {col exits} {
    if {$col == 0} {
	if {[lsearch -exact $exits "nw"] != -1} {
	    append str "\\"
	} else {
	    append str " "
	}

	if {[lsearch -exact $exits "n"] != -1} {
	    append str "|"
	} else {
	    append str " "
	}
	
	if {[lsearch -exact $exits "ne"] != -1} {
	    append str "/"
	} else {
	    append str " "
	}
    } elseif {$col == 1} {
	if {[lsearch -exact $exits "w"] != -1} {
	    append str "-"
	} else {
	    append str " "
	}

	append str "o"

	if {[lsearch -exact $exits "e"] != -1} {
	    append str "-"
	} else {
	    append str " "
	}
    } else {
	if {[lsearch -exact $exits "sw"] != -1} {
	    append str "/"
	} else {
	    append str " "
	}
	
	if {[lsearch -exact $exits "s"] != -1} {
	    append str "|"
	} else {
	    append str " "
	}

	if {[lsearch -exact $exits "se"] != -1} {
	    append str "\\"
	} else {
	    append str " "
	}
    }
    
    return $str
}

# add a room to map
proc _map_got_room {exits descript} {
    global _map _map_grid

    if {![info exists _map(dir)]} {
	return
    }

    array set dir {
	n  {-1 0}
	e  {0 1}
	w  {0 -1} 
	s  {1 0}
	ne {-1 1}
	nw {-1 -1}
	se {1 1}
	sw {1 -1}
    }

    lappend _map(path) $_map(dir)

    incr _map(y) [lindex $dir($_map(dir)) 0]
    incr _map(x) [lindex $dir($_map(dir)) 1]

   
    if {$_map(x) < $_map(tl_x)} {
	set _map(tl_x) $_map(x)
    } elseif {$_map(x) > $_map(br_x)} {
	set _map(br_x) $_map(x)
    }
    
    if {$_map(y) < $_map(tl_y)} {
	set _map(tl_y) $_map(y)
    } elseif {$_map(y) > $_map(br_y)} {
	set _map(br_y) $_map(y)
    }

    set _map_grid($_map(y),$_map(x)) [list $exits $descript]
    
    unset _map(dir)
}