#!/usr/bin/perl -w

# Perl/Tk script to make/display/calculate maps
# November 2001 - September 2002
# Jess Robinson (castaway@desert-island.m.isar.de)
# 7 - 06.09.2002
# 8 - 12.09.2002
# Parameter: '-standalone' -> don't create a socket to listen to
# 9 - 02.10.2002

use Socket;
use IO::Handle;
use Storable qw(store retrieve dclone);
use Tk;
use Cwd;

#######################################################################
# Global variables
#
my $SocketConnected;    # Are we connected to a socket?
my $location;
my %RoomIds;            # Maps Room IDs from graphic object to nodes
my $CurrentNode;        # Node information for current mapper node
my $CurrentRoomId;      # Current graphic room ID
my $CurrentLocation;    # Where am I standing
my $CurrentLevel;       # Current level that the mapper is showing
my $CurrentZone;        # Name of the current zone
my $CurrentRoomName;    # Name of the currently created room
my $CurrentRoomDesc;    # Description of the currently created room
my $ClickedRoom;        # Room in which the mouse was last clicked
my $ZoneList;           # List containing all zones
my $NodeList;           # List containing all nodes
my $CoordList;          # Coordinates of each node
my @SelectedRooms;      # Array of selected Room and Link Ids 
my @Directions;         # Maps IDs to directions and opposites        
my %Dirs;               # Maps mud-dirs to IDs
my $DirFileName;        # Current file for directions
my $MapFileName;        # Current file for map
my $SettingsFileName;   # Current file for settings
my $NodeCount;          # How many nodes have we got? (Index of next new node)
my $Exits;              # Temporary Exit->Node list
my @NewCoords;          # Temporary new coordinate list
my $GMouseX = 0;        # Global position of mouse on screen
my $GMouseY = 0;        # 
my $LMouseX = 0;        # Local position of mouse in canvas
my $LMouseY = 0;        #
my $AutomaticLinks;     # Automatically link back to previous room?
my $MapMode;            # Map=1, Follow=2, Off=0

my $DragFromX;          # Position of last mouse cursor for drag
my $DragFromY;          #
my $NewRoom;
my %Settings;           # Collect settings to save

my $Pixels10m;          # 10mm in pixels
my $Pixels10md4;        # quarter of 10m in pixels

my $LevelLabel;
my $ZoneLabel;

my $FieldSeparator;     # Separates different fields of the message
my $DataSeparator;      # Separates data field
#my $Waiting;            # 1 - If waiting for data from client, eg: Room name/
                        # Description/exits
my $RoomName;           # Name of current room, or undef
my $RoomDescription;    # Description of current room, or undef

init_map();
create_socket();
create_mapper();

sub init_map
{
    $SocketConnected = 0;
    $CurrentRoomName = '';
    $CurrentRoomDesc = '';
    %RoomIds = ();
    $ZoneList = ();
    $NodeList = ();
    @SelectedRooms = ();
    $CurrentNode = ();
    $CurrentLocation = 1;
    $CurrentLevel = 0;
    $CurrentZone = 'main';
    $CoordList = ();
    $NodeCount = 1;
    $Exits = ();
    @NewCoords = ();
#    $Planets = ();

    # set symbolic directions which will be used in the %exits hash,
    # so that directions still work when the names are changed!

    $Dirs{'<South>'} = 1;
    $Dirs{'sueden'} = 1;
    $Dirs{'s'} = 1;
    $Dirs{'Down'} = 1;
    $Dirs{'<North>'} = 2;
    $Dirs{'norden'} = 2;
    $Dirs{'n'} = 2;
    $Dirs{'Up'} = 2;
    $Dirs{'<East>'} = 3;
    $Dirs{'osten'} = 3;
    $Dirs{'o'} = 3;
    $Dirs{'Right'} = 3;
    $Dirs{'<West>'} = 4;
    $Dirs{'westen'} = 4;
    $Dirs{'w'} = 4;
    $Dirs{'Left'} = 4;
    $Dirs{'<Northwest>'} = 5;
    $Dirs{'nordwesten'} = 5;
    $Dirs{'nw'} = 5;
    $Dirs{'<Southeast>'} = 6;
    $Dirs{'suedosten'} = 6;
    $Dirs{'so'} = 6;
    $Dirs{'<Southwest>'} = 7;
    $Dirs{'suedwesten'} = 7;
    $Dirs{'sw'} = 7;
    $Dirs{'<Northeast>'} = 8;
    $Dirs{'nordosten'} = 8;
    $Dirs{'no'} = 8;
    $Dirs{'<Up>'} = 9;
    $Dirs{'oben'} = 9;
    $Dirs{'b'} = 9;
    $Dirs{'hoch'} = 9;
    $Dirs{'Prior'} = 9;
    $Dirs{'<Down>'} = 10;
    $Dirs{'unten'} = 10;
    $Dirs{'u'} = 10;
    $Dirs{'runter'} = 10;
    $Dirs{'Next'} =  10;
    $Dirs{'<Southwestup>'} = 11;
    $Dirs{'<Northeastdown>'} = 12;
    $Dirs{'<Southeastup>'} = 13;
    $Dirs{'<Northwestdown>'} = 14;
    $Dirs{'<Southwestdown>'} = 15;
    $Dirs{'<Northeastup>'} = 16;
    $Dirs{'<Southeastdown>'} = 17;
    $Dirs{'<Northwestup>'} = 18;
    $Dirs{'<Southup>'} = 19;
    $Dirs{'<Northdown>'} = 20;
    $Dirs{'<Southdown>'} = 21;
    $Dirs{'<Northup>'} = 22;
    $Dirs{'<Eastup>'} = 23;
    $Dirs{'<Westdown>'} = 24;
    $Dirs{'<Eastdown>'} = 25;
    $Dirs{'<Westup>'} = 26;

    # 'Name' of direction is first 'dirs'
    $Directions[1]{'direction'} = [0, 1, 0]; #    (change in x,y,z)
    $Directions[1]{'opposite'} = 2;
    $Directions[1]{'dirs'} = ['<South>', 'sueden', 's', 'Down'];
    $Directions[2]{'direction'} = [0, -1, 0]; #    (change in x,y,z)
    $Directions[2]{'opposite'} = 1;
    $Directions[2]{'dirs'} = ['<North>', 'norden', 'n', 'Up'];
    $Directions[3]{'direction'} = [1, 0, 0]; #    (change in x,y,z)
    $Directions[3]{'opposite'} = 4;
    $Directions[3]{'dirs'} = ['<East>', 'osten', 'o', 'Right'];
    $Directions[4]{'direction'} = [-1, 0, 0]; #    (change in x,y,z)
    $Directions[4]{'opposite'} = 3;
    $Directions[4]{'dirs'} = ['<West>', 'westen', 'w', 'Left'];
    $Directions[5]{'direction'} = [-1, -1, 0]; #    (change in x,y,z)
    $Directions[5]{'opposite'} = 6;
    $Directions[5]{'dirs'} = ['<Northwest>', 'nordwesten', 'nw'];
    $Directions[6]{'direction'} = [1, 1, 0]; #    (change in x,y,z)
    $Directions[6]{'opposite'} = 5;
    $Directions[6]{'dirs'} = ['<Southeast>', 'suedosten', 'so'];
    $Directions[7]{'direction'} = [-1, 1, 0]; #    (change in x,y,z)
    $Directions[7]{'opposite'} = 8;
    $Directions[7]{'dirs'} = ['<Southwest>', 'suedwesten', 'sw'];
    $Directions[8]{'direction'} = [1, -1, 0]; #    (change in x,y,z)
    $Directions[8]{'opposite'} = 7;
    $Directions[8]{'dirs'} = ['<Northeast>', 'nordosten', 'no'];
    $Directions[9]{'direction'} = [0, 0, 1]; #    (change in x,y,z)
    $Directions[9]{'opposite'} = 10;
    $Directions[9]{'dirs'} = ['<Up>', 'oben', 'b', 'hoch', 'ob', 'Prior'];
    $Directions[10]{'direction'} = [0, 0, -1]; #    (change in x,y,z)
    $Directions[10]{'opposite'} = 9;
    $Directions[10]{'dirs'} = ['<Down>', 'unten', 'u', 'runter', 'Next'];
    $Directions[11]{'direction'} = [-1, 1, 1];
    $Directions[11]{'dirs'} = ['<Southwestup>'];
    $Directions[11]{'opposite'} = 12;
    $Directions[12]{'direction'} = [1, -1, -1];
    $Directions[12]{'opposite'} = 11;
    $Directions[12]{'dirs'} = ['<Northeastdown>'];
    $Directions[13]{'direction'} = [1, 1, 1];
    $Directions[13]{'opposite'} = 14;
    $Directions[13]{'dirs'} = ['<Southeastup>'];
    $Directions[14]{'direction'} = [-1, -1, -1];
    $Directions[14]{'opposite'} = 13;
    $Directions[14]{'dirs'} = ['<Northwestdown>'];
    $Directions[15]{'direction'} = [-1, 1, -1];
    $Directions[15]{'opposite'} = 16;
    $Directions[15]{'dirs'} = ['<Southwestdown>'];
    $Directions[16]{'direction'} = [1, -1, 1];
    $Directions[16]{'opposite'} = 15;
    $Directions[16]{'dirs'} = ['<Northeastup>'];
    $Directions[17]{'direction'} = [1, 1, -1];
    $Directions[17]{'opposite'} = 18;
    $Directions[17]{'dirs'} = ['<Southeastdown>'];
    $Directions[18]{'direction'} = [-1, -1, 1];
    $Directions[18]{'opposite'} = 17;
    $Directions[18]{'dirs'} = ['<Northwestup>'];
    $Directions[19]{'direction'} = [0, 1, 1];
    $Directions[19]{'opposite'} = 20;
    $Directions[19]{'dirs'} = ['<Southup>'];
    $Directions[20]{'direction'} = [0, -1, -1];
    $Directions[20]{'opposite'} = 19;
    $Directions[20]{'dirs'} = ['<Northdown>'];
    $Directions[21]{'direction'} = [0, 1, -1];
    $Directions[21]{'opposite'} = 22;
    $Directions[21]{'dirs'} = ['<Southdown>'];
    $Directions[22]{'direction'} = [0, -1, 1];
    $Directions[22]{'opposite'} = 21;
    $Directions[22]{'dirs'} = ['<Northup>'];
    $Directions[23]{'direction'} = [1, 0, 1];
    $Directions[23]{'opposite'} = 24;
    $Directions[23]{'dirs'} = ['<Eastup>'];
    $Directions[24]{'direction'} = [-1, 0, -1];
    $Directions[24]{'opposite'} = 23;
    $Directions[24]{'dirs'} = ['<Westdown>'];
    $Directions[25]{'direction'} = [1, 0, -1];
    $Directions[25]{'opposite'} = 26;
    $Directions[25]{'dirs'} = ['<Eastdown>'];
    $Directions[26]{'direction'} = [-1, 0, 1];
    $Directions[26]{'opposite'} = 25;
    $Directions[26]{'dirs'} = ['<Westup>'];

    $DirFileName = '';
    $GMouseX = 0;
    $GMouseY = 0;
    $LMouseX = 0;
    $LMouseY = 0;
    $AutomaticLinks = 1;
    $MapMode = 1;
    $DragFromX = 0;
    $DragFromY = 0;
    $NewRoom = 0;
    $FieldSeparator = '#';
    $DataSeparator = ':';
#    $Waiting = 0;
    $RoomName = undef;
    $RoomDescription = undef;
}

#######################################################################
# Create a socket to receive and send map information
#
sub create_socket
{
    # Parameter: None

    if(@ARGV)
    {
	if(is_member('-standalone', @ARGV) > -1)
	{
	    print("Start without socket!\n");
	    return 0;
	}
    }

    my $proto = getprotobyname('tcp');
    my $name = '/tmp/mappersock';      # Windows??
#    my $uaddr = sockaddr_un($name);
    my $serverport = 11111;
    my $inetaddr = sockaddr_in($serverport, INADDR_ANY); 

#    socket(Server, PF_UNIX, SOCK_STREAM, 0)   || die "socket: $!";
    socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 1);
#    unlink($name);
#    bind(Server, $uaddr)                      || die "bind: $!";
    bind(Server, $inetaddr)                      || die "bind: $!";
    listen(Server, SOMAXCONN)                    || die "listen: $!";

    Server->autoflush();
#    return Server;
}

#######################################################################
# Tk Components and callbacks
#
sub create_mapper
{
    # Parameter: Socket handle
    $Mapper = MainWindow->new();
    my $menu = $Mapper->Menu();
    $mfile = $menu->cascade(-accelerator => '<Alt-F>',
			    -label => 'File',
			    -tearoff => 0,
			    -underline => 0);
    $mfile->command(-label => 'Load map',
		    -accelerator => '<Ctrl-L>',
		    -underline => 0,
		    -command => [\&load_map] );
    $mfile->command(-label => 'Save map',
		    -accelerator => '<Ctrl-S>',
		    -underline => 0,
		    -command => [\&save_map, 0] );		    
    $mfile->command(-label  => 'Quit',
		    -underline => 0,
		    -command => [$Mapper => 'destroy'] );
    $mmap = $menu->cascade(-accelerator => '<Alt-M>',
			   -label => 'Map',
			   -tearoff => 0,
			   -underline => 0);
    $mmap->command(-label => 'New Room',
		   -underline => 4,
		   -command => [\&create_room] );
    $mmap->command(-label => 'New Link',
		   -underline => 4,
		   -command => [\&create_link] );
    $msettings = $menu->cascade(-accelerator => '<Alt S>',
				-label => 'Settings',
				-tearoff => 0,
				-underline => 0);
    $msettings->command(-label => 'Save settings',
			-underline => 0,
			-command => [\&save_settings] );
    $msettings->command(-label => 'Load settings',
			-underline => 5,
			-command => [\&load_settings] );
    $msettings->command(-label => 'Edit Directions',
			-underline => 5,
			-command => [\&edit_directions] );
    $msettings->checkbutton(-label => 'Automatic links',
			    -onvalue => 1,
			    -offvalue => 0,
			    -variable => \$AutomaticLinks);
    $mmap = $menu->cascade(-accelerator => '<Alt M>',
			   -label => 'Map mode',
			   -tearoff => 0,
			   -underline => 0);
    $mmap->radiobutton(-label => 'Map',
		       -value => 1,
		       -variable => \$MapMode,
		       -command => [\&change_mapmode]);
    $mmap->radiobutton(-label => 'Follow',
		       -value => 2,
		       -variable => \$MapMode,
		       -command => [\&change_mapmode]);
    $mmap->radiobutton(-label => 'Off',
		       -value => 0,
		       -variable => \$MapMode,
		       -command => [\&change_mapmode]);
		   
    $Mapper->configure(-menu => $menu );
#$menu->post(x,y) - post menu on screen at point (right-mouse-button?)
#$menu->postcascade(index)

    my $frame = $Mapper->Frame();
    $frame->pack(-side => 'top', -expand => 1);
    $Pixels10m = int($Mapper->pixels('10m'));
    $Pixels10md4 = ($Pixels10m/4);
    print("create_mapper: $Pixels10m\n");
    print("create_mapper: $Pixels10md4\n");

    $MCanvas = $frame->Scrolled('Canvas',
				-height => 10*$Pixels10m,
				-width => 10*$Pixels10m,
				-borderwidth => 2,
				-relief => 'sunken',
				-scrollregion =>
				[0, 0, 400*$Pixels10m, 400*$Pixels10m],
				-scrollbars => 'se');

    $MCanvas->configure(-xscrollincrement => $Pixels10m,
			-yscrollincrement => $Pixels10m);
    $MCanvas->pack(-side => 'right', -expand => 1);
    $buttonlist = $frame->Frame();
    $buttonlist->Button(-text => 'Room',
			-command => [\&create_room] )->pack(-expand => 1,
							    -fill => 'x');
    $buttonlist->Button(-text => 'Link',
			-command => [\&create_link] )->pack(-expand => 1,
							    -fill => 'x');
    $buttonlist->Button(-text => 'Level +',
			-command => [\&change_level, 1] )->pack(-expand => 1,
							    -fill => 'x');
    $buttonlist->Button(-text => 'Level -',
			-command => [\&change_level, -1] )->pack(-expand => 1,
							    -fill => 'x');
    $LevelLabel = $buttonlist->Label(-text => '0', -relief => 'sunken',
		       )->pack(-expand => 1,    -fill => 'x');
    $buttonlist->Label(-text => 'Current Zone'
			)->pack(-expand => 1, -fill => 'x');
    $ZoneLabel = $buttonlist->Label(-text => 'main', -relief => 'sunken',
				     )->pack(-expand => 1, -fill => 'x');
    $buttonlist->pack();

#    draw_room(200,200,5);
#    draw_room(1,1,5);
#    draw_room(2,2,5);
    createstartroom();

    $MCanvas->createGrid(0,0,$Pixels10m, $Pixels10m);

    $MCanvas->bind('room', '<Shift-ButtonPress-1>',
		   [\&select_room]);
    $MCanvas->bind('room', '<ButtonPress-1>', 
		   [\&room_click1, Ev('x'), Ev('y')]);
    $MCanvas->bind('link', '<ButtonPress-1>', \&link_click1);
    $MCanvas->bind('room', '<ButtonPress-2>', \&room_click2);
    $MCanvas->bind('room', '<ButtonPress-3>', 
		   [\&room_click3, Ev('x'), Ev('y')]);
    $MCanvas->bind('room', '<B1-Motion>', [\&move_room, Ev('x'), Ev('y')]);
    $MCanvas->bind('room', '<ButtonRelease-1>', [\&stop_move_room]);
    # Use CanvasBind to get the canvas subwidget of the scrolled canvas pane!
    $MCanvas->Tk::bind($MCanvas, '<KeyRelease>', [\&room_command, Ev('K')]);

    $MCanvas->CanvasBind('<ButtonPress-1>', 
		       [\&set_focus, $MCanvas]);
    $MCanvas->CanvasBind('<Shift-ButtonPress-1>', 
		       [\&select_drag_start, Ev('x'), Ev('y')]);
    $MCanvas->CanvasBind('<Shift-B1-Motion>', 
		       [\&select_drag, Ev('x'), Ev('y')]);
    $MCanvas->CanvasBind('<ButtonRelease-1>', 
		       [\&select_drag_end, Ev('x'), Ev('y')]);
    
    $Mapper->Button(-text => 'Close', -command => [sub {close(Server); 
							$Mapper->destroy()}]
		    )->pack();
    $MCanvas->xview('moveto', 0.4875);
    $MCanvas->yview('moveto', 0.4875);

    $Mapper->fileevent('Server', 'readable', [\&start_server]);
    MainLoop;
}

