#!/usr/bin/perl -w
# 
#	Nagiosmap - Visual configuration tool for Nagios map
#		Copyright (C) 2002-2004 Stéphane Urbanovski <s.urbanovski@ac-nancy-metz.fr>
#
# 			- add i18n support
#			- add Nagios new file config support
#			- add grid positionning support
#			- add status line
#			- bugfixes
#
#		adapted from :
#
#	SaintMap v2.1 - Visual configuration tool for NetSaint
#		Copyright (C) 2000 David Kmoch <David.Kmoch@vslib.cz>
#
#	This program is free software; you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation; either version 2 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	About Nagios :
#		see http://www.nagios.org
#		Nagios and the Nagios logo are registered trademarks of Ethan Galstad.
#

##################################################
#
# Path for directory with images (from nagios)
#
	my $imgpath="/usr/share/nagios/images/logos/";
#
##################################################
#
# Background image path. Use only GIF images.
# Set to empty string if you do not want any
# background image
#
# my $bg_image="somemap.gif";
	my $bg_image="";

##################################################
#
# Default path to your cfg files
#
#  my $cfgpath="/etc/nagios";
	my $cfgpath="/etc/nagios";


##################################################
#       NO CHANGES NEEDED BELOW                  # 
##################################################

use strict;
use Tk;
#use Tk::FileDialog;
#use Tk::FileSelect;

use POSIX;     # Needed for setlocale()
use Locale::gettext;

use File::Basename;

my $VERSION="3.2";
my %object;
my %objprop;
my @images;
my ($main,$menubar,$canvas);

my ($GRID_WIDTH,$GRID_HEIGHT,$GRID_STEP)=(2048,1024,50);
my ($ICON_WIDTH,$ICON_HEIGHT)=(60,50);

# default labels value :
my ($xpos,$ypos,$status)=(0,0,"");
my $change;

# set gettext stufs :
sub _ {
	return gettext($_[0]);
}
setlocale(LC_MESSAGES, "");
textdomain("nagiosmap");

&init_gui;

MainLoop;

########################### SUBS #################################

sub init_gui {	# Initialize main widget, menubar and canvas
	$main = MainWindow->new('-title'	=> 'NagiosMap v'.$VERSION);
	$main->geometry(&mw_size);
	$main->protocol('WM_DELETE_WINDOW',\&quit_it);
	&create_menubar;
	&prepare;
}

###########
sub prepare { # Additional initialization, used by &close
	undef %object;
	undef %objprop;
	$change = 0;
	&create_canvas;
	&read_images;
	&bgimage;
	&grid;
}



###########
sub create_menubar {	# Create menubar, specify callbacks


	my $menuframe = $main->Frame(
		'-relief'		=> 'raised',
		'-borderwidth'	=> 2
	)->pack(
		'-side'			=> 'top',
		'-anchor'		=> "n",
		'-expand'		=> 1,
		'-fill'			=> 'x'
	);
	my $statusframe = $main->Frame(
		'-relief'		=> 'raised',
		'-borderwidth'	=> 2
	)->pack(
		'-side'			=> 'bottom',
		'-anchor'		=> "n",
		'-expand'		=> 1,
		'-fill'			=> 'x'
	);

	$menubar = $menuframe->Menubutton(
		'-text'			=> _("File"),
		'-underline' 	=> 0 ,
		'-menuitems' 	=> [
			[ Button => _("Open"),	'-command' => [\&open_dialog] ],
			[ Button => _("Save"),	'-command' => [\&save_dialog], '-state' => 'disabled' ],
			[ Button => _("Close"),	'-command' => [\&close_current], '-state' => 'disabled' ],
			[ Button => _("Quit"),	'-command' => [\&quit_it] ],
		]
	)->pack('-side' => 'left');
   
	my $gridb = $menuframe->Button(
		'-text'			=> _("Grid"),
		'-relief'		=> 'flat',
		'-command'		=> \&grid,
	)->pack('-side' 	=> 'left');

	my $coordframe = $menuframe->Frame(
		'-relief'		=> 'groove',
		'-borderwidth'	=> 2
	)->pack('-side' 	=> 'right');

 	my $aboutb = $menuframe->Button(
		'-text'			=> _("About"),
		'-relief'		=> 'flat',
		'-command'		=> [\&about],
	)->pack('-side'		=> 'right');

 	my $xlabel = $coordframe->Label(
		'-text'			=> ' X '
	)->pack('-side'		=> 'left');

	my $xvalue = $coordframe->Label(
		'-background'	=> 'white',
		'-takefocus'	=> 0,
		'-textvariable'	=> \$xpos,
		'-width'		=> 4,
	)->pack('-side'		=> 'left');

	my $ylabel = $coordframe->Label(
		'-text'			=> ' Y '
	)->pack('-side'		=> 'left');

	my $yvalue = $coordframe->Label(
		'-background'	=> 'white',
		'-takefocus'	=> 0,
		'-textvariable'	=> \$ypos,
		'-width'		=> 4,
		'-relief'		=> 'flat',
	)->pack('-side'		=> 'left');

	my $statusvalue = $statusframe->Label(
		'-takefocus'	=> 0,
		'-textvariable'	=> \$status,
	)->pack('-side'		=> 'left');
}