#######################################################################
# Callback functions for main window of Mapper
#
sub change_mapmode
{
    # Called when the value of MapMode is changed using the menu
    # Sends a corresponding message to the client, if any (=Code 01)
    # Parameter: None

    if(!$SocketConnected)
    {
	print("change_mapmode: No socket\n");
	return;
    }
    # message 1 of 1, code 1, length 1
    my $data = '#' . $MessageID ++ . '#01/01#01#01#' . $MapMode . "\n";
    print Client $data;
}

sub room_click2
{
    # Pressing the middle mouse button sets the currentlocation (and node)
    # to the clicked on room
    # Parameter: None

    print("room_click2: set location\n");
    my $room = get_current_room();
    print("room_click2: Room-Id: $room\n");
    my $node = $NodeList->{$room}[0];
    print("room_click2: Node: $node\n");
    my $t = $MCanvas->coords($node->{'RoomId'});
    print("room_click2: Coords: " . $t->[0] . "\n");
    print("room_click2: Coords: " . $t->[1] . "\n");
    print("room_click2: Coords: " . $t->[2] . "\n");
    print("room_click2: Coords: " . $t->[3] . "\n");
    set_location($room);
}

sub room_click1
{
    # Pressing button 1 in a room starts a drag operation
    # Parameter: x and y mouse coordinates

    print("room_click1: Room clicked\n");
#    print("Values\n(", (join "   ", %{$_[1]}), ")\n");
    print("room_click1: @_\n");
    my @rect = $MCanvas->find('withtag', 'current');
    my $r = $rect[0];
    print("room_click1: Room-Id: $r\n");
    print($RoomIds{$r} . "\n");
    print("room_click1: Room Name: " . 
	  $NodeList->{$RoomIds{$r}}[0]{'name'} . "\n");

    # Set current coordinates for dragging: 
    $DragFromX = $_[1];
    $DragFromY = $_[2];

    print("room_click1: Coords: " . $NodeList->{$RoomIds{$r}}[1] . "\n");
    print("room_click1: Coords: " . $NodeList->{$RoomIds{$r}}[2] . "\n");
    print("room_click1: $DragFromX, $DragFromY\n");
    
    # Tag 'current' is the item which is under the mouse cursor
    # $wigdet->pixels(number) converts '1m' to pixels etc.
    # $widget->pointerx mouse x-coord
    # $widget->pointery mouse y-coord
    # $widget->pointerxy list with x + y
    # $widget->screenmmwidth screen width in milimeters
    # $MCanvas->focus(?tagOrId?);
}

sub room_click3
{
    # Pressing button 3 in a room opens a cascading menu with options
    # that can be applied to the current room
    # Parameter: x and y mouse coordinates

    $mcascade = $Mapper->Menu();
    $mcascade->command(-label => 'Set location',
			-underline => 0,
			-command => [\&room_click2]);
    $mcascade->separator();
    $mcascade->command(-label => 'Walk to room',
		       -underline => 0,
		       -command => [\&goto_room]);
    $mcascade->separator();
    $mcascade->command(-label => 'Create zone here',
		       -underline => 7,
		       -command => [\&create_zone]);
    $mcascade->command(-label => 'Delete room',
			-underline => 7,
			-command => [\&delete_room]);
    $mcascade->command(-label => 'Delete link',
			-underline => 7,
			-command => [\&delete_link]);

    # Remember global mouse position for use in functions (and post command) 
    $GMouseX = $MCanvas->pointerx;
    $GMouseY = $MCanvas->pointery;
    print("room_click3: @_\n");
    # Remember local mouse position (to canvas) for use in functions
    $LMouseX = $_[1];
    $LMouseY = $_[2];
    # Remember current room!
    $ClickedRoom = $MCanvas->find('withtag', 'current');
    print("room_click3: GMouseX: $GMouseX\n");
    print("room_click3: GMouseY: $GMouseY\n");
    print("room_click3: LMouseX: $LMouseX\n");
    print("room_click3: LMouseY: $LMouseY\n");
    $mcascade->post($GMouseX, $GMouseY);
}

sub link_click1
{
    # Pressing button 1 on a link calls this function
    # (Does nothing at the moment -> move/drag link end?)
    # Parameter: None
    print("link_click1: Link clicked\n");
    print($MCanvas->xview() . "\n");
    print($MCanvas->yview() . "\n");
}

sub room_command
{
    # Pressing any key on the keyboard calls this function
    # Interprets cursor keys as north, south etc.
    # Parameter: Keysym of key pressed

    print("room_command: KeyPress\n");
    my ($parent, $keysym) = @_;
    print("room_command: $keysym\n");
    print("room_command: " . $MCanvas->xview() . "\n");
    print("room_command: " . $MCanvas->yview() . "\n");

    # Check for Up/Down/Left/Right and set Exits/Direction
    my $dir;
#    $dir = $Directions[$Dirs{$keysym}];
    $dir = $Dirs{$keysym};

    if(!$dir)
    {
	print("room_command: Ignored key $keysym\n");
	return;
    }
    $dir = $Directions[$dir];

    print("room_command: CurrentNode: " . $CurrentNode->{'id'} . "\n");
    create_new_room($CurrentNode->{'id'}, $dir->{'dirs'}[1], $dir, 0);
    print("room_command: CurrentNode: " . $CurrentNode->{'id'} . "\n");

}


sub move_room
{
    # Function is called when moving the mouse with button 1 pressed
    # Move 'current' room to current mouse coordinates
    # Parameter: None
    my ($c, $dragtox, $dragtoy) = @_;
    
#    print("move_room: From: $DragFromX, $DragFromY\n");
#    print("move_room: To  : $dragtox, $dragtoy\n");

    my $moveroom = 0;
    my $xco2 = 0;
    my $yco2 = 0;
#    my $pixels10m = $MCanvas->pixels('10m');

    if($dragtox >= $DragFromX + $Pixels10m)
    {
	$dragtox = $DragFromX + $Pixels10m;
	$dragtoy = $DragFromY;
	$moveroom = 1;
	$xco2 = 1;
    }
    elsif($dragtox <= $DragFromX - $Pixels10m)
    {
	$dragtox = $DragFromX - $Pixels10m;
	$dragtoy = $DragFromY;
	$moveroom = 1;
	$xco2 = -1;
    }
    elsif($dragtoy >= $DragFromY + $Pixels10m)
    {
	$dragtoy = $DragFromY + $Pixels10m;
#	$dragtox = $DragFromX;
	$moveroom = 1;
	$yco2 = 1;
    }
    elsif($dragtoy <= $DragFromY - $Pixels10m)
    {
	$dragtoy = $DragFromY - $Pixels10m;
#	$dragtox = $DragFromX;
	$moveroom = 1;
	$yco2 = -1;
    }
    if($moveroom)
    {
	if(!@SelectedRooms)
	{
	    $SelectedRooms[0] = $NodeList->{get_current_room()}[0]{'RoomId'};
	}
	my $cl = $NodeList->{$CurrentLocation}[0]{'RoomId'};
	if(is_member($cl, @SelectedRooms > -1))
	{
	    # Move current location mit (redraw)
	}
	foreach $r (@SelectedRooms)
	{
	    my $nodeid = $RoomIds{$r};
	    my $xco = $NodeList->{$nodeid}[1];
	    my $yco = $NodeList->{$nodeid}[2];
#	    print("move_room: $r, $dragtox - $DragFromX, $dragtoy - $DragFromY\n");
	    redraw_room($r, $xco, $yco, 
			$dragtox - $DragFromX, $dragtoy - $DragFromY);
	    $NodeList->{$nodeid} = [$NodeList->{$nodeid}[0], $xco + $xco2,
				    $yco + $yco2, $NodeList->{$nodeid}[3]];
	    delete $CoordList->{$xco}{$yco}{$NodeList->{$nodeid}[1]};
	    $CoordList->{$xco+$xco2}{$yco+$yco2}{$NodeList->{$nodeid}[1]} =
		$nodeid;
	    
	}
	$DragFromX = $dragtox;
	$DragFromY = $dragtoy;
    }
    
}

sub stop_move_room
{
    # Called when room drag is finished, to reset SelectedRooms
    # Parameter: None

    @SelectedRooms = ();
}

sub set_focus
{
    # Sets the focus to the object clicked on!
    # Parameter: Widget, obj

    my $obj = $_[1];
    $obj->Tk::focus;
}

{
    my $SDragFromX; # Drag start for Select (X)
    my $SDragFromY; # Drag start for Select (Y)

    sub select_drag_start
    {
	# Called when shift-button1 is done on the canvas
	# Starts a 'selection' rectangle to select more than one room at once
#	$SDragFromX = $_[1];
#	$SDragFromY = $_[2];
	$SDragFromX = $MCanvas->canvasx($_[1]);
	$SDragFromY = $MCanvas->canvasy($_[2]);
	
	print("select_drag_start: $SDragFromX, $SDragFromY\n");
    }

    sub select_drag
    {
	# Called when shift-button1 is move across the canvas
	# Draws a rectangle to indicate the selected area
	my $sdragtox = $MCanvas->canvasx($_[1]);
	my $sdragtoy = $MCanvas->canvasy($_[2]);
#	print("select_drag_start: $DragFromX, $DragFromY\n");

	draw_select_area($SDragFromX, $SDragFromY, $sdragtox, $sdragtoy);
    }

    sub select_drag_end
    {
	# Called when the shift-button1 drag is ended by releasing the 
	# mouse button
	# Removes the rectangle, and marks the rooms inside the rectangle
	# as 'selected' (see 'select_room')
	my $sdragtox = $MCanvas->canvasx($_[1]);
	my $sdragtoy = $MCanvas->canvasy($_[2]);
	print("select_drag_end: $sdragtox, $sdragtoy\n");
	if(!$SDragFromX || !$SDragFromY)
	{
	    # Wasn't selecting
	    return;
	}
	delete_select_area();
	
	# Get items enclosed in rectangle
	# - write a function for this in the Canvas-stuff??
	my ($x1, $y1, $x2, $y2);
	$x1 = $sdragtox > $SDragFromX ? $SDragFromX : $sdragtox;
	$x2 = $sdragtox > $SDragFromX ? $sdragtox   : $SDragFromX;
	$y1 = $sdragtoy > $SDragFromY ? $SDragFromY : $sdragtoy;
	$y2 = $sdragtoy > $SDragFromY ? $sdragtoy   : $SDragFromY;

	print("select_drag_end: $x1, $y1, $x2, $y2\n");

	my @selectedrooms1 = $MCanvas->find('withtag', 'room');
	my @selectedrooms2 = $MCanvas->find('enclosed', 
					    $x1, $y1, $x2, $y2);
	print("select_drag_end: Found: " . @selectedrooms1 . " items\n");
	print("select_drag_end: Found: " . @selectedrooms2 . " enclosed\n");

	my @selectedrooms = get_common_items(\@selectedrooms1, 
					     \@selectedrooms2);

	foreach my $r (@selectedrooms)
	{
	    print("select_drag_end: $r\n");
	    select_room(undef, $r);
	}
    }
}

sub select_room
{
    # When 'shift-button1' is done on a room, it is added or deleted from the
    # 'selectedrooms' list, the outline colour (orange) of the room (and its
    # exits!) is changed to indicate that it is selected.
    # Parameter: RoomNr or undef

    my $roomnode = get_current_room();
    my $roomid = $_[1] ? $_[1] : $NodeList->{$roomnode}->[0]->{'RoomId'};

    print("select_room: Node: $roomnode\n");
    print("select_room: Room: $roomid\n");

    my $ind = is_member($roomid, @SelectedRooms);
    if($ind > -1)
    {
	print("select_room: Already selected: $roomid, $ind\n");
	# Remove room from array
	splice(@SelectedRooms, $ind, 1);
	# Change the outline back to black (Mapper object!)
	change_item($roomid, '-outline', 'black');
	change_item($roomid, '-width', 1);
	return 1;
    }

    print("select_room: Add $roomid\n");
    $SelectedRooms[scalar(@SelectedRooms)] = $roomid;
    change_item($roomid, '-outline', 'white');
    change_item($roomid, '-width', 2);
    return 1;
}

sub create_room
{
    # Called from button 'Room' and menu item 'New Room'
    # Create a new room on the edge of the map as soon as the mousecursor
    # enters it, which is moved with the cursor, until it is clicked.
    # Parameter : None
    print("Create Room\n");
    my $newroom;
#    $MCanvas->Tk::bind($MCanvas, '<Enter>', sub {
#	my ($c) = @_;
##	my $can = $MCanvas->Subwidget('scrolled');
#	my $can = $MCanvas;
#	my $mx = $c->XEvent->x;
#	my $my = $c->XEvent->y;
#	if($mx < 0) {$mx -= 3;} # Add borderwidth
#	if($my < 0) {$my -= 3;}
#	my $cx = $can->canvasx($mx); 
#	my $cy = $can->canvasx($my);
#	print("create_room : Pixels10m :" . $Pixels10m . "\n");
#	print("create_room : Event :" . $mx . " " . $my . "\n");
#	print("create_room : Canvas :" . $cx . " " . $cy . "\n");
#	print("create_room : Canvas / Pixels :" . (int($cx / $Pixels10m) + 1) 
#	      . " " . (int($cy / $Pixels10m) + 1) . "\n");
#	my $tx = (int($cx / $Pixels10m) + 1);
#	my $ty = (int($cy / $Pixels10m) + 1);
#	# (Man sollte der aktuelle tiefe nehmen, statt 5!)
#	$newroom = draw_room($tx, $ty, 5);
#	$MCanvas->Tk::bind($MCanvas, '<Enter>', '');
#	$MCanvas->itemconfigure($newroom, -tags => ['newroom']);
#	$MCanvas->bind('newroom', '<Motion>', [\&move_room, Ev('x'), Ev('y')]);
#	$MCanvas->Tk::bind($MCanvas, '<ButtonPress-1>', sub {});
#    });

    $MCanvas->Tk::bind($MCanvas, '<ButtonPress-1>', sub {
	my ($c) = @_;
	my $mx = $c->XEvent->x;
	my $my = $c->XEvent->y;
	if($mx < 0) {$mx -= 3;} # Add borderwidth
	if($my < 0) {$my -= 3;}
	my $cx = $can->canvasx($mx); 
	my $cy = $can->canvasx($my);
	print("create_room : Pixels10m :" . $Pixels10m . "\n");
	print("create_room : Event :" . $mx . " " . $my . "\n");
	print("create_room : Canvas :" . $cx . " " . $cy . "\n");
	print("create_room : Canvas / Pixels :" . (int($cx / $Pixels10m) + 1) 
	      . " " . (int($cy / $Pixels10m) + 1) . "\n");
	my $tx = (int($cx / $Pixels10m) + 1);
	my $ty = (int($cy / $Pixels10m) + 1);

	$newroom = draw_room($tx, $ty, 5);
	$MCanvas->Tk::bind($MCanvas, '<ButtonPress-1>', '');
    });
}