############
sub create_canvas {	# Create canvas, bind specific actions
	$main->update;
	my $c = $main->Scrolled("Canvas",
		'-width'		=> $main->width,
		'-height'		=> $main->height,
		'-scrollregion'	=> [0,0,$GRID_WIDTH,$GRID_HEIGHT],
		'-bg'			=> 'gray80',
		'-scrollbars'	=> 'osoe',
	)->pack(
		'-fill'			=> 'both',
		'-expand'		=> 1
	);

	$canvas=$c->Subwidget("canvas");
	$canvas->Tk::bind("<1>", [ \&get_pos, Ev('x'), Ev('y')]);
	$canvas->Tk::bind("<B1-Motion>", [ \&get_pos, Ev('x'), Ev('y')]);
	$canvas->bind("moveable","<1>", [ \&drag_start, Ev('x'), Ev('y') ]);
	$canvas->bind("moveable","<B1-Motion>", [ \&drag_it, Ev('x'), Ev('y') ]);
	$canvas->bind("moveable","<Any-Enter>", [ \&highlight,Ev('T')]);
	$canvas->bind("moveable","<Any-Leave>", [ \&highlight,Ev('T')]);
	$canvas->bind("moveable","<3>", [ \&change_type,Ev('x'), Ev('y')]);
}  

sub create_file_dialog {	# Create file dialog box

	# OBSOLETE !!
	return 1;
#	return $main->FileDialog(
#		'-Title'			=> _("Select hosts.cfg file to read"),
#		'-Create'			=> 0,
#		'-FPat'				=> '*cfg',
#		'-File'				=> 'hosts.cfg',
#		'-Path'				=> $cfgpath,
#		'-Geometry'			=> "=500x300+".int($main->width/4)."+".int($main->height/4),
#		'-DirLBCaption'		=> _("Directories"),
#		'-FileLBCaption'	=> _("Files"),
#		'-FileEntryLabel'	=> _("Filename:"),
#		'-PathEntryLabel'	=> _("Pathname:"),
#		'-FltEntryLabel'	=> _("Filter:"),
#		'-ShowAllLabel'		=> _("Show All"),
#		'-OKButtonLabel'	=> _("OK"),
#		'-RescanButtonLabel'	=> _("Rescan"),
#		'-CancelButtonLabel'	=> _("Cancel"),
#		'-EDlgTitle'		=> _("File does not exist!"),
#		'-EDlgText'			=> _("You must specify an existing file.\n(\$filename not found)"),
#	);

}

############
sub bgimage { # If defined, show background image
	if (defined $bg_image) {
		my $img=$main->Photo('-file'	=> $bg_image);
		$canvas->createImage(0, 0,
			'-image'	=> $img,
			'-anchor'	=> 'nw',
			'-tags'		=> ["bgimg"]
		);
	}
}  

############
sub grid { # Show/hide grid

	if ($canvas->find("withtag","grid")) {
		$canvas->delete("grid");
	} else {
		for ( my $i=$GRID_STEP ; $i<$GRID_WIDTH ; $i+=$GRID_STEP ) {
			$canvas->createLine($i,0,$i,$GRID_HEIGHT,
				'-fill'	=> 'gray70',
				'-tags'	=> ["grid"]
			);
		}
		for ( my $i=$GRID_STEP ; $i<$GRID_HEIGHT ; $i+=$GRID_STEP ) {
			$canvas->createLine(0,$i,$GRID_WIDTH,$i,
				'-fill' => 'gray70',
				'-tags' => ["grid"]
			);
		}
		$canvas->lower("grid","all");
		if (defined $bg_image) {
			$canvas->raise("grid","bgimg")
		}
	}
}  
############
sub get_pos {	# Callback for position indicators
	my ($obj,$x,$y)=@_;
#	$xpos=$canvas->canvasx($x);
#	$ypos=$canvas->canvasy($y);
}

###########
sub mw_size { # Set MainWindow size
	my $size=0.9;
	my($dx,$dy)=($main->screenwidth,$main->screenheight);
	$dx = $dx > 1024 ? 1024 : $dx;
	$dy = $dy > 768 ? 768 : $dy;
	return int($size*$dx)."x".int($size*$dy)
}

############
sub open_dialog { # Show open file dialog
	my ($fname);

	$fname = $main->getOpenFile(
		-defaultextension => ".cfg",
		-filetypes        => [
			['Configuration Files',	['.cfg', '.conf']],
			['All Files',			'*',],
		],
		-initialdir       => $cfgpath,
		-initialfile      => 'hosts.cfg',
		-title            => _("Select hosts.cfg file to read"),
	);

	if ($fname) {
		&read_hosts($fname);
		
		$fname = $main->getOpenFile(
			-defaultextension => ".cfg",
			-filetypes        => [
				['Configuration Files',	['.cfg', '.conf']],
				['All Files',			'*',],
			],
			-initialdir       => $cfgpath,
			-initialfile      => 'hostextinfo.cfg',
			-title            => _("Select hostextinfo.cfg file to read"),
		);
		if ($fname) {
			&read_nscgi($fname);
		} else {
			$status = sprintf(_("Enable to open '%s' file !"),$fname);
		}
	} else {
		$status = sprintf(_("Enable to open '%s' file !"),$fname);
	}
}

############
sub save_dialog { # Show save file dialog
	my($fname);
	$fname = $main->getSaveFile(
		-initialdir       => $cfgpath,
		-initialfile      => 'hostextinfo.cfg',
		-title            => _("Select hostextinfo.cfg file to read"),
	);

	if ($fname) {
		if (!(-e $fname) || ((-e $fname) && (&overwrite($fname)))) {
			&save_file($fname);
		}
		return $fname;
	} else {
		$status = sprintf(_("Enable to save '%s' file !"),$fname);
	}
}

############
sub save_file { # Save %object records into $file
	my ($file)=@_;
	my ($obj,$img1,$img2);
	unless ( open(SAVE,">$file") ) {
		warn "$file : $!\n";
		return ;
	}
	for $obj (keys %object) {
		print SAVE "define hostextinfo {\n";
		print SAVE "	host_name	$obj\n";
		if ($object{$obj}{"Notes"}){
			print SAVE "	notes_url	".$object{$obj}{"Notes"}."\n";
		}
		print SAVE "	icon_image	".$object{$obj}{"Img"}."\n";
		
		print SAVE "	gd2_image	".$object{$obj}{"GD2"}."\n";
		if ($object{$obj}{"Alt"}) {
			print SAVE "	icon_image_alt	".$object{$obj}{"Alt"}."\n";
		}
		print SAVE "	2d_coords	".$object{$obj}{"X2d"}.",".$object{$obj}{"Y2d"}."\n";
		if ($object{$obj}{"X3d"}) {
			print SAVE "	3d_coords	".$object{$obj}{"X3d"}.",".$object{$obj}{"Y3d"}.",".$object{$obj}{"Z3d"}."\n";
			print SAVE "	vrml_image	".$object{$obj}{"VRML"}."\n";
		}
		print SAVE "}\n\n";

#		print STDERR ">".$obj." -> parent=".$object{$obj}->{"parent"}."\n";
	}
	close(SAVE);
	$change=0;
}