sub create_link
{
    # Called from button 'Link' or menu item 'New Link'
    print("Create Link\n");
}

sub change_level
{
    # Called from buttons 'Level +' and 'Level -'
    # Parameter: Integer: +1 = higher, -1 = lower
    my $levelchange = $_[0];

    print("change_level: $levelchange\n");

    # $canvas->gettags(tagOrId) returns a list of all items with this tag
    # $canvas->delete(tagOrId, tagOrId) deletes each item denoted by tagOrId
    # room, roomunder, roomover, link, location

    delete_canvas_all();
    $CurrentLevel += $levelchange;

    $LevelLabel->configure(-text => $CurrentLevel);

    print("change_level: Current: $CurrentLevel\n");

    draw_nodes();
    draw_location($NodeList->{$CurrentLocation}[1],
		  $NodeList->{$CurrentLocation}[2],
		  $NodeList->{$CurrentLocation}[3],
		  'red');
}

sub goto_room
{
    # Called from popup-menu, or client
    # Parameter: NodeId to goto, or undef

    my $room = $_[0] || get_current_room();
    print("goto_room: Node: $room\n");
    print("goto_room: CurrentLocation: $CurrentLocation\n");
    if(!$room)
    {
	print("goto_room: Can't find current room!\n");
	return;
    }
    my %exits = %{$NodeList->{$CurrentLocation}[0]{'exits'}};
## %Exits{'<Direction>'} = [$pointertolink, 'ausgang', $NodeId] NEW!

    my $pathl;
    my $pathe;
    foreach my $e (keys %exits)
    {
	print("goto_room: Looking at: $e\n");
	if(!defined($exits{$e}[2]))
	{
	    next;
	}
	print("goto_room: Looking at: " . $exits{$e}[2] . "\n");
	if($room == $exits{$e}[2])
	{
	    # Node ist in the next room, we can just go there
	    print("goto_room: Node in next room\n");
	    my $d = $Directions[$Dirs{$e}]{'dirs'}[1];
	    $pathl->[0] = $room;
	    $pathe->[0] = $d;
	    last;
	}
    }
    if(!$pathl)
    {
	my $p = findpath($CurrentNode->{'id'}, $room);
	$pathl = $p->[0];
	$pathe = $p->[1];
    }

    print("room_goto: pathl: $pathl\n");
    print("room_goto: pathe: $pathe\n");
    if(!$pathl || !$pathe)
    {
	print("goto_room: No path found!\n");
	return;
    }

    foreach $exit (@{$pathl})
    {
	print("room_goto: Exit: $exit\n");
#	$Mapper->after(2000);
	sleep(1);
	$CurrentLocation = $exit;
	draw_location($NodeList->{$CurrentLocation}[1],
		      $NodeList->{$CurrentLocation}[2],
		      $NodeList->{$CurrentLocation}[3],
		      'red');
	centre_map($NodeList->{$CurrentLocation}[1],
		   $NodeList->{$CurrentLocation}[2]);
	$MCanvas->update;
#	room_command($MCanvas, $exit);
    }
    
    $CurrentNode = undef;
    $CurrentNode = $NodeList->{$CurrentLocation}->[0];
    $NodeList->{0} = [$CurrentNode, 0, 0, 0];

}

sub create_zone
{
    # Since most buildings are larger on the inside than on the outside in
    # mud, zones are created, to 'zoom-in' on certain parts of the map
    # A zone is marked on the map as a different coloured 'room', once created
    # entering this 'room' does a 'zoom-in' to the zone. (Delete all rooms, 
    # change current zonename, redraw rooms for the zone)
    # Creating a new zone is done by changing a current room into a zone,
    # a new zone is created which must be named, (Or gets the short name of the
    # current room?? - can be changed afterwards?)
    # Parameter: None

    my @rooms = ();
    foreach my $rid (@SelectedRooms)
    {
	$rooms[scalar(@rooms)] = $RoomIds{$rid};
    }

    # Find out, which rooms have exits to rooms not in the list
    my @externalexits;
    print("create_zone: Rooms " . @rooms . "\n");
    foreach my $room (@rooms)
    {
	print("create_zone: Room $room\n");
	my $exits = $NodeList->{$room}[0]{'exits'};

	foreach my $exit (keys %{$exits})
#	while (my ($exit, $dest) = each %{$exits})
	{
	    print("create_zone: Exit: " . $exit . "\n");
	    my $eid = $exits->{$exit}[2];

	    if(is_member($eid, @rooms) == -1)
	    {
		print("create_zone: Found $room\n");
		print("create_zone: Found " . $eid . "\n");
		$externalexits[scalar(@externalexits)] = $room;
	    }
	}
    }
    print("create_zone: ExternalExits: " . @externalexits . "\n");
    if(@externalexits != 1)
    {
	print("create_zone: Only one external exit allowed!\n");
	return 0;
    }
    # The room with the external exit will be the 'zone' room
    # Check that it isn't one already.. (Other 'zone' rooms in the list
    # will move to the new zone.
    print("create_zone: ExternalExit: " . $externalexits[0] . "\n");
    my $zoneroom = $externalexits[0];
    my @tags = $MCanvas->gettags($zoneroom);
    if(is_member('zone', @tags) > -1)
    {
	print("create_zone: $zoneroom is already a zone!\n");
	return 0;
    }
    # Add zone tag to room and change room colour
    $MCanvas->addtag('zone', 'withtag', $zoneroom);
#    change_item($zoneroom, '-fill', 'orange');

    # start a new zone with the name of this room
    my $newnodelist = ();
    # Add nodes to new nodelist

#    $newnodelist = dclone($NodeList);

    foreach my $room (@rooms)
    {
	$newnodelist->{$room} = dclone($NodeList->{$room});
#	my @coords = @{$NodeList->{$room}};
#	$CoordList->{$coords[1]} {$coords[2]} 
#	            {$coords[3]} = $newnodelist->{$room}[0];
	if($room != $zoneroom)
	{
	    delete $NodeList->{$room};
	    print("create_zone: Deleted: " . $NodeList->{$room} . "\n");
	}
	else
	{
	    print("create_zone: Kept: " . $room . "\n");
	    $NodeList->{$room}[0]{'zone'} = 
		$NodeList->{$zoneroom}[0]{'name'};
	    $newnodelist->{$room}[0]{'zone'} = 
		$CurrentZone;
	    print("create_zone: ZoneOld: " . $NodeList->{$room}[0]{'zone'} . "\n");
	    print("create_zone: ZoneNew: " . $newnodelist->{$room}[0]{'zone'} . "\n");
	}
    }
    if(is_member($CurrentNode->{'id'}, @rooms) > -1 )
    {
	$CurrentNode = undef;
	$CurrentNode = $newnodelist->{$CurrentLocation}[0];
    }
    $CurrentZone = $NodeList->{$zoneroom}[0]{'name'};
    $newnodelist->{0} = [$CurrentNode, 0, 0, 0];
    my @coords = @{$NodeList->{$zoneroom}};
    $ZoneList->{$CurrentZone} = [$newnodelist, 
				 $coords[1], $coords[2], $coords[3]];


    $NodeList = undef;
    $NodeList = $newnodelist;

    delete_canvas_all();

    $ZoneLabel->configure(-text => $CurrentZone);

    print("change_zone: Current: $CurrentZone\n");

    draw_nodes();
    print("create_zone: CurrentLocation: $CurrentLocation\n");

    if(is_member($CurrentLocation, @rooms) > -1)
    {
	draw_location($NodeList->{$CurrentLocation}[1],
		      $NodeList->{$CurrentLocation}[2],
		      $NodeList->{$CurrentLocation}[3],
		      'red');
    }

    # reset selectedrooms!
    @SelectedRooms = ();
    
}

sub delete_room
{
    # Called from the right-mouse-button menu to delete the current or
    # selected rooms from the map and the hash
    # Parameter: None

    my @rooms;
    if(!@SelectedRooms)
    {
	$rooms[0] = get_current_room();
    }
    else
    {
	foreach my $r (@SelectedRooms)
	{
	    $rooms[scalar(@rooms)] = $RoomIds{$r};
	}
    }
    if(!@rooms)
    {
	print("delete_room: No rooms choosen\n");
	return;
    }
    print("delete_rooms: " . @rooms . "\n");
    print("delete_rooms: " . $rooms[0] . "\n");

    # don't delete the room we are standing in
    if(is_member($CurrentLocation, @rooms) > -1)
    {
	print("delete_room: Can't delete current location!\n");
	return;
    }

    # delete rooms from map
    foreach my $r (@rooms)
    {
	undraw_room($NodeList->{$r}->[0]->{'RoomId'});
	undraw_links($r);
    }

    # delete items from the NodeList and CoordList
    foreach my $r (@rooms)
    {
	my $node = $NodeList->{$r};
	# don't delete a zone room (delete_zone?)
	if(defined($node->[0]{'zone'}))
	{
	    next;
	}
	# delete exits from other rooms to this one
	foreach my $n (keys %{$NodeList})
	{
	    if($n == $r)
	    {
		next;
	    }
	    foreach my $e (keys %{$NodeList->{$n}[0]{'exits'}})
	    {
		if(defined($NodeList->{$n}[0]{'exits'}{$e}[2]) &&
		   $NodeList->{$n}[0]{'exits'}{$e}[2] == $r)
		{
		    $NodeList->{$n}[0]{'exits'}{$e} = undef;
		}
	    }
	}
    
	delete $CoordList->{$node->[1]}{$node->[2]}{$node->[3]};
	$node = undef;
	delete $NodeList->{$r}->[0]->{'exits'};
	delete $NodeList->{$r};
    }

}    

sub start_server
{
    print("Start server\n");
    $paddr = accept(Client, Server);
    Client->autoflush(1);
    Client->blocking(0);
    print("Accepted Server->Client\n");
    $Mapper->fileevent('Server', 'readable', '');
    print("Closed fileevent for Server\n");
    $Mapper->fileevent('Client', 'readable', 
		   [\&get_mapper_data, Client]);
#    $mw->fileevent('Client', 'writable', 
#		   [\&send_text, $t2, Client]);
    print("Started fileevent for Client\n");
    $SocketConnected = 1;
}


#######################################################################
# Auxiliary functions for callbacks
#
sub set_location
{
    # Called by various functions to set the actual location
    # Parameter: Node to set Location to
    my $node = $_[0];

    $CurrentLocation = $node;
    print("set_location: CurrentLocation: $node\n");
    $CurrentNode = undef;
    $CurrentNode = $NodeList->{$CurrentLocation}->[0];
    $NodeList->{0} = [$CurrentNode, 0, 0, 0];

    draw_location($NodeList->{$node}[1],
		  $NodeList->{$node}[2],
		  $NodeList->{$node}[3],
		  'red');
}
sub get_current_room
{
    # Returns the node-id of the room under the mouse
    # Parameter: None

    print("get_current_room: \n");
    my @rect = $MCanvas->find('withtag', 'current');
    print("get_current_room: Found: " . @rect . "\n");
    if(!@rect)
    {
	# Also finds links !?
	print("get_current_room: " . $MCanvas->canvasx($LMouseX) . "\n");
	print("get_current_room: " . $MCanvas->canvasy($LMouseY) . "\n");
	@rect = $MCanvas->find('closest', $MCanvas->canvasx($LMouseX),
			                  $MCanvas->canvasy($LMouseY) );
	print("get_current_room: Found: " . @rect . "closest\n");
	my @rooms = $MCanvas->find('withtag', 'room');
	print("get_current_room: Found: " . @rooms . "rooms\n");
	@rect = get_common_items(\@rect, \@rooms);
    }
    print("get_current_room: Found: " . @rect . "\n");
    if(!@rect && $ClickedRoom)
    {
	# Last resort, use the current room found when clicking
	$rect[0] = $ClickedRoom;
    }
    print("get_current_room: Found: " . $rect[0] . "\n");
    my $r = $rect[0];
    print("get_current_room: Rect: $r\n");
    my $room = $RoomIds{$r};
    print("get_current_room: Node-id: $room\n");

    $ClickedRoom = undef;
    return $room;
}