############
sub overwrite { # Toplevel overwrite dialog, returns 0 or 1
	my($file)=@_;
	my($over,$map,$text,$butf,$textf,$yes,$no,$retval);
	$over=$main->Toplevel('-title'=>_("Overwrite file?"));
	$over->geometry("+".int($main->width/2)."+".int($main->height/2));
	$over->transient($main);
	$over->grab;
	$textf=$over->Frame->pack;
	$map=$textf->Label('-bitmap' => 'error')->pack(
		'-side' => 'left',
		'-padx' => 5,
		'-pady' => 5
	);
	$text=$textf->Label(
		'-text' => _("File already exists!\nOverwrite?")
	)->pack(-side=>'left');
	$butf=$over->Frame->pack;
	$yes=$butf->Button(
		'-text'		=> _("Yes"),
		'-command'	=> sub{$retval=1}
	)->pack('-side' => 'left');

	$no=$butf->Button(
		'-text'		=> _("No"),
		'-command'	=> sub{$retval=0}
	)->pack('-side' => 'left');

	$over->waitVariable(\$retval);
	$over->grabRelease;
	$over->destroy;
	return $retval;
}

############
sub ask_save { # Toplevel ask dialog, returns 0 or 1
	my($over,$map,$text,$butf,$textf,$yes,$no,$retval);
	$over=$main->Toplevel('-title'=>_("Save changes?"));
	$over->geometry("+".int($main->width/2)."+".int($main->height/2));
	$over->transient($main);
	$over->grab;
	$textf=$over->Frame->pack;
	$map=$textf->Label('-bitmap'=>'warning')->pack(
		'-side'	=> 'left',
		'-padx'	=> 5,
		'-pady'	=> 5
	);
	$text=$textf->Label('-text' => _("Save changes?"))->pack('-side' => 'left');
	$butf=$over->Frame->pack;
	$yes=$butf->Button(
		'-text'		=> _("Yes"),
		'-command'	=> sub{ $retval = 1 }
	)->pack('-side' => 'left');
	$no=$butf->Button(
		'-text'		=> _("No"),
		'-command'	=> sub{ $retval = 0 }
	)->pack('-side' => 'left');
	$over->waitVariable(\$retval);
	$over->grabRelease;
	$over->destroy;
	return $retval;
}

############
sub read_hosts {# Actual reading of file hosts, parsing into %object hash
	my $file = shift;
	if ( ! open(HOST,$file) ) {
		print STDERR ("ERR: $file : $!");
		return;
	}
	my %curHost = ();
	$status = _("Please wait while reading").' hosts.cfg ...';
	while(my $line=<HOST>) {
		if ($line =~ /define\ host/) {
			# enter a new definition : lets clear all
			%curHost = ('parent' => []);
		} elsif ($line =~ /^\s*host_name\s+([\w\-\.]+)\s*(\;?.*|)$/) {
			# the current definition s hostname
			$curHost{"hostname"}=$1;
		} elsif ($line =~ /^\s*parents\s+([\w\-\.\ \,]+)\s*(\;?.*|)$/) {
			# the current definition s parent
			my $p = $1;
			$p =~ s/\ //g;
			@{$curHost{"parent"}} = split(/,/,$p);
		} elsif (($line =~ /^\s*\}/ )&&( exists $curHost{"hostname"}) )  {
			my %tmp=%curHost;
			%curHost = ();
			$object{$tmp{"hostname"}}=\%tmp;
		}
		
	}
	close(HOST);
}
############
sub read_nscgi {  # Actual nscgi reading, completing records in %object
	my($file)=@_;

	$status = _("Please wait while reading").' hostextinfo.cfg ...';
	if ( ! open(NSCGI,$file) ) {
		print STDERR ("ERR: $file : $!");
		return;
	}

	my %curHost = ();
	while ( my $line = <NSCGI> ) {
		$line =~ s/[\r\n]//g;
		if ($line =~ /define\ hostextinfo/) {
			%curHost = ();
		} elsif ($line =~ /^\s+host_name\s+([\w\-\.]+)\s*(\;?.*|)$/) {
			$curHost{"hostname"} = $1;
		} elsif ($line =~ /^\s+notes_url\s+(.*)\s*(\;?.*|)$/) {
			$curHost{"Notes"} = $1;
		} elsif ($line =~ /^\s+icon_image\s+([\w\d\-\_\.]+)\s*(\;?.*|)$/) {
			$curHost{"Img"} = $1;
		} elsif ($line =~ /^\s+icon_image_alt\s+(.*)\s*(\;?.*|)$/) {
			$curHost{"Alt"} = $1;
		} elsif ($line =~ /^\s+vrml_image\s+([\w\d\-\_\.]+)\s*(\;?.*|)$/) {
			$curHost{"VRML"} = $1;
		} elsif ($line =~ /^\s+gd2_image\s+([\w\d\-\_\.]+)\s*(\;?.*|)$/) {
			$curHost{"GD2"} = $1;
		} elsif ($line =~ /^\s+2d_coords\s+(\d+)\,(\d+)\s*(\;?.*|)$/) {
			$curHost{"X2d"} = $1;
			$curHost{"Y2d"} = $2;
		} elsif ($line =~ /^\s+3d_coords\s+(\d+)\,(\d+)\,(\d+)\s*(\;?.*|)$/) {
			$curHost{"X3d"} = $1;
			$curHost{"Y3d"} = $2;
			$curHost{"Z3d"} = $3;
		} elsif ( $line =~ /^\s*\}/ )  {
			if ( exists $object{$curHost{"hostname"}} ) {
				my %tmp=%curHost;
				$tmp{"parent"}=$object{$tmp{"hostname"}}->{"parent"};
				%curHost = ();
				$object{$tmp{"hostname"}}=\%tmp;
			} else {
				print STDERR "WARN: ".$curHost{"hostname"}." is not defined in hosts.cfg !\n";
			}
		}
		next;

	}
	close(NSCGI);
	&update_objects;
	&create_objects;
	$status = "";
}  

############
sub update_objects { # Correcting read values
	my ($x,$y) = ($ICON_WIDTH,$ICON_HEIGHT);

	foreach my $obj (sort keys %object) {
		unless (defined $object{$obj}->{"Y2d"}) {
		
			$object{$obj}->{"X2d"} = $x;
			$object{$obj}->{"Y2d"} = $y;
			$x += $ICON_WIDTH;
			if ($x > $GRID_WIDTH-$ICON_WIDTH) {
				$x = $ICON_WIDTH;
				$y += $ICON_HEIGHT;
			}
		}
		if ( defined $object{$obj}->{"Img"} ) {
			if ( ! -f $imgpath.$object{$obj}->{"Img"}) {
				print STDERR "NOTICE: Image not found for $obj : '".$imgpath.$object{$obj}->{"Img"}."', using default !\n";
			}
			
		} else {
			$object{$obj}->{Img} = "unknown.gif";
		}
		
		foreach my $attr (qw/Notes VRML GD2 Alt X3d Y3d Z3d/) {
			unless (defined $object{$obj}->{$attr}) {
				$object{$obj}->{$attr} = "";
			}
		}
	}
}
############
sub create_objects { # Create canvas objects stored in %object
	for my $obj (keys %object) {

		my $img = $main->Photo('-file',$imgpath.$object{$obj}->{"Img"});
		$object{$obj}->{"ID"} = $canvas->createImage(
			$object{$obj}->{"X2d"},
			$object{$obj}->{"Y2d"},
			'-image'	=> $img,
			'-tags'		=> ["moveable",$obj]
		);
		my ($l,$t,$r,$b)=$canvas->bbox($object{$obj}->{"ID"});
		$object{$obj}->{LabelID}=$canvas->createText(
			$l+20,$b+10,
			'-font'		=> 'fixed',
			'-text'		=> $obj
		);


		foreach my $parentObj (@{$object{$obj}->{"parent"}}) {
			my $lineid=$canvas->createLine(
				$l+(int(($r-$l)/2)),$t+(int(($b-$t)/2)),
				$object{$parentObj}->{"X2d"},$object{$parentObj}->{"Y2d"},
				'-tags'		=> ["line"]
			);
			$object{$obj}->{LineIDp}->{$lineid}=$parentObj;
			$object{$parentObj}->{LineID}->{$lineid}=$obj;
		}

#		if ( defined($object{$obj}->{"parent"}) && (exists $object{$object{$obj}->{"parent"}}) ) {
#			my $lineid=$canvas->createLine(
#				$l+(int(($r-$l)/2)),
#				$t+(int(($b-$t)/2)),
#				$object{$object{$obj}->{"parent"}}->{"X2d"},
#				$object{$object{$obj}->{"parent"}}->{"Y2d"},
#				'-tags'		=> ["line"]
#			);
#			$object{$obj}->{LineIDp}->{$lineid}=$object{$obj}->{"parent"};
#			$object{$object{$obj}->{"parent"}}->{LineID}->{$lineid}=$obj;
#		}
	}
	$canvas->lower("line","moveable");
	$menubar->entryconfigure(_("Save"),'-state' => 'normal');
	$menubar->entryconfigure(_("Close"),'-state' => 'normal');
	$menubar->entryconfigure(_("Open"),'-state' => 'disabled');
}