{
    my $ExitName;
    my $Direction;
    my $Wait;

    sub iswaiting
    {
	# Are we waiting for information from the Client?
	# Parameter: None
	return $Wait;
    }

    sub create_new_room
    {
	# Creates a new room in the list and on the canvas
	# Or enters an old one.
	# Parameter: Start room-id, Exit name, Direction, 
	#            wait (0 - local, 1 - remote)
	
	my $startnode = $NodeList->{$_[0]}[0];
	my $exitname = $_[1];
	my $direction = $_[2];
	$Wait = $_[3];
	
	print("create_new_room: " . $startnode . "\n");
	print("create_new_room: " . $startnode->{'id'} . "\n");
	print("create_new_room: Zone: " . $startnode->{'zone'} . "\n");
	print("create_new_room: " . $direction . "\n");
	print("create_new_room: " . $exitname . "\n");
	print("create_new_room: " . $Wait . "\n");
	
#    $Exits->{$direction->{'dirs'}[0]} = '';
	if(iswaiting()) # Room created by client
	{
	    if(defined($exitname) && defined($direction) )
	    {
		$ExitName = $exitname;
		$Direction = $direction;
		# check if room already exists in that direction
		#$node->{'exits'}{$direction->{'dirs'}[0]}[2] . "\n");
		print("create_room_name: Defined: " . 
		      $startnode->{'exits'}{$direction->{'dirs'}[0]} .
		      "\n");
		print("create_room_name: Defined: " . 
		      $startnode->{'exits'}{$direction->{'dirs'}[0]}[1] .
		  "\n");
		print("create_room_name: Defined: " . 
		      $startnode->{'exits'}{$direction->{'dirs'}[0]}[2] .
		      "\n");
		if(defined($startnode->{'exits'}{$direction->{'dirs'}[0]}) &&
		   defined($startnode->{'exits'}{$direction->{'dirs'}[0]}[2]))
		{
		    print("create_room_name: " . 
			  $startnode->{'exits'}{$direction->{'dirs'}[0]} .
			  "\n");
		    print("create_room_name: " . 
			  $startnode->{'exits'}{$direction->{'dirs'}[0]}[2] .
			  "\n");
		    $RoomName = '';
		    $RoomDescription = '';
		}
	    }
	    if(!defined($RoomName))
	    {
		print("create_new_room: waiting for name\n");
		return;
	    }
	    else
	    {
		$CurrentRoomName = $RoomName;
	    }
	    if(!defined($RoomDescription))
	    {
		print("create_new_room: waiting for description\n");
		return;
	    }	   
	    else
	    {
		$CurrentRoomDesc = $RoomDescription;
	    }
	    $RoomName = undef;
	    $RoomDescription = undef;
	}
	else
	{
	    $CurrentRoomName = "Room $NodeCount";
	    $CurrentRoomDesc = '';
	    $ExitName = $exitname;
	    $Direction = $direction;
	}
	$Wait = 0;
	
	if(!defined($ExitName) || !defined($Direction))
	{
	    print("create_new_room: No Exit/Direction. (Client forgot Move?)\n");
	    return;
	}
	my $newnode = ();
	$newnode = getnewnode($ExitName, $Direction, $startnode);
	$ExitName = $Direction = undef;
	if($newnode->{'id'} == $startnode->{'id'})
	{
	    # We ran over the edge! Do nothing.
	    print("create_new_room: Ran over the edge of the map!\n");
	    return 0;
	}
	
	# If the room we entered is a zone room, change zones
	# On leaving a zone room, and through the exit out of the zone!
	# Otherwise we land in the zone room on the other side..
	print("create_new_room: Id  : " . $newnode->{'id'} . "\n");
	my $zone = $startnode->{'zone'};
	print("create_new_room: Zone: $zone\n");
	print("create_new_room: Id  : " . $startnode->{'id'} . "\n");
	if($zone && !defined($NodeList->{$newnode->{'id'}}))
	{
	    my $id = $newnode->{'id'};
	    print("create_new_room: NodeId: $id\n");
	    print("create_new_room: Leaving zone: $CurrentZone\n");
	    $CurrentZone = $zone;
	    $NodeList = undef;
	    $NodeList = $ZoneList->{$CurrentZone}[0];
	    print("change_zone: NodeList: " . $NodeList . "\n");
	    delete_canvas_all();
	    
	    $ZoneLabel->configure(-text => $CurrentZone);
	    
	    print("change_zone: Current: $CurrentZone\n");
	    
	    draw_nodes();
	    print("change_zone: CurrentLocation: $CurrentLocation\n");
	}
	print("create_new_room: startnode-Id: " . $startnode->{'id'} . "\n");
	print("create_new_room: newnode-Id: " . $newnode->{'id'} . "\n");
	
	my @coords = @{$NodeList->{$newnode->{'id'}}};
	$CurrentLocation = $newnode->{'id'};
	$CurrentNode = undef;
	$CurrentNode = $newnode;
	$newnode = undef;
	
	# Save current node to position 0 
	$NodeList->{0} = [$CurrentNode, 0, 0, 0];
	
	print("create_new_room: CurrentLocation: $CurrentLocation.\n");
	draw_location($coords[1], $coords[2], $coords[3], 'red');
	
	my @xviewtest = $MCanvas->xview;
	my @yviewtest = $MCanvas->yview;
	print("create_new_room: " . $xviewtest[0] . " " . $xviewtest[1] . "\n");
	print("create_new_room: " . $yviewtest[0] . " " . $yviewtest[1] . "\n");
	
	my $left = $xviewtest[0] * 400*$Pixels10m;
	my $right = $xviewtest[1] * 400*$Pixels10m;
	my $top = $yviewtest[0] * 400*$Pixels10m;
	my $bottom = $yviewtest[1] * 400*$Pixels10m;
#    print("create_new_room: l-r " . $left . " " . $right . "\n");
#    print("create_new_room: t-b " . $top . " " . $bottom . "\n");
	
	print("create_new_room: RoomId: " . $CurrentNode->{'RoomId'} . "\n");
	my @rcoords = $MCanvas->coords($CurrentNode->{'RoomId'});
	print("create_new_room: Coords: " . @rcoords . "\n");
	
	if($rcoords[0] < $left ||
	   $rcoords[2] > $right ||
	   $rcoords[1] < $top || 
	   $rcoords[3] > $bottom)
	{
	centre_map($coords[1], $coords[2], $coords[3]);
    }
	
	$Exits = undef;
    }    
}

sub change_roomprop
{
    # Called by client or room properties dialog to change a property of
    # the given room
    # Parameter: Zone name, NodeId, property, new value
    my ($zone, $nodeid, $prop, $value) = @_;

    if(!defined($ZoneList->{$zone}))
    {
	print("change_roomprop: No such Zone: $zone\n");
	return;
    }
    if(!defined($ZoneList->{$zone}[0]{$nodeid}))
    {
	print("change_roomprop: No such Id: $nodeid\n");
	return;
    }
    my $node = $ZoneList->{$zone}[0]{$nodeid}[0];
    if(defined($node->{$prop}))
    {
	print("change_roomprop: Old value: " . $node->{$prop} . "\n");
    }
    $node->{$prop} = $value;
}

sub add_exit
{
    # Add a new exit to the given room
    # Parameter: NodeId, Exit Name, Direction
    my ($nodeid, $exitname, $direction) = @_;

    if(!defined($NodeList->{$nodeid}))
    {
	print("add_exit: No such node: $nodeid\n");
	return;
    }
    my $node = $NodeList->{$nodeid}[0];
#    if(!defined($node->{'exits'}{$direction}))
    if(defined($node->{'exits'}{$direction->{'dirs'}[0]}))
    {
	print("add_exit: Exit exists: " . 
	      $node->{'exits'}{$direction->{'dirs'}[0]} . "\n");
	if(defined($node->{'exits'}{$direction->{'dirs'}[0]}[2]))
	{
	    print("add_exit: Exit goes to: " . 
		  $node->{'exits'}{$direction->{'dirs'}[0]}[2] . "\n");
	}
	return ;
    }
    my $links = ();
    $links->[0] = [$direction->{'dirs'}[0], 1];
    $NodeList->{$nodeid}[0]{'exits'}{$direction->{'dirs'}[0]} = [$links, $exitname, undef];
    
    draw_link($NodeList->{$nodeid}[1],
	      $NodeList->{$nodeid}[2],
	      $NodeList->{$nodeid}[3],
	      $direction);
}

sub find_nodes
{
    # Looks for nodes matching the given name + description and highlights
    # them
    # Parameter: Name, Description
    my ($name, $desc);

    my @nodes = ();
    while(my ($node, $value) = each %{$NodeList})
    {
#	my @roomdesc = $value->[0]{'desc'};
#	splice(@roomdesc, -1);
#	my $testdesc = join("\n", @roomdesc);
	if( ($name eq '' || $name eq $value->[0]{'name'}) &&
	    ($desc eq '' || $desc eq $value->[0]{'desc'}) )
	{
	    $node[scalar(@nodes)] = $node;
	    draw_mark($value->[1], $value->[2], $value->[3], 'gold');
	}
    }
    return @nodes;
}

#######################################################################
# Functions that manipulate/draw on the canvas
#
sub draw_room : locked
{
    # Each room is in a 10m box. The room itself is 5m x 5m, the remaining
    # 2.5m on each side can be used for the link.
    # The x,y,z parameters represent which box is to be used, starting at
    # the top left with 1,1. To convert to coordinates, we subtract 1 (as
    # coordinates start at 0) multiply by 10 to get the top left corner, and
    # add 2.5 to get the top left corner of the room itself.
    #   ____
    #   |_
    #   ||
    #
    # The bottom right corner is then these coordinates + 5.
    # Only draw room if these coords do not contain a room
    # Parameters: X, Y, Z coordinates
    # NB: Use global Pixel10m definition to avoid rounding problems!

    my ($x, $y, $z) = @_;
    
    print("draw_room: $x, $y, $z\n");
    if($x == 0 || $y == 0 || $x > 400 || $y > 400)
    {
	print("draw_room: Node outside of canvas\n");
	# Can't draw a room outside of the canvas
	return 0;
    }
    my $xcoord = ($Pixels10m * ($x - 1)) + ($Pixels10md4);
    my $ycoord = ($Pixels10m * ($y - 1)) + ($Pixels10md4);

    my $findroom = $MCanvas->find('enclosed', 
				  ($xcoord - ($Pixels10md4)),
				  ($ycoord - ($Pixels10md4)),
				  ($xcoord + 3*$Pixels10md4),
				  ($ycoord + 3*$Pixels10md4));
    my $roomraise = 0;
    if($findroom)
    {
	print("draw_room: Room already exists: $findroom\n");
	if($MCanvas->itemcget($findroom, '-fill') eq 'blue')
	{
	    # If the colour of the existing room is blue -> the room should
	    # be shown 'on top', raise this item to the top
	    $roomraise = 1;
	}
#	return $findroom;
    }
    
    my $rect;
    lock $MCanvas;

    if($z == $CurrentLevel)
    {
	print("draw_room: Room on current level\n");
	$rect = $MCanvas->createRectangle($xcoord , 
					  $ycoord ,
					  $xcoord + ($Pixels10m/2), 
					  $ycoord + ($Pixels10m/2), 
					  -fill => 'cornflowerblue',
					  -disabledfill => 'white',
					  -outline => 'black',
					  -activewidth => 2,
					  -tags => ['room']);
    }
    elsif($z == $CurrentLevel - 1)
    {
	print("draw_room: Room on level below\n");
	$rect = $MCanvas->createRectangle($xcoord , 
					  $ycoord ,
					  $xcoord + ($Pixels10m/2), 
					  $ycoord + ($Pixels10m/2), 
					  -fill => 'gray',
					  -disabledfill => 'white',
					  -outline => 'gray',
					  -activewidth => 2,
					  -tags => ['room', 'roomunder']);
    }
    elsif($z == $CurrentLevel + 1)
    {
	print("draw_room: Room on level above\n");
	$rect = $MCanvas->createRectangle($xcoord , 
					  $ycoord ,
					  $xcoord + ($Pixels10m/2), 
					  $ycoord + ($Pixels10m/2), 
					  -fill => 'white',
					  -disabledfill => 'white',
					  -outline => 'white',
					  -activewidth => 2,
					  -tags => ['room', 'roomover']);
    }
    else
    {
	print("draw_room: room not on currentlevel, above, or below\n");
	return 0;
    }

    print("draw_room: Raise: $roomraise\n");
#    if($roomraise && $rect)
#    {
	# Put found room on top of new room (current level rooms should be
	# on top)
#	$MCanvas->raise($findroom, $rect);
#    }

    $CurrentRoomId = $rect;
    $MCanvas->focus($rect);
    $MCanvas->Tk::focus;
    print("draw_room: $rect, $xcoord, $ycoord \n");
    print("draw_room: coords :" . 
	  ($xcoord ) . ", " .
	  ($ycoord ) . ", " .
	  ($xcoord + ($Pixels10m/2)) . ", " .
	  ($ycoord + ($Pixels10m/2)) . "\n");
    print("draw_room: scaling: " . $Mapper->scaling() . "\n");
    return $rect;
}

sub undraw_room
{
    # Called remove a room from the map
    # Parameter: RoomId
    my $roomid = $_[0];

    $MCanvas->delete($roomid);
}

sub redraw_room
{
    # Called by move_room to move this room with the mouse
    # Parameter: index or id to redraw, coords of room, x, y to redraw
    my ($id, $x, $y, $xd, $yd) = @_;
    print("redraw_room: $id, $x, $y\n");

    $MCanvas->move($id, $xd, $yd);

    my $xcoord = ($Pixels10m * ($x - 1)) + $Pixels10md4;
    my $ycoord = ($Pixels10m * ($y - 1)) + $Pixels10md4;
    my @inlinks = $MCanvas->find('overlapping', $xcoord, $ycoord,
			       $xcoord + $Pixels10m/2,
			       $ycoord + $Pixels10m/2);
    my @taglinks = $MCanvas->find('withtag', 'link');
    my @links = get_common_items(\@inlinks, \@taglinks);

    foreach my $l (@links)
    {
	$MCanvas->move($l, $xd, $yd);
    }
}

sub draw_link : locked
{
    # The x,y,z coordinates represent the room 'box' (see above) from which
    # to draw the link from. The direction defines whether it should be 
    # drawn above, below, to the left etc. of the room. The link is drawn
    # from the edge of the room to the edge of the surrounding box.
    # Parameters: X, Y, Z, Direction
    my ($x, $y, $z, $dir) = @_;
    
    print("draw_link: $x, $y, $z, $dir\n");
    if(!$dir)
    {
	print("draw_link: mm, no direction\n");
	return;
    }
    # Convert x,y of room to centre of 10x10 box
    my $xco1 = ($Pixels10m * ($x - 1)) + ($Pixels10m/2);
    my $yco1 = ($Pixels10m * ($y -1)) + ($Pixels10m/2);

    # Calculate ends of link using direction modifiers
    $xco1 += $Pixels10md4 * ($dir->{'direction'}->[0]);
    my $xco2 = $xco1 + ($Pixels10md4 * ($dir->{'direction'}->[0]));

    $yco1 += $Pixels10md4 * ($dir->{'direction'}->[1]);
    my $yco2 = $yco1 + ($Pixels10md4 * ($dir->{'direction'}->[1]));

    
    lock $MCanvas;
    if($z == $CurrentLevel)
    {
	$MCanvas->createLine($xco1, $yco1,
			     $xco2, $yco2, 
			     -fill => 'blue',
			     -tags => ['link']);
    }
    elsif($z == $CurrentLevel - 1)
    {
	$MCanvas->createLine($xco1, $yco1,
			     $xco2, $yco2, 
			     -fill => 'gray',
			     -tags => ['link']);
    }
    elsif($z == $CurrentLevel + 1)
    {
	$MCanvas->createLine($xco1, $yco1,
			     $xco2, $yco2, 
			     -fill => 'white',
			     -tags => ['link']);
    }
    else
    {
	print("draw_link: Room not on level\n");
    }
}

sub undraw_links
{
    # Deletes all links in the surrounding box for the given room
    # Paremeter: NodeId

    my $room = $_[0];
    print("delete_room: $room\n");
    # delete links in room-box
    my $xcoord = ($Pixels10m * ($NodeList->{$room}[1] - 1)) + $Pixels10md4;
    my $ycoord = ($Pixels10m * ($NodeList->{$room}[2] - 1)) + $Pixels10md4;
    my @inlinks = $MCanvas->find('overlapping', $xcoord, $ycoord,
			       $xcoord + $Pixels10m/2,
			       $ycoord + $Pixels10m/2);
    my @taglinks = $MCanvas->find('withtag', 'link');
    my @links = get_common_items(\@inlinks, \@taglinks);

    foreach my $l (@links)
    {
	$MCanvas->delete($l);
    }
}


sub draw_location
{
    # Draw a coloured circle in the room denoted by x,y,z
    # A circle is drawn using a bounding box inside the room 4m in diameter.
    # Parameter: $x, $y, $z, colour
    my ($x, $y, $z, $colour) = @_;
    
    print("draw_location: $x, $y, $z\n");
    my $xcoord = ($Pixels10m * ($x - 1)) + 6*($Pixels10md4/5);
    my $ycoord = ($Pixels10m * ($y - 1)) + 6*($Pixels10md4/5);
#    my $ycoord = ($Pixels10m * ($y - 1)) + 3;
    
    lock $MCanvas;
    $MCanvas->delete('location');
    $location = $MCanvas->createOval($xcoord , 
				     $ycoord ,
				     $xcoord + 8*($Pixels10md4/5) , 
				     $ycoord + 8*($Pixels10md4/5) ,
				     -fill => $colour,
				     -tags => ['location']);
}

sub draw_select_area
{
    # Called from select_drag* routines to show a rectangle representing
    # the current area/items contained in the dragarea
    # Paremeter: 4 coordinates of the rectangle

    my ($x1, $y1, $x2, $y2) = @_;
#    print("draw_select_area: $x1, $y1, $x2, $y2\n");
    
    $MCanvas->delete('select_area');
    my $rect = $MCanvas->createRectangle($x1, $y1 , 
					 $x2, $y2 ,
					 -outline => 'black',
					 -tags => ['select_area']);
}

sub delete_select_area
{
    # Called from select_drag* routines to remove the rectangle showing the
    # selected area
    # Parameter: None

    $MCanvas->delete('select_area');
}

sub delete_canvas_all
{
    # Delete everything from the map-canvas
    # Parameter: None
    $MCanvas->delete('room', 'roomunder', 'roomover', 'link', 'location');
}