############
sub highlight { # Highlight object s label under the mouse cursor
	my($obj,$event)=@_;
	my($name);
	$name=($canvas->gettags($canvas->find("withtag","current")))[1];
	if ($event eq 'EnterNotify') {
		$canvas->itemconfigure($object{$name}->{LabelID},'-fill' => 'Red');
		$status = "Parent : [".join(",",@{$object{$name}->{"parent"}})."]    Alt : [".$object{$name}->{"Alt"}."]";
		for my $line (keys %{$object{$name}{LineIDp}}) {
			$canvas->itemconfigure($line,'-fill' => 'Red');
		}
	} else {
		$canvas->itemconfigure($object{$name}->{LabelID},'-fill' => 'Black');
		$status = "";
		for my $line (keys %{$object{$name}{LineIDp}}) {
			$canvas->itemconfigure($line,'-fill' => 'Black');
		}
	}
}

############
sub snaptogrid {
	my ($v)=@_;
	if ($canvas->find("withtag","grid")) {
		return 5*int($v/5);
	}
	return $v;
}

############
sub drag_start { # Callback for button 1 click
	my ($obj,$x,$y) = @_;
	$objprop{x} = $x;
	$objprop{y} = $y;

	$objprop{obj} = $canvas->find("withtag","current");
	my ($l1,$t1) = $canvas->bbox($objprop{obj});
	$objprop{x} = snaptogrid($x)+($l1-snaptogrid($l1));
	$objprop{y} = snaptogrid($y)+($t1-snaptogrid($t1));
}


############
sub drag_it { # Callback for button 1 motion - moves object, label and lines
	my ($obj,$x,$y) = @_;

	$change = 1 unless $change;

	$x = snaptogrid($x);
	$y = snaptogrid($y);
	
	my $dx = ($x-$objprop{x});
	my $dy = ($y-$objprop{y});
	
	$objprop{x} = $x;
	$objprop{y} = $y;

	$xpos = $x ;
	$ypos = $y ;
	
	# move icon :
	$canvas->move($objprop{obj},$dx,$dy);

	# move label :
	my $name = ($canvas->gettags($objprop{obj}))[1];
	$canvas->move($object{$name}->{LabelID},$dx,$dy);

	# bonding coords
	my ($l1,$r1,$t1,$b1) = $canvas->bbox($objprop{obj});

	# save object s coords :
	($object{$name}{"X2d"},$object{$name}{"Y2d"}) = $canvas->coords($objprop{obj});

	# show object coords :
	($xpos,$ypos) = ($l1,$t1); 

	# center coords
	my ($x1,$y1) = ($l1+(int(($t1-$l1)/2)),$r1+(int(($b1-$r1)/2)));

	# move all wires :
	for my $line (keys %{$object{$name}{LineID}}) {
		my ($l2,$r2,$t2,$b2) = $canvas->bbox($object{$object{$name}{LineID}{$line}}{"ID"});
		$canvas->coords($line,$x1,$y1,$l2+(int(($t2-$l2)/2)),$r2+(int(($b2-$r2)/2)));
	}
	for my $line (keys %{$object{$name}{LineIDp}}) {
		my ($l2,$r2,$t2,$b2) = $canvas->bbox($object{$object{$name}{LineIDp}{$line}}{"ID"});
		$canvas->coords($line,$x1,$y1,$l2+(int(($t2-$l2)/2)),$r2+(int(($b2-$r2)/2)));
	}
}

############
sub change_type { # Callback for button 3 - change type of the object
	my($obj,$x,$y)=@_;
	my($id,$name,$img,$choice);
	$change = 1 unless $change;
	$id = $canvas->find("withtag","current");
	$name = ($canvas->gettags($id))[1];
	$img = $object{$name}{"Img"};
	$img =~ s/\.gif//;
	$choice = &choose_type($x,$y,$img);
	$object{$name}{"Img"} = $choice.'.gif';
	$object{$name}{"GD2"} = $choice.'.gd2';
	$img=$main->Photo('-file' => $imgpath.$choice.'.gif');
	$canvas->itemconfigure($id,'-image' => $img);
}