sub draw_mark
{
    # Draws a kleiner square inside the room, with no fill but thicker outline.
    # Parameter: x, y, z, colour
    my ($x, $y, $z, $col) = @_;

    my $xcoord = ($Pixels10m * ($x - 1)) + ($Pixels10md4/2);
    my $ycoord = ($Pixels10m * ($y - 1)) + ($Pixels10md4/2);

#    if($z == $CurrentLevel)
#    {
#	print("draw_room: Room on current level\n");
	$rect = $MCanvas->createRectangle($xcoord , 
					  $ycoord ,
					  $xcoord + ($Pixels10md4), 
					  $ycoord + ($Pixels10md4), 
					  -outline => $col,
					  -width => 3,
					  -tags => ['mark']);
#    }
}

sub change_item
{
    # Called by various functions to re-configure an item
    # Checks Id, but not option or value
    # Parameter: ItemId, option, new-value
    my ($id, $option, $value) = @_;
    print("change_item: Id: $id\n");
    print("change_item: Option: $option\n");
    print("change_item: Value: $value\n");

    my $findid = $MCanvas->find('withtag', $id);

    print("change_item: Found: $findid\n");
    if($findid)
    {
	$MCanvas->itemconfigure($findid, $option, $value);
    }
}

sub centre_map
{
    # Change xview and yview of canvas to centre map around the given room.
    # Parameter: room coordinates; x,y to centre around
    my ($x, $y) = @_;
    print("centre_map: $x, $y\n");

# -50 because xview takes the top left corner
#    my $xcoord = (10 * ($x - 1)) - 50; 
#    my $ycoord = (10 * ($y - 1)) - 50;
    my $xcoord = ($Pixels10m * ($x - 1)) - (5*$Pixels10m); 
    my $ycoord = ($Pixels10m * ($y - 1)) - (5*$Pixels10m);
    print("centre_map: $xcoord, $ycoord\n");

#    my $movetox = $xcoord/4000;
#    my $movetoy = $ycoord/4000;
    my $movetox = $xcoord/(400*$Pixels10m);
    my $movetoy = $ycoord/(400*$Pixels10m);
    print("centre_map: $movetox, $movetoy\n");


    $MCanvas->xview('moveto', $movetox);
    $MCanvas->yview('moveto', $movetoy);
}

#######################################################################
# Edit directions dialog box and callbacks
#
{

    my $DirWindow;
    my $DirEntry;
    my $NameEntry;
    my $DirList;
    my $NameList;
    my $NCanvas;
    my @LocalDirections;
    my %LocalDirs;
    my $CopyDirs;
    my $DCanvas;
    my $StatusLabel;
    my $NewDir;
    my $PreviousPoly;

    sub edit_directions
    {
	# Called from menu 'edit directions'
	# Creates a new toplevel window in which the directions can be changed
	# Changes should be immediate!
	# Parameter: None

	# Make a copy of the Dirs and Directions!
	@LocalDirections = @{dclone(\@Directions)};
	%LocalDirs = %{dclone(\%Dirs)};
	##

	# Set default values
	$NewDir = 0;
	$PreviousPoly = 0;
	##

	if($DirWindow)
	{
	    print("edit_directions: Dialog already exists!\n");
	    return;
	}
	$DirWindow = $Mapper->Toplevel(-title => 'Directions');
	
	my $menu = $Mapper->Menu();
	my $mfile = $menu->cascade(-accelerator => '<Alt-F>',
				   -label => 'File',
				   -tearoff => 0,
				   -underline => 0);
	$mfile->command(-label => 'Open',
			-accelerator => '<Ctrl-O>',
			-underline => 0,
			-command => [\&dirs_open_file, 0]);
	$mfile->command(-label => 'Save',
			-accelerator => '<Ctrl-S>',
			-underline => 0,
			-command => [\&dirs_save_file, 0]);
	$mfile->command(-label => 'Save as..',
			-underline => 5,
			-command => [\&dirs_save_file, 1]);
	$mfile->separator();
	$mfile->command(-label => 'Set current',
		        -underline => 4,
			-command => [\&dirs_set_current]);
	$mfile->command(-label => 'Reload..',
			-accelerator => '<Ctrl-R>',
			-underline => 0,
			-command => [\&dirs_reload_dirs]);
	$mfile->separator();
	$mfile->command(-label => 'Close',
			-accelerator => '<Ctrl-C>',
			-underline => 0,
			-command => [$DirWindow => 'destroy'] );
	my $mdirs = $menu->cascade(-accelerator => 'Alt->D',
				   -label => 'Directions',
				   -tearoff => 0,
				   -underline => 0);
	
	$DirWindow->configure(-menu => $menu );
	
	# Save directions on exit
	$DirWindow->bind('<Destroy>', [\&dirs_save_dirs]);

	# Frame to hold everything
	my $frame = $DirWindow->Frame();
	$frame->pack(-anchor => 'n',
		     -side => 'top',
		     -fill => 'x',
		     -expand => 1);
	
	# Frame to hold list of directions and edit buttons
	my $fdirs = $frame->Frame(-relief => 'sunken');
	$fdirs->pack(-anchor => 'w',
		     -side => 'left', 
		     -fill => 'y', 
		     -padx => 6,
#		     -pady => 3,
		     -expand => 1);
	
	$DirList = $fdirs->Scrolled('Listbox',
				    -height => 8,
				    -width  => 10,
				    -scrollbars => 'e' );
	$DirList->pack(-anchor => 'n',
		       -side => 'top', 
		       -fill => 'x', 
		       -expand => 1);
	$DirList->bind('<Double-1>' => [\&dirs_click_dir]);
	
	# Add a two-button frame under the list box
	my $fdirsbuttons = $fdirs->Frame();
	$fdirsbuttons->pack(-anchor => 'n',
			    -side => 'top',
			    -fill => 'x',
			    -expand => 1);
	$fdirsbuttons->Button(-text => 'Add',
			      -command => 
			      [\&dirs_add_direction] )
	    ->pack(-side => 'left', -expand => 1, -fill => 'y');
	$fdirsbuttons->Button(-text => 'Remove',
			      -command => 
			      [\&dirs_remove_direction])
	    ->pack(-side => 'right', -expand => 1, -fill => 'y');

	# Add a text/entry field under the two buttons
	$DirEntry = $fdirs->Entry();
	$DirEntry->pack(-anchor => 'n',
			-side => 'top',
			-fill => 'x',
			-expand => 1);

	# Frame to hold list of names for each direction
	my $fnames = $frame->Frame(-relief => 'sunken');
	$fnames->pack(-anchor => 'w',
		      -side => 'left',
		      -fill => 'y',
		      -padx => 6,
#		      -pady => 3,
		      -expand => 1);

	# Frame with list and two arrow buttons to rearrange names in the list
	my $flistarrows = $fnames->Frame(-borderwidth => 0);
	$flistarrows->pack(-anchor => 'n',
		       -side => 'top',
		       -fill => 'y',
		       -expand => 1);
	$NameList = $flistarrows->Scrolled('Listbox',
					   -height => 8,
					   -width => 14,
					   -scrollbars => 'e');
	$NameList->pack(-anchor => 'w',
			-side => 'left',
			-fill => 'x',
			-expand => 1);
	$NameList->bind('<ButtonPress-1>' => [\&dirs_click_name]);

	my $farrows = $flistarrows->Frame(-borderwidth => 0);
	$farrows->pack(-anchor => 'e',
		       -side => 'right',
		       -fill => 'y',
		       -expand => 1);
	my $farrowp1 = $farrows->Photo(-file => cwd . '/3arrow1.gif');
	$flistarrows->Button(-image => $farrowp1,
			 -command => [\&dirs_name_up])
	    ->pack(-side => 'top');

	my $farrowp2 = $farrows->Photo(-file => cwd . '/3arrow2.gif');
	$flistarrows->Button(-image => $farrowp2,
			 -command => [\&dirs_name_down])
	    ->pack(-side => 'bottom');


	# Add a two-button frame under the list box
	my $fdirsbuttons2 = $fnames->Frame();
	$fdirsbuttons2->pack(-anchor => 'n',
			    -side => 'top',
			    -fill => 'x',
			    -expand => 1);
	$fdirsbuttons2->Button(-text => 'Add',
			      -command => 
			       [\&dirs_add_name] )
	    ->pack(-side => 'left', -expand => 1, -fill => 'y');
	$fdirsbuttons2->Button(-text => 'Remove',
			      -command => 
			       [\&dirs_remove_name])
	    ->pack(-side => 'right', -expand => 1, -fill => 'y');

	# Add a frame for a mini-canvas and text entry field under the two 
	# buttons
	my $fentry = $fnames->Frame();
	$fentry->pack(-anchor => 'n',
		      -side => 'top',
		      -fill => 'x',
		      -expand => 1);
	$NCanvas = $fentry->Canvas(-width => $Pixels10m/2,
				   -height => $Pixels10m/2,
				   -borderwidth => 2,
				   -relief => 'sunken');
	$NCanvas->Tk::bind($NCanvas, '<KeyRelease>', [\&dirs_name_key,
						      Ev('K')]);
	$NCanvas->Tk::bind($NCanvas, '<ButtonPress-1>', [\&dirs_name_focus]);
	$NCanvas->pack(-anchor => 'w',
		       -side => 'left');

	# Add a text/entry field under the two buttons
	$NameEntry = $fentry->Entry();
	$NameEntry->pack(-anchor => 'w',
			-side => 'left',
			-fill => 'x',
			-expand => 1);

	# Frame to hold canvas with real directions
	$fdircanvas = $frame->Frame();
	$fdircanvas->pack(-anchor => 'w',
			  -side => 'left',
			  -fill => 'y',
			  -padx => 6,
#			  -pady => 3,
			  -expand => 1);
	$DCanvas = $fdircanvas->Canvas( -width => 6*$Pixels10m + 8,
					-height => 5.5*$Pixels10m + 8,
					-borderwidth => 2 );
	$DCanvas->pack(-anchor => 'n',
		       -side   => 'top',
		       -fill   => 'x',
		       -expand => 1);
	$DCanvas->bind('polygon', '<ButtonPress-1>', [\&dirs_click_poly]);
#	$DCanvas->bind('start', '<Enter>', [\&dirs_enter_start]);

	my @dirs = ('<Southwestup>', '<Westup>', '<Northwestup>', '<Southup>',
		    '<Up>', '<Northup>', '<Southeastup>', '<Eastup>',
		    '<Northeastup>', '<Southwest>', '<West>', '<Northwest>',
		    '<South>', '<Start>', '<North>', '<Southeast>', '<East>',
		    '<Northeast>', '<Southwestdown>', '<Westdown>', 
		    '<Northwestdown>', '<Southdown>', '<Down>', '<Northdown>',
		    '<Southeastdown>', '<Eastdown>', '<Northeastdown>');
	my $count = 0;
	for (my $h = 0; $h < 3; $h++)
	{
	    for (my $i = 0; $i < 3; $i++)
	    {
		for (my $j = 3, $k = 0; $j > 0; $j--, $k++)
		{
		    $DCanvas->createPolygon
		(($i + $k)    *$Pixels10m, ($j + 4*$h)     *($Pixels10m/2) + 4,
		 ($i + $k + 1)*$Pixels10m, ($j + 4*$h)     *($Pixels10m/2) + 4,
		 ($i + $k + 2)*$Pixels10m, ($j + 4*$h - 1) *($Pixels10m/2) + 4,
		 ($i + $k + 1)*$Pixels10m, ($j + 4*$h - 1) *($Pixels10m/2) + 4,
		 ($i + $k)    *$Pixels10m, ($j + 4*$h)     *($Pixels10m/2) + 4,
		 -fill => 'white',
		 -outline => 'black',
		 -tags => ['polygon', $dirs[$count++]]);
		}
	    }
	}
	$DCanvas->createLine(
			     4*$Pixels10m/2, 6*($Pixels10m/2) + 4,
			     8*$Pixels10m/2, 5*($Pixels10m/2) + 4,
			     -fill => 'blue',
			     -tags => ['start']);
	$DCanvas->createLine(
			     6*$Pixels10m/2, 6*($Pixels10m/2) + 4,
			     6*$Pixels10m/2, 5*($Pixels10m/2) + 4,
			     -fill => 'blue',
			     -tags => ['start']);

	$StatusLabel = $DirWindow->Label(-relief => 'sunken');
	$StatusLabel->pack(-anchor => 's',
			   -side => 'bottom',
			   -fill => 'x',
			   -expand => 1);

	dirs_fill_dialog();
    }

    sub dirs_open_file
    {
	# Called when the File|Open command is chosen, to open a preiviously
	# saved <Name>.dir file
	# Parameter: 0, 1 - DirFileName

	print("dirs_open_file: $DirWindow\n");
	print("dirs_open_dile: " . cwd . "\n");

	my $filename;
	if($_[0] && $DirFileName)
	{
	    $filename = $DirFileName;
	}
	else
	{
	    $filename = $DirWindow->
		getOpenFile(-defaultextension => '.dir',
			    -title => 'Open Directories File',
			    -initialdir => '/home/castaway/perl/');
	}
	if(defined($filename))
	{
	    my $stuff;
	    $stuff = retrieve($filename);
	    %LocalDirs = %{$stuff->[0]};
	    @LocalDirections = @{$stuff->[1]};
	    print("dirs_open_dile: " . @LocalDirections . "\n");

	    $DirFileName = $filename;
	    $Settings{'DirFileName'} = $DirFileName;
	}
	dirs_fill_dialog();
	
    }

    sub dirs_save_file
    {
	# Called when the File|Save or File|Save as commands are chosen, saves
	# the current directions to a <Name>.dir file
	# Parameter: save/save as (0/1)

	my $saveas = $_[0];
	if(!$saveas)
	{
	    # Save to current filename
	    if(length($DirFileName) > 0)
	    {
		print("dirs_save_file: SaveAs: $saveas, FileName: $DirFileName\n");
		my @stuff;
		$stuff[0] = \%LocalDirs;
		$stuff[1] = \@LocalDirections;
		store(\@stuff, $DirFileName) or die "Can't store %a in %filename!\n";
		return;
	    }
	}

	my $filename = $DirWindow->
	    getSaveFile(-defaultextension => '.dir',
			-title => 'Save Directories File',
			-initialfile => $DirFileName,
			-initialdir => cwd);
	if(defined($filename))
	{
	    my @stuff;
	    $stuff[0] = \%LocalDirs;
	    $stuff[1] = \@LocalDirections;
	    store(\@stuff, $filename) or die "Can't store %a in %filename!\n";
	}
    }

    sub dirs_set_current
    {
	# Called by the menu to set the edited directions to the ones used
	# by the mapper
	# Parameter: None

	@Directions = ();
	%Dirs = ();
	@Directions = @{dclone(\@LocalDirections)};
	%Dirs = %{dclone(\%LocalDirs)};
    }

    sub dirs_reload_dirs
    {
	# Reloads the original directions from the mapper
	# Parameter: None
	@LocalDirections = @{dclone(\@Directions)};
	%LocalDirs = %{dclone(\%Dirs)};
	dirs_fill_dialog();
    }

    sub dirs_save_dirs
    {
	# Called when the directions window is unmapped (before/after??)
	# Called more than once for some reason...
	# Parameter: None
	print("dirs_save_dirs: " . @_ . "\n");

	# Function is called each time a component is destroyed!
#	print("dirs_save_dirs: " . $_[0]->class . "\n");
	if($_[0]->class eq 'Toplevel')
	{
	    print("dirs_save_dirs: " . $_[0] . "\n");

	    # Copy LocalDirs and LocalDirections back to Dirs and Directions

	}

    }
    sub dirs_click_dir
    {
	# Called when a direction is chosen
	# Parameter: None
	print("dirs_click_dir: " . @_ . "\n");

	print("dirs_click_dir: clicked: " . $DirList->get('active') . "\n");
	print("dirs_click_dir: clicked: " . $DirList->index('active') . "\n");
	
	$NameList->delete(0, 'end');

	
	my $dir = $LocalDirs{$DirList->get('active')};
	if(!$dir)
	{
	    print("dirs_click_dir: No Dirs for " . $DirList->get('active') . "\n");
	    return;
	}
	$dir = $LocalDirections[$dir];
	# Start counting at 2, 0 is the <Direction> and 1 the DirList direction
	for (my $d = 2; $d < @{$dir->{'dirs'}}; $d++)
	{
	    $NameList->insert('end', $dir->{'dirs'}[$d]);
	}
	dirs_draw_dir($dir->{'direction'}[0],
		      $dir->{'direction'}[1],
		      $dir->{'direction'}[2]);
    }

    sub dirs_add_direction
    {
	# Called when the add_direction button is clicked
	# Parameter: direction listbox, direction entry field
	print("dirs_add_direction: " . @_ . "\n");

	print("dirs_add_direction: " . $DirEntry->get() . "\n");

	my $text = $DirEntry->get();
	my @items = $DirList->get(0, 'end');
	if(length($text) == 0)
	{
	    print("dirs_add_direction: $text is empty.\n");
	    return;
	}
	if(is_member($text, @items) > -1)
	{
	    print("dirs_add_direction: $text haben wir schon!\n");
	    return;
	}

	$DirList->insert('end', $text);
	$DirList->selectionClear(0, 'end');
	$DirList->selectionSet('end');
	$DirList->see('end');
	$DirList->activate('end');
	$NameList->delete(0, 'end');
	$DirEntry->delete(0, 'end');
	$DCanvas->itemconfigure($PreviousPoly, -fill => 'white');
	$DCanvas->delete('direction');
	$StatusLabel->configure(-text => "Adding Direction: $text");
	$NewDir = 1;
    }

    sub dirs_remove_direction
    {
	# Called when the remove_direction button is clicked
	# Parameter: direction listbox
	print("dirs_remove_direction: " . @_ . "\n");
    }

    sub dirs_click_name
    {
	# Called when a direction name is clicked in the listbox
	# Parameter: None
	print("dirs_remove_direction: " . @_ . "\n");
    }

    sub dirs_name_up
    {
	# Called when the arrow-up button is clicked (to rearrange the order
	# of the direction names)
	# Parameter: names listbox
	print("dirs_name_up: " . @_ . "\n");

	my $activeindex = $NameList->index('active');
	if($activeindex == 0)
	{
	    print("dirs_name_up: Is already at the top\n");
	    return;
	}
	my $activename = $NameList->get('active');
	$NameList->delete('active');
	$NameList->insert($activeindex - 1, $activename);
	$NameList->selectionSet($activeindex - 1);
	$NameList->activate($activeindex - 1);

	my $dir = $LocalDirections[$LocalDirs{$DirList->get('active')}];
	my $ind = is_member($activename, @{$dir->{'dirs'}});
	# Swap names in the dirs list by deleting and replacing using splice
	splice(@{$dir->{'dirs'}}, $ind - 1, 2, 
	       ($activename, $dir->{'dirs'}[$ind - 1]));
    }

    sub dirs_name_down
    {
	# Called when the arrow-down button is clicked (to rearrange the order
	# of the direction names)
	# Parameter: names listbox
	print("dirs_name_down: " . @_ . "\n");

	my $activeindex = $NameList->index('active');
	if($activeindex == $NameList->index('end') - 1)
	{
	    print("dirs_name_down: Is already at the bottom\n");
	    return;
	}
	my $activename = $NameList->get('active');
	$NameList->delete('active');
	$NameList->insert($activeindex + 1, $activename);
	$NameList->selectionSet($activeindex + 1);
	$NameList->activate($activeindex + 1);

	my $dir = $LocalDirections[$LocalDirs{$DirList->get('active')}];
	my $ind = is_member($activename, @{$dir->{'dirs'}});
	# Swap names in the dirs list by deleting and replacing using splice
	splice(@{$dir->{'dirs'}}, $ind + 1, 2, 
	       ($dir->{'dirs'}[$ind + 1], $activename));
    }

    sub dirs_add_name
    {
	# Called when the add_name button is clicked
	# Parameter: names listbox, name entry field
	print("dirs_add_name: " . @_ . "\n");

	print("dirs_add_name: " . $NameEntry->get() . "\n");

	my $text = $NameEntry->get();
	my @items = $NameList->get(0, 'end');
	if(length($text) == 0)
	{
	    print("dirs_add_direction: $text is empty.\n");
	    return;
	}
	if(is_member($text, @items) > -1)
	{
	    print("dirs_add_name: $text haben wir schon!\n");
	    return;
	}
	my $activedir = $DirList->get('active');
	if($activedir eq '')
	{
	    print("dirs_add_name: No Direction chosen.\n");
	    return;
	}
	# Check if current direction is in LocalDirs, then add text to 
	# LocalDirections
	print("dirs_add_name: ActiveDir " . $DirList->get('active') . "\n");
	my $dir = $LocalDirs{$DirList->get('active')};
	if($dir)
	{
	    print("dirs_add_name: ActiveDir $dir\n");
	    $LocalDirs{$text} = $dir;
	    my @ds = @{$LocalDirections[$dir]{'dirs'}};
	    $LocalDirections[$dir]{'dirs'} = [@ds, $text];

	    @ds = @{$LocalDirections[$dir]{'dirs'}};
	    foreach my $d (@ds)
	    {
		print("dirs_add_name: D $d\n");
	    }
	}
	
	$NameList->insert('end', $text);
#	$NameList->selectionClear(0, 'end');
#	$NameList->selectionSet('end');
	$NameList->see('end');
	$NameEntry->delete(0, 'end');
	if($NewDir)
	{
	    $StatusLabel->configure(-text => $StatusLabel->cget('-text') . ", $text");
	}
    }

    sub dirs_remove_name
    {
	# Called when the remove_name button is clicked
	# Parameter: names listbox
	print("dirs_remove_name: " . @_ . "\n");

	my $activename = $NameList->get('active');
	if($activename eq '')
	{
	    print("dirs_remove_name : No name selected.\n");
	}
	# Remove name from list
	$NameList->delete('active');

	# If we're not creating a new Direction, delete from local dirs etc.
	if(!$NewDir)
	{
	    # Delete name from LocalDirs
	    my $d = $LocalDirs{$activename};
	    if(!$d)
	    {
		print("dirs_remove_name : Oops, there is no $activename in LocalDirs\n");
		return;
	    }
	    delete $LocalDirs{$activename};
	    
	    # Find name in LocalDirections->{'dirs'}
	    $d = $DirList->get('active');
	    if(!$d)
	    {
		print("dirs_remove_name : Oops, no activedir or localdirection.\n");
		return;
	    }
	    my @dirs = @{$LocalDirections[$LocalDirs{$d}]{'dirs'}};
	    my $d1 = is_member($activename, @dirs);
	    splice(@dirs, $d1, 1);
	    $LocalDirections[$LocalDirs{$d}]{'dirs'} = \@dirs;
	}
    }

    sub dirs_name_key
    {
	# Called when a key is pressed in the name-canvas
	# Parameter: Keysym
	print("dirs_name_key: " . $_[1] . "\n");
	$NameEntry->delete(0, 'end');
	$NameEntry->insert(0, $_[1]);
    }

    sub dirs_name_focus
    {
	# Called when the first mouse-button is pressed in the name-canvas
	# Sets focus to this object
	# Parameter: None

	print("dirs_name_focus:\n");
	$NCanvas->Tk::focus;
    }

    sub dirs_click_poly
    {
	# Called when the mouse pointer enters a polygon
	# Parameter: None
	print("dirs_click_poly: " . @_ . "\n");

	my $poly = $DCanvas->find('withtag', 'current');
	my @ptags = $DCanvas->gettags($poly);

	print("dirs_click_poly: " . $poly . ":" . $ptags[0] . " " . $ptags[1] . "\n");
	my ($x, $y, $z) = (0, 0, 0);
	my $d;
	if($d = $LocalDirs{$ptags[1]})
	{
	    $x = $LocalDirections[$d]->{'direction'}[0];
	    $y = $LocalDirections[$d]->{'direction'}[1];
	    $z = $LocalDirections[$d]->{'direction'}[2];
	}
	dirs_draw_dir($x, $y, $z);

	# If newdir, check if direction already exists, 
	# add Dir, Names to LocalDir/LocalDirections
	if($NewDir)
	{
	    print("dirs_click_poly: d: $d\n");
	    my @dirs = @{$LocalDirections[$d]->{'dirs'}};
	    if(@dirs > 1)
	    {
		print("dirs_click_poly: Direction already exists\n");
		$DCanvas->itemconfigure($PreviousPoly, -fill => 'white');
		$DCanvas->delete('direction');
		return;
	    }
	    # Add DirList name first!
	    my @test = @{$LocalDirections[$d]->{'dirs'}};
	    $LocalDirections[$d]->{'dirs'}[scalar(@test)] = $DirList->get('active');
	    $LocalDirs{$DirList->get('active')} = $d;

	    # for-loop through $NameList, add names to current list
	    my @name = $NameList->get(0, 'end');
	    if(@name > 0)
	    {
		# Add names from NameList
		foreach my $n (@name)	
		{
		    print("dirs_click_poly: Name: $n\n");
		    my @test = @{$LocalDirections[$d]->{'dirs'}};
		    $LocalDirections[$d]->{'dirs'}[scalar(@test)] = $n;
		    $LocalDirs{$n} = $d;
		}
	    }
	    @test = @{$LocalDirections[$d]->{'dirs'}};
	    foreach $t (@test)
	    {
		print("dirs_click_poly: Test: $t\n");
	    }
	    $NewDir = 0;
	    $StatusLabel->configure(-text => '');
	}
	print("dirs_click_poly: $x $y $z\n");

    }

    sub dirs_enter_start
    {
	# Called when the mouse pointer enters the start field
	# Parameter: None
	print("dirs_enter_start: " . @_ . "\n");
    }

    sub dirs_draw_dir
    {
	# Converts a direction x,y,z into its graphical representation, 
	# and draws it in the canvas
	# Parameter: x,y,z (0,1,-1)
	my ($x, $y, $z) = @_;
	print("dirs_draw_dir: $x $y $z\n");
	
	# Start point is always the middle of the middle level
	my $startx = 6*$Pixels10m/2;
	my $starty = 5.5*$Pixels10m/2;

	my $endx = $startx + (2*$Pixels10m/2 * $x);

	$endx = $endx - (2*$Pixels10m/2 * $y);
	my $endy = $starty + ($Pixels10m/2 * $y);

	$endy = $endy - (4*$Pixels10m/2 *$z);

	$DCanvas->delete('direction');
	$DCanvas->itemconfigure($PreviousPoly, -fill => 'white');
	$PreviousPoly = $DCanvas->find('closest', $endx, $endy);
	$DCanvas->itemconfigure($PreviousPoly, -fill => 'red');
	$DCanvas->createLine($startx, $starty + 4,
			     $endx  , $endy   + 4,
			     -fill => 'red',
			     -tags => ['direction']);
	
    }

    sub dirs_fill_dialog
    {
	# Called by various functions to refill the display with the current
	# contents of LocalDirections / LocalDirs
	# Parameter: None

	# Fill listbox with current 'Directions' list

	$DirList->delete(0, 'end');
	
	for (my $dir = 1; $dir < @LocalDirections; $dir++)
	{
	    my $d = $LocalDirections[$dir]->{'dirs'};

	    if(@{$d} > 1)
	    {
		$DirList->insert('end', $d->[1]);
	    }
	}
	
	$DirList->selectionSet(0);
	$DirList->activate(0);
	dirs_click_dir();
    }

# End Edit directions dialog box
}

#######################################################################
# Manipulate Hash of rooms exits etc.
#
sub createstartroom
{
    # Set the start/current node
    # Parameter: None
    $CurrentNode->{'name'} = "Room 1";
    $CurrentNode->{'id'} = $NodeCount;
    $CurrentNode->{'exits'} = ();
    $CurrentNode->{'zone'} = undef;
    addnewnode($NodeCount, $CurrentNode, 200, 200, $CurrentLevel);
    $ZoneList->{$CurrentZone} = [$NodeList, 0, 0, 0];
    $CurrentNode->{'RoomId'} = $CurrentRoomId;
    $CurrentLocation = $NodeCount;
    $NodeCount += 1;
}

sub addnewnode : locked
{
    # Add a new node to the NodeList and Coordlist, given its Id,
    # A pointer to the node object, and its coordinates.
    # Parameter: $count, $nodeptr, $x, $y, $z
    my ($count, @stuff) = @_;
    print("addnewnode :" . $count . "\n");
    print("addnewnode :" . @stuff . "\n");
    
    # Just add the node
    # TODO
    # Later this should check if there is already a node with these coordinates
    # and do something about it!
    # (A check is made in getnewnode, but there the node is discarded, if
    # it does not have a matching room name)
    # Add the node to NodeList and CoordList
    # If room is outside canvas, draw_room returns 0
    # 
    $NodeList->{$count} = [@stuff];

    print("defined: " . defined($NodeList) . "\n");
#    print("addnewnode: id: " . $NodeList->{$count}->{'id'} . "\n");

    $CoordList->{$stuff[1]}{$stuff[2]}{$stuff[3]} = $stuff[0]->{'id'};
    
    if($stuff[3] > $CurrentLevel)
    {
	change_level(1);
    }
    elsif($stuff[3] < $CurrentLevel)
    {
	change_level(-1);
    }
    draw_room($stuff[1], $stuff[2], $stuff[3]);
    $RoomIds{$CurrentRoomId} = $count;
}

sub getnewnode : locked
{
    # Get a new node or the current node in the direction given,
    # starting at the fromNode
    # Parameter: String Name, Exit name, String Direction, Node fromNode
    my %temp;
    my @coords = ();
    my ($exitname, $strDirection, $fromNode) = @_;
    print("getnewnode, strDirection :" . $strDirection->{'dirs'}->[0] . "\n");
    print("getnewnode, Node :" . $fromNode . "\n");
    print("getnewnode, from-id :" . $fromNode->{'id'} . "\n");
    
    # Get list of nodeptr, x, y and z from allnodes
    @coords = @{$NodeList->{$fromNode->{'id'}}};
    
    # Get a node from these coords in this direction, if it exists
    my $nodeid = getnodeindirection($strDirection, $coords[1], $coords[2], $coords[3]);
    my $node;
    if(defined($nodeid))
    {
	print("getnewnode: Found Id: $nodeid\n");
	print("getnewnode: FromZone: " . $fromNode->{'zone'} . "\n");
	print("getnewnode: CurrentList " . $NodeList->{$nodeid} . "\n");
	if(defined($fromNode->{'zone'}) && !defined($NodeList->{$nodeid}))
	{
	    # We came from a zone, and our target does not exist -> look in the
	    # NodeList of the other zone
	    if(defined($ZoneList->{$fromNode->{'zone'}}->[0]->{$nodeid}))
	    {
		$node = $ZoneList->{$fromNode->{'zone'}}->[0]->{$nodeid}->[0];
		print("getnewnode: Found Node: $node\n");
	    }
	}
	else
	{
	    $node = $NodeList->{$nodeid}->[0];
	    print("getnewnode: Found Node: $node\n");
	}
    }
#    if($node && ($node->{'name'} eq $strName))
    if($node && ($node->{'id'} == $CurrentNode->{'id'}))
    {
	# We tried to run over the edge! Don't add node, just return
	print("getnewnode, found node :" . $node->{'id'} . "\n");
	print("getnewnode, found node roomid:" . $node->{'RoonId'} . "\n");
	return $node;
    }
    if(!$node)
    {
	# If no node found, create new node
	
	$node->{'name'} = $CurrentRoomName;
	$node->{'desc'} = $CurrentRoomDesc;
	$node->{'id'} = $NodeCount;
	$node->{'zone'} = undef;

	addnewnode($NodeCount, $node, @NewCoords);

	# RoomId exists after draw_room, called in addnewnode!
	$node->{'RoomId'} = $CurrentRoomId;
	$NodeCount += 1;
	@NewCoords = ();
    }
    my $links = ();
    $links->[0] = [$strDirection->{'dirs'}[0], 1];

    $fromNode->{'exits'}{$strDirection->{'dirs'}[0]} = 
	[$links, $exitname, $node->{'id'}];

    # If AutomaticLinks is on, create link back:
    if($AutomaticLinks)
    {
	my $dopp = $strDirection->{'opposite'};
	my $links = ();
	$links->[0] = [$Directions[$dopp]->{'dirs'}[0], 1];
	$node->{'exits'}{$Directions[$dopp]->{'dirs'}[0]} = 
	    [$links, $Directions[$dopp]->{'dirs'}[1], $fromNode->{'id'}];
	my @coords = @{$NodeList->{$node->{'id'}}};
	draw_link($coords[1], $coords[2],$coords[3], 
		  $Directions[$dopp]);
    }
    @coords = @{$NodeList->{$fromNode->{'id'}}};

    while (my  ($exit, $dest) = each %{$fromNode->{'exits'}})
    {
	print("getnewnode: " . $exit . "\n");
	draw_link($coords[1], $coords[2],$coords[3], 
		  $Directions[$Dirs{$exit}]);
    }
    
    print("getnewnode, make new node\n");
#    print("getnewnode: " . $CurrentNode->{'id'} . "\n"); - previous node!
    return $node;
}