############
sub choose_type { # Change type top level widget - returns image file
	my ($x,$y,$current)=@_;
	my ($count,$cv,$type,$img,$i,$h,$w,$wmax,$hsum);
	my $space = 4;
	$type=$main->Toplevel('-title'	=>_("Choose type"));
	$type->geometry("+$x+$y");
	$type->resizable(0,1);
	$type->transient($main);
	$x = $type->Scrolled('Canvas', 
		'-height'		=> 300,
		'-scrollbars'	=>'osoe',
	)->pack(
		'-fill'			=> 'both',
		'-expand'		=> 1
	);
	$cv = $x->Subwidget("canvas");
	$hsum = 0;
	$count = $space;
	$wmax = 0;
	for $img (@images) {
		$i=$main->Photo(
			'-file'			=> $imgpath.$img.'.gif',
		);
		$h=$i->height;
		$w=$i->width;
		$wmax= $w > $wmax ? $w : $wmax;
		$hsum+=$h;
		$y=$cv->Radiobutton(
			'-image'		=> $i,
			'-height'		=> $h,
			'-value'		=> $img,
			'-variable'		=> \$current,
			'-command'		=> sub{$type->grabRelease;$type->destroy},
		);
		$cv->createWindow($w,$count+int($i->height/2), '-window' => $y);
		$count=$count+$h+$space;
	}
	$x->configure(
		'-width'			=> $wmax+50,
		'-scrollregion'		=> [0, 0, $wmax+50, $space+$hsum+$#images*$space]
	);
	$type->update;
	$type->grab;
	$type->waitWindow;
	return $current;
}

############
sub close_current { # Close current map 
	if ($change) {
		if(&ask_save && !&save_dialog) {
			return
		}
	}
	$menubar->entryconfigure(_("Save"),'-state'		=>'disabled');
	$menubar->entryconfigure(_("Close"),'-state'	=>'disabled');
	$menubar->entryconfigure(_("Open"),'-state'		=>'normal');
	$canvas->parent->destroy;
	&prepare;
}

############
sub read_images { # Read gif image dir into @images
	if (!opendir(DIR, $imgpath)) {
	 	print STDERR "ERROR: Enable to load images : $imgpath : $!\n";
		return;
	}
#	@images = grep (/.*\.gif/i,readdir(DIR));
	while ( my $f= readdir(DIR) ) {
		if ($f =~ /(.*)\.gif/ ) {
			push (@images,$1);
		}
	}
	closedir DIR;
}

############
sub about { # Show about
	my($label,$about,$but);
	my $MSG="Copyright (c) 2000-2004\n";

	$MSG.="Authors:\n";
	$MSG.="	David Kmoch <David.Kmoch\@vslib.cz> (original author)\n";
	$MSG.="	Stéphane Urbanovski <s.urbanovski\@ac-nancy-metz.fr> (Nagios adaptation and i18n support)\n\n";

	$MSG.="Thanks to:\n";
	$MSG.="
	Petr Adamec <Petr.Adamec\@vslib.cz> for the idea
	Ethan Galstad <netsaint\@netsaint.org> for NetSaint and Nagios
	Adrian Pavlykevych <pam\@polynet.lviv.ua> and
	Szilard Fulop <silas\@fornax.hu> for patches and new ideas.
	\n";

	$MSG.="About Nagios:\n";
	$MSG.="
	See http://www.nagios.org
	Nagios and the Nagios logo are registered trademarks of Ethan Galstad.
	\n";

	$MSG.="License:\n";
	$MSG.="
	This program is free software; you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation; either version 2 of the License, or
	(at your option) any later version.
	";

	$MSG.= "
	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.
	";

	$about=$main->Toplevel(
		'-title'	=> _("About NagiosMap")
	);
	$about->geometry("+".int($main->width/4)."+".int($main->height/4));
	$about->transient($main);
	$about->resizable(0,0);
	$about->grab;
	$label=$about->Label(
		'-text'		=> "NagiosMap v$VERSION\n\n$MSG",
		'-font'		=> "7x13",
		'-justify'	=> 'left'
	)->pack(
		'-padx'		=> 5,
		'-pady'		=> 5,
		'-expand'	=> 1,
	);
	$but=$about->Button(
		'-text'		=> _("OK"),
		'-command'	=> sub{$about->grabRelease;$about->destroy},
	)->pack(
		'-pady'		=> 10
	);
}

############
sub quit_it { # Obvious
	$main->destroy;
	exit;
}