sub getnodeindirection : locked
{
    # Get a node in the given direction, from the given coordinates
    # Parameter: String strDirection, Array coords
    my ($strDirection, $x, $y, $z) = @_;
    print("getnodeindirection :" . $strDirection . "\n");
    print("getnodeindirection :" . $x . " " . $y . " " . $z . "\n");

    addirection(@_);
    print("getnodeindirection :" . $NewCoords[0] . " " . $NewCoords[1] . " " . $NewCoords[2] . "\n");
    my $newnode = $CoordList->{$NewCoords[0]}{$NewCoords[1]}{$NewCoords[2]};
    if($newnode)
    {
	# returns NodeId!
	return $newnode;
    }
    return undef;
}

sub addirection : locked
{
    # Calculate New Coordinates, given current coordinates, 
    # and a direction. NewCoords hold the results
    # Parameter: String strDirection, Array coords
    my ($strDirection, $x, $y, $z) = @_;
#    $strDirection = lc($strDirection);

    print("addirection :" . $strDirection->{'dirs'}->[0] . "\n");
    print("addirection :" . $x . " " . $y . " " . $z . "\n");

    # Bei normale Richtung versuche richtung, am sonsten alle richtungen?

    my $change = $strDirection->{'direction'};
    $x += $change->[0];
    $y += $change->[1];
    $z += $change->[2];

    # if one of the coords is <1 or >400 then we ran over the edge!
    # reset to current node

    if($x < 1) {$x = 1;}
    if($y < 1) {$y = 1;}

    if($x > 400) {$x = 400;}
    if($y > 400) {$y = 400;}

    print("addirection :" . $x . " " . $y . " " . $z . "\n");
    $NewCoords[0] = $x;
    $NewCoords[1] = $y;
    $NewCoords[2] = $z;
#	return [$x, $y, $z];
}

#######################################################################
# Save and load functions
#
sub save_map
{
    # Parameter: saveas (0/1)
    my $saveas = $_;

    my @stuff;
    my %zl = %{$ZoneList};
    my %cl = %{$CoordList};
    
    print("save_map: NodeList: " . %zl . "\n");
    print("save_map: CoordList: " . %cl . "\n");
    print("save_map: RoomIds: " . %RoomIds . "\n");
    print("save_map: NodeCount: " . $NodeCount . "\n");
    print("save_map: CurrentLocation: " . $CurrentLocation . "\n");
    print("save_map: CurrentLevel: " . $CurrentLevel . "\n");
	    
    $stuff[0] = \%zl;
    $stuff[1] = \%cl;
    $stuff[2] = \%RoomIds;
    $stuff[3] = \$NodeCount;
    $stuff[4] = \$CurrentLocation;
    $stuff[5] = \$CurrentLevel;
    $stuff[6] = \$CurrentZone;
    $stuff[7] = \%Settings;

    if(!$saveas)
    {
	# Save to current filename
	if(defined($MapFileName) && length($MapFileName) > 0)
	{
	    print("save_map: SaveAs: $saveas, FileName: $MapFileName\n");
	    store(\@stuff, $MapFileName) or die "Can't store %a in %filename!\n";
	    return;
	}
    }
    
    my $filename = $Mapper->
	getSaveFile(-defaultextension => '.dir',
		    -title => 'Save Directories File',
		    -initialfile => $MapFileName || 'mapper.map',
		    -initialdir => cwd());

    if(defined($filename))
    {
	store(\@stuff, $filename) or die "Can't store %a in %filename!\n";
    }

    print("save_map saved\n");
    return 1;
}

sub load_map
{
    # Parameter: None

    my $filename = cwd . '/mapper.map';
    my $stuff;

    if($_[0] && $MapFileName)
    {
	$filename = $MapFileName;
    }
    else
    {
	$filename = $Mapper->
	    getOpenFile(-defaultextension => '.dir',
			-title => 'Open Directories File',
			-initialdir => '/home/castaway/perl/',
			-initialfile => $filename);
    }
    if(!defined($filename))
    {
	return 0;
    }

    $stuff = retrieve($filename);
#    @stuff = @{ retrieve($filename)};
    if(!defined($stuff))
    {
	print("Can't load nodes from $filename!\n");
	return 0;
    }

    print("stuff: " . @{$stuff} . "\n");
#    my @testarr = @{$stuff};
#    print("stuff: " . $testarr[0] . "\n");
#    print("stuff: " . %{$testarr[0]} . "\n");
#    %test = %{$stuff->[0]};

    $ZoneList = $stuff->[0];
#    $NodeList = \%test;
    $CoordList = $stuff->[1];
    %RoomIds = %{$stuff->[2]};
    $NodeCount = ${ $stuff->[3] };
    $CurrentLocation = ${$stuff->[4]};
    $CurrentLevel = ${$stuff->[5]};
    $CurrentZone = ${$stuff->[6]};
    %Settings = %{$stuff->[7]};

    print("load_map: NodeList: " . $ZoneList . "\n");
    print("load_map: CoordList: " . %{$CoordList} . "\n");
    print("load_map: RoomIds: " . %RoomIds . "\n");
    print("load_map: NodeCount: " . $NodeCount . "\n");
    print("load_map: CurrentLocation: " . $CurrentLocation . "\n");
    print("load_map: CurrentLevel: " . $CurrentLevel . "\n");

    $NodeList = $ZoneList->{$CurrentZone}[0];
    $CurrentNode = $NodeList->{0}[0];
    $CurrentRoomId = $CurrentNode->{'RoomId'};
    $CurrentLocation = $CurrentNode->{'id'};
    $DirFileName = $Settings{'DirFileName'};
    $MapFileName = $Settings{'MapFileName'};
    $ZoneList->{'main'} = [$NodeList, 0, 0, 0];
    $ZoneLabel->configure(-text => $CurrentZone);

#    dirs_open_file(1);

    print("load_map: " . $CurrentNode . "\n");
    print("load_map loaded\n");

# Delete RoomIds (recreate in draw_nodes)
    %RoomIds = ();
delete_canvas_all();
    draw_nodes();
    draw_location($NodeList->{$CurrentLocation}[1],
		  $NodeList->{$CurrentLocation}[2],
		  $NodeList->{$CurrentLocation}[3],
		  'red');

    centre_map($NodeList->{$CurrentLocation}[1],
               $NodeList->{$CurrentLocation}[2],
               $NodeList->{$CurrentLocation}[3]);
    
    
    $MapFileName = $filename;
    $Settings{'MapFileName'} = $MapFileName;
    @SelectedRooms = ();

    return 1;
}

#######################################################################
# Redraw map functions
#
sub draw_nodes
{
    # Parameter: None
    # Redraw all nodes in $NodeList
    # Recreate RoomIds

    list_nodes();

    # Draw nodes on level under current level
    while(my ($key, $value) = each %{$NodeList})
    {
	next unless $key > 0;
	next unless $value->[3] == $CurrentLevel - 1;

	my $id = draw_room($value->[1], $value->[2], $value->[3]);
	print("draw_nodes: RoomId: $id \n");
	print("draw_nodes: Id: " . $value->[0]->{'id'} . "\n");
	print("draw_nodes: Id/RoomId: " . $NodeList->{$key}[0]{'id'} . " " .
	      $NodeList->{$key}[0]{'RoomId'} . "\n");

	$RoomIds{$id} = $value->[0]->{'id'};
	$NodeList->{$key}[0]{'RoomId'} = $id;
	print("draw_nodes: Id/RoomId: " . $NodeList->{$key}[0]{'id'} . " " .
	      $NodeList->{$key}[0]{'RoomId'} . "\n");

#	$value->[0]{'RoomId'} = $id;
	sleep(0.1);

	if(defined($value->[0]{'exits'}))
	{
	    my %exits = %{$value->[0]{'exits'}};
	    print("draw_nodes :" . %exits . "\n");
	    while (my ($exitname, $exitval) = each %exits)
	    {
		draw_link($value->[1], $value->[2], $value->[3], 
			  $Directions[$Dirs{$exitname}]);
		sleep(0.1);
	    }
	}
    }

    # Draw nodes on level above current level
    while(my ($key, $value) = each %{$NodeList})
    {
	next unless $key > 0;
	next unless $value->[3] == $CurrentLevel + 1;

	my $id = draw_room($value->[1], $value->[2], $value->[3]);
	print("draw_nodes: RoomId:  $id \n");
	print("draw_nodes: Id: " . $value->[0]->{'id'} . "\n");

	$RoomIds{$id} = $value->[0]->{'id'};
	$NodeList->{$key}[0]{'RoomId'} = $id;
	print("draw_nodes: Id/RoomId: " . $NodeList->{$key}[0]{'id'} . " " .
	      $NodeList->{$key}[0]{'RoomId'} . "\n");
	sleep(0.1);

	if(defined($value->[0]{'exits'}))
	{
	    my %exits = %{$value->[0]{'exits'}};
	    print("draw_nodes :" . %exits . "\n");
	    while (my ($exitname, $exitval) = each %exits)
	    {
		draw_link($value->[1], $value->[2], $value->[3], 
			  $Directions[$Dirs{$exitname}]);
		sleep(0.1);
	    }
	}
    }

    # Draw nodes on current level
    while(my ($key, $value) = each %{$NodeList})
    {
	next unless $key > 0;
	next unless $value->[3] == $CurrentLevel;

	my $id = draw_room($value->[1], $value->[2], $value->[3]);
	if(defined($value->[0]->{'zone'}))
	{
	    change_item($id, '-fill', 'orange');
	}
	print("draw_nodes: RoomId:  $id \n");
	print("draw_nodes: Id: " . $value->[0]->{'id'} . "\n");

	$RoomIds{$id} = $value->[0]->{'id'};
	$NodeList->{$key}[0]{'RoomId'} = $id;
	print("draw_nodes: Id/RoomId: " . $NodeList->{$key}[0]{'id'} . " " .
	      $NodeList->{$key}[0]{'RoomId'} . "\n");
	sleep(0.1);

	if(defined($value->[0]{'exits'}))
	{
	    my %exits = %{$value->[0]{'exits'}};
	    print("draw_nodes :" . %exits . "\n");
	    while (my ($exitname, $exitval) = each %exits)
	    {
		draw_link($value->[1], $value->[2], $value->[3], 
			  $Directions[$Dirs{$exitname}]);
		sleep(0.1);
	    }
	}
    }
}

sub list_nodes
{
    # Parameter : None
    while (my ($key, $value) = each %{$NodeList})
    {
	next unless $key > 0;
	print($key . ": " .$value->[1] . 
	      " " . $value->[2] . " " . $value->[3] . " " . 
	      $value->[0]->{'name'} . 
	      "\n");
	while (my ($exitkey, $exitvalue) = each %{$value->[0]})
	{
	    print($exitkey . ": " . $exitvalue . 
		  "\n");
	}
    }
}

#######################################################################
# Route finding function
#
sub findpath
{
    # Find a path from 1. Node-Id to 2. Node-Id
    # Parameter: FromNode, ToNode,

    my ($fromnode, $tonode) = @_;
    my @searchlist = ();
    my $search = 0;
    my $citem = ();

    print("findpath: $fromnode, $tonode \n");

    # Searchlist contains nodes to search, the node they came from
    # and the direction to get there from the previous node
    # Add Fromnode to searchlist to start search
    $searchlist[0] = [$fromnode, undef, undef];

    $citem = $searchlist[$search];
    while($citem)
    {
	print("findpath: search $search \n");

	# Exit loop if end of list reached (room not found)
	if(!$citem)
	{
	    print("findpath: $tonode not found.\n");
	    last;
	}
	# Check if the currentitem is the one we're looking for
	if($citem->[0] == $tonode)
	{
	    print("findpath: Found $tonode here $search.\n");
	    last;
	}
	# Add children of currentitem to the end of searchlist
	# (checking first if the children are in the list!)
	if(!$NodeList->{$citem->[0]})
	{
	    print("findpath: Can't find node " . $citem->[0] . "\n");
	    return;
	}
	my %exits = %{$NodeList->{$citem->[0]}[0]{'exits'}};
# %Exits{'<Direction>'} = [$pointertolink, 'ausgang', $PointerToNode]

	foreach my $exit (keys %exits)
	{
	    my $founditem = 0;
	    print("findpath: Exit: $exit\n");
	    print("findpath: Exit-To: " . $exits{$exit} . "\n");
	    print("findpath: Exit-To: " . $exits{$exit}[2] . "\n");
	    if(!$exits{$exit}[2])
	    {
		# This exit-node does not exist!
		next;
	    }
	    my $enode = $NodeList->{$exits{$exit}[2]}[0]; 

	    print("findpath: searching .. " . $enode->{'id'} . "\n");
	    foreach my $item (@searchlist)
	    {
		if($enode->{'id'} == $item->[0])
		{
		    # Exit-node already in list
		    print("findpath: Exists " . $enode->{'id'} . "\n");
		    $founditem = 1;
		}
	    }
	    if(!$founditem)
	    {
		# Add exit-node-id, parent-node-id to list
		print("findpath: AddItem " . $enode->{'id'} . "\n");
		$searchlist[scalar(@searchlist)] = 
		    [$enode->{'id'}, $search, $exit];
	    }
	}
	$search++;
	$citem = $searchlist[$search];
    }
    
    # If path found, then citem is the last item searched, follow the list
    # back to the beginning
    my $pathroom = ();
    my $pathexit = ();
    while($citem)
    {
	unshift @{$pathroom}, $citem->[0];
	unshift @{$pathexit}, $citem->[2];
#	$path = $citem->[0] . "|" . $path;
	print("findpath: " . @{$pathroom} . "\n");
	print("findpath: " . @{$pathexit} . "\n");
	if(!$citem->[1])
	{
	    last;
	}
	$citem = $searchlist[$citem->[1]];
    }
	
#    print("findpath: $pathroom\n");
#    print("findpath: $pathexit\n");
    return [$pathroom, $pathexit];
}

#######################################################################
# function(s) to get data from socket, parse, and carry out
#
{
    my $Messages = ();
    $MessageID = 0;
    sub get_mapper_data
    {
	# Parameter: Client-handle
	my $client = $_[0];
	
	my $data = <$client>;
	if($data)
	{
            #<ID>#<number>/<count>#<code>#<length>#<data>
	    chomp($data);
	    my @pieces = split($FieldSeparator, $data);
	    if(@pieces != 6)
	    {
		print("get_mapper_data: Invalid data! $data\n");
		print("get_mapper_data: Too short " . @pieces . "\n");
		return;
	    }
	    my @count = split("/", $pieces[2]);
	    if(@count != 2)
	    {
		print("get_mapper_data: Invalid data! $data\n");
		print("get_mapper_data: Wrong count: " . @count ."\n");
		return;
	    }
	    if(length($pieces[5]) != $pieces[4])
	    {
		print("get_mapper_data: Corrupt data! " . length($pieces[5]) . "\n");
		print("get_mapper_data: Corrupt data! " . $pieces[5] . "\n");
		print("get_mapper_data: Corrupt data! " . $pieces[4] ."\n");
		return;
	    }
	    if(defined($Messages->{$pieces[1]}{'data'}[$count[0] - 1]))
	    {
		print("get_mapper_data: Repeated data! $data\n");
		return;
	    }

	    $Messages->{$pieces[1]}{'count'} = $count[1];
	    $Messages->{$pieces[1]}{'code'} = $pieces[3];
	    $Messages->{$pieces[1]}{'data'}[$count[0] - 1] = $pieces[5];
	    
	    @count = @{$Messages->{$pieces[1]}{'data'}};
	    print("get_mapper_data: " . $Messages->{$pieces[1]}{'data'} . "\n");
	    print("get_mapper_data: " . @count . "\n");
	    print("get_mapper_data: " . $Messages->{$pieces[1]}{'count'} . "\n");
	    if(@count == $Messages->{$pieces[1]}{'count'})
	    {
		# Got complete message from client
		parse_message($Messages->{$pieces[1]});
	    }

	    print("Data from client: $data\n");
#	    print_client("ack\n");
	}
	else
	{
	    # EOF?
	    close(Client);
	    $SocketConnected = 0;
	}
	return;
    }

    sub parse_message
    {
	# Called by get_mapper_data to actually carry out a received comand
	# Parameter: $Message

	my ($message) = @_;

	print("parse_message: Got: " . $message . "\n"); 

	my @data;
	if(@{$message->{'data'}} > 1)
	{
	    print("parse_message: Data1: " . @data . "\n");
	    @data = @{$message->{'data'}};
	}
	else
	{
	    print("parse_message: Data2:" . $message->{'data'}[0] . "\n");
	    @data = split($DataSeparator, $message->{'data'}[0]);
	}
#	print("parse_message: Data:" . $data[0] . "\n");
#	print("parse_message: Data:" . $data[1] . "\n");


	if($message->{'code'} eq '01')
	{
	    # Change mapper mode
	    if(is_member($message->{'data'}[0], (1, 2, 0)) > -1)
	    {
		$MapMode = $message->{'data'}[0];
		print("parse_message: Changed mapmode to $MapMode\n");
	    }
	}
	elsif($message->{'code'} eq '02')
	{
	    # Move in specified direction
	    # Parameter: exit name, direction
	    if(@data != 2)
	    {
		print("parse_message: Move: Not enough data!" . @data . "\n");
		return;
	    }
	    if($MapMode == 1)
	    {
		my $dir = $Dirs{$data[1]};
		if(!$dir)
		{
		    print("parse_message: Move: No such direction: " . $data[1] . "\n");
		    return;
		}
		my $nc = $NodeCount;
		create_new_room($CurrentLocation, $data[0], 
				$Directions[$dir], 1);
		print("parse_message: NC: $nc, NodeCount: $NodeCount\n");
		print("parse_message: Waiting: " . iswaiting() . "\n");
		if($nc == $NodeCount && !iswaiting())
		{
		    # No new room made
		    print_client("#" . $MessageID++ . "#01/01#04#" .
				 length($CurrentLocation) . 
				 "#$CurrentLocation\n");
		}
		else
		{
		    print_client("#" . $MessageID++ . "#01/01#02#" .
				 length($NodeCount) . "#$NodeCount\n");
		}
	    }
	    elsif($MapMode == 2)
	    {
		my $dir = $Dirs{$data[1]};
		if(!$dir)
		{
		    print("parse_message: Move: No such direction: " . $data[1] . "\n");
		    return;
		}
		my $nodeid = $CurrentNode->{'exits'}{$Directions[$dir]{'dirs'}[0]}[2];
		if(!$nodeid || !$NodeList->{$nodeid})
		{
		    print("parse_message: Move: Can't find node in direction: " . $data[1] . "\n");
		    return;
		}
		goto_room($nodeid);
		print_client("#" . $MessageID++ . "#01/01#04#" .
			     length($nodeid) . "#$nodeid\n");
	    }
	    
	}
	elsif($message->{'code'} eq '03')
	{
	    # Room Name (Number, Name)
	    if(@data != 2)
	    {
		print("parse_message: Room Name: Not enough data!" . @data . "\n");
		return;
	    }
	    print("parse_message: RoomName: Number:" . $data[0] . "\n");
	    if($data[0] != $NodeCount && $data[0] != $CurrentLocation)
	    {
		print("parse_message: Can only set room name for current/new room!\n");
		return;
	    }
	    if($data[0] == $NodeCount)
	    {
		# Set RoomName to the name given
		$RoomName = $data[1] eq '0' ? '' : $data[1];
		create_new_room($CurrentLocation, undef, 
				undef, 1);
		return;
	    }
	    if($data[0] == $CurrentLocation)
	    {
		change_roomprop($CurrentZone, $data[0], 'name', $data[1]);
	    }
	}
	elsif($message->{'code'} eq '04')
	{
	    # Room Name (Number, Name)
	    if(@data != 2)
	    {
		print("parse_message: Room Desc: Not enough data!" . @data . "\n");
		return;
	    }
	    print("parse_message: RoomDesc: Number:" . $data[0] . "\n");
	    if($data[0] != $NodeCount && $data[0] != $CurrentLocation)
	    {
		print("parse_message: Can only set room desc for current/new room!\n");
		return;
	    }
	    if($data[0] == $NodeCount)
	    {
		# Set RoomName to the name given
		$RoomDescription = $data[1] eq '0' ? '' : $data[1];
		create_new_room($CurrentLocation, undef, 
				undef, 1);
		return;
	    }
	    if($data[0] == $CurrentLocation)
	    {
		change_roomprop($CurrentZone, $data[0], 'desc', $data[1]);
	    }
	}
	elsif($message->{'code'} eq '05')
	{
	    # Add Exit to room
	    if(@data != 3)
	    {
		print("parse_message: Add Exit: Not enough data!" . @data . "\n");
		return;
	    }
	    if(!defined($NodeList->{$data[0]}))
	    {
		print("parse_message: Add Exit: No such Node:\n");
		return;
	    }
	    my $dir = $Dirs{$data[2]};
	    if(!$dir)
	    {
		print("parse_message: Add Exit: No direction: " . $data[2] . "\n");
		return;
	    }
	    $dir = $Directions[$dir];
	    add_exit($data[0], $data[1], $dir);
	}
	elsif($message->{'code'} eq '06')
	{
	    # Find/Teleport to room with name/description
	    # Highlights room(s) which match? 
	    # Parameter: Name, Desc, Teleport (1/0)
	    if(@data != 3)
	    {
		print("parse_message: Find/Teleport: Not enough data!" . @data . "\n");
		return;
	    }
	    # To really locate we need the exits, and possibly the decsription
	    # of neighbouring rooms, maybe the mapper should ask the client for
	    # exits/neighbours
	    my @nodes = find_nodes($data[0], $data[1]);
	    if(@nodes == 1 && $data[2])
	    {
		set_location($nodes[0]);
	    }
#	    else
#	    {
#		show_found(@nodes);
#	    }
	}
	elsif($message->{'code'} eq '07')
	{
	    # Add or get Note from Node
	}
	elsif($message->{'code'} eq '08')
	{
	    # Send directions
	    if(@data != 1)
	    {
		print("parse_message: Send directions: Too much data!\n");
		return;
	    }
	    if($data[0] != 0)
	    {
		print("parse_message: Send directions: Incorrect!" . $data[0] . "\n");
		return;
	    }
	    my $id = $MessageID++;
	    print("parse_message: Dirs: " . @Directions . "\n");
	    # count directions which have data:
	    my $dircount = 0;
	    for(my $dir = 1; $dir < @Directions; $dir++)
	    {
		if(defined($Directions[$dir]) &&
		   @{$Directions[$dir]{'dirs'}} > 1)
		{
		    $dircount++;
		}
	    }
	    # build answer for each direction
	    for(my $dir = 1; $dir <= $dircount; $dir++)
	    {
		my $answer = $dir . ":";
		my $dirs = $Directions[$dir]{'dirs'};
		for(my $i = 1; $i < @{$dirs}; $i++)
		{
		    $answer .= $dirs->[$i] . ",";
		}
		chop($answer);
		print_client("#" . $id . "#" . $dir . "/" . $dircount . 
			     "#05#" . length($answer) . "#" . $answer . "\n");
	    }
	}
	else
	{
	    print("parse_message: Invalid code! " . 
		  $message->{'code'} . "\n");
	}
    }

    sub print_client
    {
	# Sends information to the connected client
	# Parameter: Text to send (Check format??)
	my $message = $_[0];
	print("print_client: Send: $message");

	if(!$SocketConnected)
	{
	    print("print_client: Socket not connected.\n");
	    return;
	}
	print Client $message;
	
    }
}


#####
# Is $item contained in the given list?
#
sub is_member
{
    ($item, @liste) = @_;
    
    if(!defined($item) || !@liste)
    {
	return -1;
    }
    for($i = 0; $i<@liste; $i++)
    {
	print("is_member: compare: " . $liste[$i] . " $item.\n");
	if ($liste[$i] eq $item)
	{
	    return $i;
	}
    }
    return -1;
}

######
# Which items are in both lists?
#

sub numerically { $a <=> $b }
sub get_common_items
{
    # Returns a list of items which are contained in both lists
    # Parameter: PointerToList1, PointerToList2
    
    if(!$_[0] || !$_[1])
    {
	return ();
    }

    my @list1 = @{$_[0]};
    my @list2 = @{$_[1]};

    @list1 = sort numerically @list1;
    @list2 = sort numerically @list2;

    my $p1 = 0;
    my $p2 = 0;
    my @result;

    while($list1[$p1] && $list2[$p2])
    {
	if($list1[$p1] == $list2[$p2])
	{
	    $result[scalar(@result)] = $list1[$p1];
	    $p1++;
	    $p2++;
	}
	elsif($list1[$p1] < $list2[$p2])
	{
	    $p1++;
	}
	else
	{
	    $p2++;
	}
    }
    print("get_common_items: Found: " . @result . " items.\n");

    return @result;
}

## Use the keyboard (cursor keys) to create new rooms, adding them to a
## NodeList and CoordList
# Create a new room for dragging when 'Room' button is clicked.
## Where to save?? $MapFileName
# load_settings, save_settings, $SettingsFileName
# Double the borderwidth of a room where two rooms are?
## CoordList {x}{y}{z}=[room-nr] ?
## %RoomIds {'1'} = Node Id-Number
# Draw a path using a smaller yellow circle in each room together with 
# connecting yellow lines
## %Node {'name'} = "name of room"
## %Node {'id'} = Node Id-number
## %Node {'RoomId'} = Room Id-number !! NEW
## %Node {'exits'} = $PointerToExits
## %Node {'zone'} = name of zone / undef
## %Exits {'norden'} = $PointerToNode !! OLD!
## %Exits{'<Direction>'} = [$pointertolink, 'ausgang', $NodeId] NEW!
## !!! change 'norden' to number of direction! <- OLD
# @link[0] = ['<Direction1>', 1]
# @link[1] = ['<Direction2>', 1]
## etc. - describes how to draw a link between two rooms, the first and last
## direction are only drawn from room to edge and edge to room, the ones
## inbetween are drawn across a complete square!
## %Exits{'<Direction>'} = [$pointertolink, 'ausgang', $PointerToNode] OLD!
# change draw_link to use links ??
## %Coordlist {x} {y} {z} = $PointerToNode !! OLD
## %Coordlist {x} {y} {z} = $NodeId        !! NEW
## %NodeList {id} = [$PointerToNode,x,y,z]
## %NodeList {0} is always  [$CurrentNode,0,0,0]
## $NodeCount is the number of nodes we have (and the id of the next node)
#
# Create mapper as a class and create object in client?
# TCP/IP zwischen client/mapper ??
# Tk::filevent(filehandle, status, subroutine) calls subroutine, when status
# 'readable' 'writable' 'exception' .. 
# Tk::IO - highlevel interface??
## Levels, hoch/runter?
## Keypad / Num lock?
## Set current after load-map doesn't work?
## Automatic link?
## RoomIds change after load_map - reset by redraw!
#
## $Dirs{'sueden'} = 1
## $Dirs{'s'} = 1
## $Dirs{'norden'} = 2
## $Dirs{'n'} = 2
##
## $Directions[1]{'direction'} = [0, 1, 0]    (change in x,y,z)
## $Directions[1]{'opposite'} = 2
## $Directions[1]{'dirs'} = ['sueden', 's']
#
## Hoch/Runter (PageUp, PageDown)
## -> change level +1, -1 (ReDraw, delete all rooms on map, draw rooms in 
## current level, draw rooms in level below darker, above with white outline)
## reference to 'Level' label to change label?
## Centre map
# Change $Pixels10m to $RoomSize.. Change it for Zoom? (Change Canvas grid)
# Constant for size of map (currently 400x400) (Canvas->scale(tagorid.. ?)
# What happens if a room is needed off the edge of the map?
# Zones? - %ZoneList{'Zonename'} = [%NodeList, x, y, z]
## $CurrentZone = Zonename
## createzone - info from room is new room in new zone, zone hat room name?
# findpath between zones?
## find out which exit of chosen room (to be converted to zone) is 'attached'
## to the rest of the map (not in current NodeList)
## select/use multiple rooms? (get_selected_rooms) ..
## cant dclone nodes or exits, because of pointers to other rooms.. (use ids)
## 'delete_room', remove room from map (and location if its there) and node
## from NodeList, Coords from CoordList, NodeCount?? (refers only to next node,
## - count further in new zones, so that room-nr is unique!)
# Worlds? for bigger zones
## draw_nodes - draw first nodes on level below, then nodes above, then current
## level ?
## Directions-change dialog
## findpath algorithm
# Mapper/Client protocol:
# #<ID>#<number>/<count>#<code>#<length>#<data>
# (examples)
# #1#01/01#02#12#south:sueden
# or: 
# #1#01/02#02#5#south
# #1#02/02#02#6#sueden
# #2#01/01#01#1#2
# #3#01/01#03#16#2:Road to castle
# #4#01/01#04#3#2:0
# #5#01/01#05#14#2:south:sueden
# Client-> Mapper
# 01 - Change mode (Map, Follow, Off)
# 02 - Move (Exit name, Direction)
# 03 - Room Name (Number, Text)           -- '0' means no name
# 04 - Description (Number, Text)         -- '0' means no desc
# 05 - Exit (Number, Name, Direction)     -- Optional
# 06 - Find/Teleport (Room Name, Description, <bool teleport>) (exits?)
# 07 - Note (Number, Text)                -- Text option (get Note)
# 08 - Send directions
# 09 - Goto (Number)
# 10 - Show path (Number) ??
# 11 - Change field separator (<char>)
# 12 - change data separator (<char>)
#
# Mapper -> Client
# 01 - Change mode (Map, Follow, Off)
# 02 - New Room (Number)
# 03 - Move (Exit-Name)
# 04 - Current Room (Number)
# 05 - Directions (list of directions known with aliases)
# 06 - Change field separator (<char>)
# 07 - Change data separator (<char>)
# 08 - Note (Number, Text)
# 
# 'Map' mode allows both sides to create new rooms
# 'Follow' mode allows both sides to move, but produces an error, if either try
# to enter a non-existant room
# 'Off' ignores all commands apart from 'Change mode'
# In map mode, a 'move' from the client, will prompt a 'new room' or 'current 
# room' from the mapper, indicating an unknown room or a known one.
# The answer to 'new room' is a room name and or description, followed by the
# exits.
# A 'Teleport' command informs the mapper that it needs to resync, and provides
# information about the current room. The answer is a 'Current Room' command.
# 'Send directions' prompts the mapper to describe all the direction-commands
# it knows. 'Directions' will be automatically sent when the user changes the
# Directions in the mapper.
# The client does not need to remember more than the number of the current
# room, it can maintain a list, to use for the 'Goto' command (starts a 
# findpath and produces a series of 'move' commands from the mapper.
# Show path marks the path to the given room, without moving along it
# The 'number/count' in the protocol refers to the count of messages in the
# current code, eg: each direction with alias list will be sent seperately
# The 'data' portion will be seperated by a '|' by default, both this and the
# '#' can be changed.
# ID is a unique identifier allotted by the mapper or client to a message.
# add_exit, to add exits to rooms after creation!
# add_exit(NodeId, ExitName, Direction)
#
# Messages{ID}{'data'}[nr] = data
# Messages{ID}{'count'} = count
#
# Commandline options: -s <socketfile> (if(my $arg = is_member('-s', @ARGV) > -1) && defined($ARGV[$arg]) && -f (??) $ARGV[$arg])) .. 
#
# Communicate/define how a room looks,  with XML?
# Make help in HTML and show using Tk::HTML ??