#!/usr/bin/perl -w
use strict;

# Babygimp 0.4

use POSIX;
use Tk;
use Tk::DialogBox;
use File::Basename;
use File::stat;
use FileHandle;
use Fcntl;
use locale;
use Text::Wrap qw($columns &wrap);
use DirHandle;

# ----------------------------------------------------------------------
# Prototypes
# ----------------------------------------------------------------------

# Communication with other instances of Babygimp
sub init();
sub read_fifo();

# Wrapper call the buggy Tk::Photo methods (must catch crashes as well as
# hangups!)
sub try($);
sub try_shell_command($);

# Preferences
sub read_config();
sub is_safe($);
sub write_config();
sub preferences_dialog();

# Exporters/Importers
sub read_convertors($$);
sub edit_convertor($$$);
sub save_convertors($$);
sub build_importer_menu();
sub create_importer();
sub delete_importer($);
sub edit_importer($);
sub build_exporter_menu();
sub create_exporter();
sub delete_exporter($);
sub edit_exporter($);

# Dialogs
sub load_dialog();
sub new_dialog();
sub quit_dialog();
sub save_dialog();
sub rambo_save();
sub save_image($);

# Loading and saving
sub save_buffer_to_xpm($$);
sub extension($);
sub load_xpm_to_buffer($);
sub load_image_to_buffer($);
sub save_buffer_to_image($$);

# Info
sub info(@);
sub message(@);

# Loading and saving the image
sub load_image($);
sub new_image($$$);

# Drawing a new image 
sub draw_preview();
sub display_info();
sub draw_image();
sub redraw_canvas();

# Draw pixels
sub set_transparency_weights();
sub draw_forced($$$);
sub draw_normal($$;$$$);
sub draw_bg($$;$$$);
sub draw_fg($$;$$$);
sub draw_color($$;$$$);
sub draw_value($$;$$$);
sub draw_saturation($$;$$$);
sub draw_erase($$;$$$);

# Draw figures
sub draw_line(@);
sub draw_rectangle($$$$);
sub draw_ellipse($$$$);
sub draw_filled_ellipse($$$$);

# Cutting and pasting
sub save_to_buffer($$$$);
sub insert_buffer($$$;$);
sub overwrite_buffer($$$);
sub delete_rectangle($$$$);
sub clear();

# Zooming
sub zoom($);
sub propose_zoomfac($$);

# Selecting colors
sub select_preview_bg($);
sub select_foreground();
sub select_background();
sub switch_fg_bg();
sub set_color_entry();
sub set_color_RGB();
sub set_color_Hex($);
sub set_color_Val();
sub pick_color();

# Palette
sub build_palette_menu();
sub build_palette();
sub palette_popup($$);
sub change_palette_color($);
sub insert_palette($);
sub remove_from_palette($);
sub save_palette_dialog();
sub load_palette_dialog($);
sub load_default_palette_dialog();
sub load_default_palette();
sub load_palette($);

# mousewatcher() watches the mouse movement of the drawing canvas.
# All drawing tools will be bound to mouse events in the drawing canvas 
# via canvas_bind() instead of Tk::bind().
sub mousewatcher($$$$);
sub button3watcher($$);
sub canvas_unbind();

# Routines to restrict the angle of lines etc.
sub restrict30($$$$);
sub restrict_line_30($$$$);
sub restrict45($$$$);
sub restrict_diagonal($$$$);

# Drawing tools
sub freehand_tool();
sub smooth_tool();
sub line_tool();
sub rectangle_tool();
sub filled_rectangle_tool();
sub ellipse_tool();
sub create_canvas_oval($$$$$);
sub spray_tool();
sub spray($$$$);

# mapping colors
sub floodfill_tool();
sub adaptive_floodfill($$$);
sub recursive_floodfill($$$$);
sub map_color();

# gradients
sub gradient_tool();
sub gradient_square($);
sub gradient_sqrt($);
sub gradient_sine($);
sub linear_gradient($$$$$$);
sub bilinear_gradient($$$$$$);
sub radial_gradient($$$$$$);

# warping
sub warp_tool();
sub warp($$$$);
sub spline($$$);

# selection handling
sub create_selection_rectangle($$$$$$);
sub select_region_tool();
sub select_region_dialog($$$$$);
sub select_region_cancel($$);
sub select_region_cut($$$$$$);
sub select_region_move($$$$$$$);
sub select_region_clip($$$$$$);
sub select_region_color_dialog($$$$$$);
sub select_region_flip_vert($$$$$$);
sub select_region_flip_horiz($$$$$$);
sub select_region_apply_plugin($$$$$$$);

# Transformations
sub resize_dialog();
sub resize_image($$);
sub smoothpixel($$;$);
sub bestpixel($$;$);
sub scale_dialog();
sub keep_x_aspect($$$$);
sub keep_y_aspect($$$$);
sub scale_image($$$);
sub rotate_dialog();
sub rotate_90($);
sub autocrop();
sub autocrop_buffer($);
sub flip_vert();
sub flip_horiz();

# Colorizing
sub color_dialog($;$$);
sub gamma_correct($$$$);
sub adjust_brightness($$);
sub adjust_saturation($$);
sub adjust_contrast($$);
sub sample_colorize_dialog($;$$);
sub sample_colorize($$);

# Clipboard
sub clipboard_items();
sub clipboard_add($);
sub clipboard_delete($);
sub clipboard_clear();
sub clipboard_photo($);
sub clipboard_paste($$);
sub clipboard_exchange($$);
sub clipboard_save_image();
sub clipboard_load_file_dialog();
sub clipboard_load_file($);

# Undo
sub undo();
sub enable_undo();
sub clear_undo();

# Colorspace conversions
sub RGBtoHex($$$);
sub HextoRGB($);
sub RGBtoHSV($$$);
sub HSVtoRGB($$$);

# Auxiliary functions
sub min(@);
sub max(@);
sub parse_image_data($);
sub matrixclone($);
sub dimensions($);

# Plugins
sub load_plugins();
sub build_plugin_menu();

# Help
sub help($);


{;} # to prevent emacs from wrong indenting

# ----------------------------------------------------------------------
#  Constants
# ----------------------------------------------------------------------

#my $max_canvas_width = 384;
#my $max_canvas_height = 384;
my $max_canvas_width = 500;
my $max_canvas_height = 500;
my @zoomfacs = (2, 3, 4, 6, 8, 10, 12, 14, 16);


# Files
my $babydir = "$ENV{HOME}/.babygimp";
my $configfile = "$babydir/babygimp.config";
my $fifoname = "$babydir/babygimp.fifo";
my $plugindir = "$babydir/plugins";
my $tmpdir = "$babydir/tmp";
my $bookmarkfile = "$babydir/bookmarks";
my $exporterfile = "$babydir/exporters";
my $importerfile = "$babydir/importers";

# ----------------------------------------------------------------------
# Config. Options (defaults, may be overwritten in config file)
# ----------------------------------------------------------------------
my %preferences = ( helpbrowser => "kdehelp",
                    docdir => "/usr/local/doc/Babygimp",
                    autobackups => 1,
                    queryoverwrite => 1,
		    querypalettesave => 1,
		    timeout => 5,
		    maxundo => 5,
		    defaultwidth => 32,
		    defaultheight => 32
		    );




# ----------------------------------------------------------------------
# Global (shared) variables 
# ----------------------------------------------------------------------

# Variables describing mouse events in the drawing cancvas
# These variables are set by mousewatcher() and are used by 
# the drawing tools
my ($mousex, $mousey) = (-1, -1); # mouse coordinates / zoomfactor 
my $mouse1down = 0;                # button 1 down ?
my $mouseincanvas = 0;            # mouse inside the canvas
my $canvas_callback;              # callback which will be invoked
                                  # when button 1 is pressed in the canvas
my @canvas_callback_args = ();
my $mouse3down = 0;


# Tools Options
my $restrict_lines_angle = 0; 

my $filled_rectangle = 0;
my $rectangle_force_square = 0;
my $filled_ellipse = 0;
my $ellipse_force_circle = 0;
my $restrict_gradient_angle = 0;

my $spray_radius = 2;
my $spray_intensity = 50;
my $spray_h_randomfak = 0;
my $spray_s_randomfak = 0;
my $spray_v_randomfak = 0;


my $smooth_mode = 0;  # 0: both directions, 1: horizontal, 2: vertical
my $smooth_intensity = 50;

my $h_tolerance = 0;
my $s_tolerance = 0;
my $v_tolerance = 0;
my $adaptive_floodfill = 0;

my $warpfac = 50;

my $gradient_type = 0;  # 0: linear, 1: bilinear, 2: radial, 3: rectangular
my $gradient_mode = 0;  # 0: foreground->background
                        # 1: foreground->transparency,
                        # 2: transparency->foreground
my $gradientfunc = 0;

# Filter Options
my $gaussian_blur_rx = 1;
my $gaussian_blur_ry = 1;
my $gaussian_blur_ignore_transparency = 1;

my $remove_isolated_diagonal_neighbours = 0;
my $remove_isolated_remove_visible = 1;
my $remove_isolated_remove_transparent = 0;
my $remove_isolated_min_neighbours = 1;


# Colors
my ($fg_frame, $fg_button, $fg_label, $bg_frame, $bg_button, $bg_label);
my $foreground = "#000000";            # drawing color
my ($fg_r, $fg_g, $fg_b) = (0, 0, 0);  # RGB components 
my $background = "#ffffff";            # currently only used with gradients
my ($bg_r, $bg_g, $bg_b) = (255, 255, 255);  # RGB components 
my $select_color = \$foreground;       # color which is set by the 
                                       # color selector
my ($select_r, $select_g, $select_b)  = (\$fg_r, \$fg_g, \$fg_b);
my $select_val = 0;
my $select_color_button = \$fg_button;
my ($redscale, $greenscale, $bluescale);


# Palette
my @default_palette = ( '#ffffff', '#c8c8c8', '#969696', '#646464', '#323232',
			'#000000', '#ff0000', '#800000', '#00ff00', '#008000',
			'#0000ff', '#000080', '#00ffff', '#008080', '#ff00ff',
			'#800080', '#ffff00', '#ff8000', '#804000', '#808000');
my @palette = @default_palette;

my @palette_buttons;
my $palette_dir = "$babydir/palettes";
my $palette_name = '';
my $palette_changed = 0;
my $palette_menubutton;

my $opacity = 100;
my $fg_weight = 1;
my $bg_weight = 0;
my $preview_bg = "#ffffff";
my $threshhold = 0;   # for floodfill and mapping

my $drawingfunc = \&draw_normal;

# Image
my ($width, $height);
my @pixelmatrix = ();  # $pixelmatrix[i][j] contains a string of the form
                       # #rrggbb. For transparent pixels it will be set to '';
my $zoomfac;
my $previewimage;
my @canvaspixel = ();

# Clipboard
my $cliplabel = 0;
my %clipboard_buffers;
my %clipboard_photos;

# Undo
my @undobuffer = ();
my $changes = 0;  # must count changes, since due to the fact the the undo 
                  # buffer is now limited, an empty does not mean an unchanged
                  # image

# Widgets, which are configured by callbacks
my $mw;           
my $drawingcanvas;
my $previewcanvas;   
my $previewcanvasframe;   
my $undobutton;
my $clipbutton;
my $pluginbutton;
my $fileinfo;       # displays the current drawing mode
my $sizeinfo;
my $pixelinfo;      # displays info about the pixel corresponding the 
                    # mouse position in the drawing canvas
my $modeframe;

# Tool Buttons
my ($active_button, $freehand_button, $line_button, $rect_button, 
    $ellipse_button, 
    $spray_button, $smooth_button, $map_button, $floodfill_button,
    $gradient_button, $warp_button, $select_button, $pick_button);



my %previewbg_button;

# messages
my $guimessages = 0; # set to 1 when the gui is built
my $infolabel;
my $infotext = '';

# Current file
my $filename;

# Plugins
my @plugins;
my @regionfilters;  # filter plugins which may be applied to the selcted
                    # region (must not change the image size)

# Export/import filters
my %exporters;
my %importers;


# ----------------------------------------------------------------------
# Main program
# ----------------------------------------------------------------------

init();
load_plugins();

scalar(@ARGV) <= 1 or die "usage: minigimp [xpm-file]\n";
    
# Build main window and frames
$mw = new MainWindow();
$mw->optionAdd( '*BorderWidth' => 1);


#$mw->resizable(0,0);
my $menuframe = $mw->Frame(-borderwidth => 3, -relief => "ridge");
my $mainframe = $mw->Frame();
my $leftframe = $mainframe->Frame(-borderwidth => 3, -relief => 'ridge');
my $drawingframe = $mainframe->Frame(-relief => "ridge", -borderwidth => 3);
my $rightframe = $mainframe->Frame();

# Build menus
my $filemenu = $menuframe->
    Menubutton(-text => "File ...", -tearoff => 0, -relief => "raised",
	       -padx => 0, -pady => 1, -width => 12,
	       -menuitems => 
	       [ ['command' => "New", -command => \&new_dialog ],
		 ['command' => "Open", -command => \&load_dialog ],
		 ['command' => "Save", -command => \&rambo_save ],
		 ['command' => "Save as", -command => \&save_dialog ],
		 ['cascade' => 'Importers'],
		 ['cascade' => 'Exporters'],
		 ['command' => "Quit", -command => \&quit_dialog ]])
    ->pack(-side => "left");

my $zoommenu = $menuframe->Menubutton(-text => "Zoom ...", 
				      -tearoff => 0, -relief => "raised",
				      -padx => 0, -pady => 1, -width => 12,
				      -menuitems => [])
    ->pack(-side => "left");
foreach (@zoomfacs) {
    $zoommenu->AddItems(['command' => "1:$_",-command => [\&zoom, $_]]);
}

$undobutton = $menuframe->Button(-text => "Undo", -state => "disabled", 
				 -padx => 0, -pady => 0, -width => 12,
				 -command => \&undo)
                        ->pack(-side => "left");
$clipbutton = $menuframe
    ->Menubutton(-text => "Clipboard ...", 
		 -tearoff => 0, -relief => "raised",
		 -padx => 0, -pady => 1, -width => 12,
		 -menuitems =>
		 [[ 'command' => 'Copy Image to Clipboard', 
		    -command => \&clipboard_save_image],
		  [ 'command' => 'Load File to Clipboard', 
		    -command => \&clipboard_load_file_dialog],
		  [ 'command' => 'Clear', -command => \&clipboard_clear]])
    ->pack(-side => "left");
$menuframe->Button(-text => "Help", -command => [\&help, 'index.html'],
	       -padx => 0, -pady => 0, -width => 12)
          ->pack(-side => "right");
$menuframe->Button(-text => "Options", -command => \&preferences_dialog,
	       -padx => 0, -pady => 0, -width => 12)
          ->pack(-side => "right");

$menuframe->Menubutton(-text => 'Transform ...',
		       -tearoff => 0, -relief => "raised",
		       -padx => 0, -pady => 1, -width => 12,
		       -menuitems =>
		       [[ 'command' => 'Resize', -command => \&resize_dialog],
			[ 'command' => 'Add Border', 
			  -command => \&add_border_dialog],
			[ 'command' => 'Scale', -command => \&scale_dialog],
			[ 'command' => 'Rotate', -command => \&rotate_dialog],
			[ 'command' => 'Flip Vertically', 
			  -command => \&flip_vert],
			[ 'command' => 'Flip Horizontally', 
			  -command => \&flip_horiz],
			[ 'command' => 'Autocrop', -command => \&autocrop],
			])->pack(-side => "left");		       

$menuframe->Menubutton(-text => "Filters ...",
		       -padx => 0, -pady => 1, -width => 12,
		       -tearoff => 0, -relief => "raised",
		       -menuitems =>
		       [[ 'command' => 'Color Equalizer', 
			  -command => [\&color_dialog, \@pixelmatrix]],
			[ 'command' => 'Sample Colorizer', 
			  -command => [\&sample_colorize_dialog, 
				       \@pixelmatrix]],
			[ 'command' => 'Gaussian Blur', 
			  -command => [\&gaussian_blur_buffer_dialog, 
				       \@pixelmatrix]],
			[ 'command' => 'Remove Isolated Pixels', 
			  -command => [\&remove_isolated_buffer_dialog, 
				       \@pixelmatrix]]
			])->pack(-side => "left");		       

$pluginbutton = $menuframe
    ->Menubutton(-text => "Plugins ...", 
		 -tearoff => 0, -relief => "raised",
		 -padx => 0, -pady => 1, -width => 12,
		 -menuitems => [
				['command' => 'Create Pew Plugin',
				 -command => \&create_plugin],
				['command' => 'Rescan Plugins',
				 -command => \&rescan_plugins]
				])
    ->pack(-side => "left");

$palette_menubutton = $menuframe
    ->Menubutton(-text => "Palettes ...", 
		 -tearoff => 0, -relief => "raised",
		 -padx => 0, -pady => 1, -width => 12,
		 -menuitems => [
				['command' => 'Save as',
				 -command => \&save_palette_dialog],
				['command' => 'Builtin Default',
				 -command => \&load_default_palette_dialog]
				])
    ->pack(-side => "left");

# Drawing modes
my $modeframe1 = $leftframe->Frame()->pack();

$modeframe1->Radiobutton(-text => "Normal", -value => \&draw_normal,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 0, -column => 0, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Erase", -value => \&draw_erase,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 0, -column => 1, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Backgr.", -value => \&draw_bg,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 1, -column => 0, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Foregr.", -value => \&draw_fg,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 1, -column => 1, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Color", -value => \&draw_color,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 2, -column => 0, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Value", -value => \&draw_value,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 2, -column => 1, -sticky => 'sw', -pady => 0);
$modeframe1->Radiobutton(-text => "Saturation", -value => \&draw_saturation,
			 -pady => 0, -variable => \$drawingfunc)
    ->grid(-row => 3, -column => 0, -columnspan => 2, 
	   -sticky => 'sw', -pady => 0);

$leftframe->Label(-text=> 'Opacity:')->pack(-anchor => 'w');
$leftframe->Scale(-orient => "horizontal",
		  -from => 0, -to => 100, -variable => \$opacity,
		  -showvalue => 0,
		  -command => \&set_transparency_weights)
    ->pack(-fill => 'x');

$leftframe->Button(-text => 'Clear', -anchor => 'w', -pady => 0,
		   -command => \&clear)->pack(-fill => 'x');

# Drawing tools
$freehand_button = $leftframe->Button(-text => 'Freehand', 
				      -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');
$line_button = $leftframe->Button(-text => 'Lines', 
				  -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');
my $lines_frame = $leftframe->Frame(-relief => 'sunken', 
				    -borderwidth => 1);
$lines_frame->Label(-text => 'Lines Angle:')->pack(-anchor => 'w');
$lines_frame->Radiobutton(-text => 'Arbitrary',
			  -variable => \$restrict_lines_angle,
			  -value => 0)    
    ->pack(-anchor => 'w');
$lines_frame->Radiobutton(-text => 'Muiltiples of 30 ', 
			  -variable => \$restrict_lines_angle,
			  -value => 30)    
    ->pack(-anchor => 'w');
$lines_frame->Radiobutton(-text => 'Multiples of 45 ',
			  -variable => \$restrict_lines_angle,
			  -value => 45)    
    ->pack(-anchor => 'w');


$rect_button = $leftframe->Button(-text => "Rectangle", 
				  -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');
my $rectangle_frame = $leftframe->Frame(-relief => 'sunken',
				       -borderwidth => 1);
$rectangle_frame->Checkbutton(-text => 'Filled',
			      -variable => \$filled_rectangle)
    ->pack(-anchor => 'w');
$rectangle_frame->Checkbutton(-text => 'Force Square',
			      -variable => \$rectangle_force_square)
    ->pack(-anchor => 'w');


$ellipse_button = $leftframe->Button(-text => "Ellipse", 
				     -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');
my $ellipse_frame = $leftframe->Frame(-relief => 'sunken',
				       -borderwidth => 1);
$ellipse_frame->Checkbutton(-text => 'Filled',
			  -variable => \$filled_ellipse)
    ->pack(-anchor => 'w');
$ellipse_frame->Checkbutton(-text => 'Force Circle',
			  -variable => \$ellipse_force_circle)
    ->pack(-anchor => 'w');

# Spray
$spray_button = $leftframe->Button(-text => "Spray", 
				   -anchor => "w",  -pady => 0)
    ->pack(-fill => 'x');

my $spray_frame = $leftframe->Frame(-relief => 'sunken', -borderwidth => 1);

$spray_frame->Label(-text => 'Radius:')
    ->grid(-row => 0, -column => 0, -sticky => 'w');
$spray_frame->Label(-textvariable => \$spray_radius, -width => 1)
    ->grid(-row => 0, -column => 1, -sticky => 'w');
$spray_frame->Scale(-variable => \$spray_radius, -showvalue => 0,
		    -orient => 'horizontal', 
		    -length => 65, -sliderlength => 25,
		    -from => 0, -to => 5, resolution => 1)
    ->grid(-row => 0, -column => 2, -sticky => 'w');

$spray_frame->Label(-text => 'Intensity:')
    ->grid(-row => 1, -column => 0, -columnspan => 2, -sticky => 'w');

$spray_frame->Scale(-variable => \$spray_intensity, -showvalue => 1,
		    -orient => 'horizontal', 
		    -length => 65, -sliderlength => 25,
		    -from => 0, -to => 100)
    ->grid(-row => 1, -column => 2, -sticky => 'w');


$spray_frame->Label(-text => 'Randomization:')
    ->grid(-row => 2, -column => 0, -columnspan => 3, -sticky => 'w');


$spray_frame->Label(-text=> 'Color', -pady => 0, -padx => 0)
    ->grid(-row => 3, -column => 0, -columnspan => 2, -sticky => 'w');
$spray_frame->Scale(-variable => \$spray_h_randomfak,
		    -length => 65, -sliderlength => 25,
		    -from => 0, -to => 300, 
		    -orient => "horizontal", -showvalue => 0) 
    ->grid(-row => 3, -column => 2, -sticky => 'w');

$spray_frame->Label(-text=> 'Saturation', -pady => 0, -padx => 0)
    ->grid(-row => 4, -column => 0, -columnspan => 2, -sticky => 'w');
$spray_frame->Scale(-variable => \$spray_s_randomfak,
		    -from => 0, -to => 50, 
		    -length => 65, -sliderlength => 25,
		    -orient => "horizontal", -showvalue => 0) 
    ->grid(-row => 4, -column => 2, -sticky => 'w');

$spray_frame->Label(-text=> 'Brightness', -pady => 0, -padx => 0)
    ->grid(-row => 5, -column => 0, -columnspan => 2, -sticky => 'w');
$spray_frame->Scale(-variable => \$spray_v_randomfak,
		    -from => 0, -to => 50, 
		    -length => 65, -sliderlength => 25,
		    -orient => "horizontal", -showvalue => 0) 
    ->grid(-row => 5, -column => 2, -sticky => 'w');

# Smoothing
$smooth_button = $leftframe->Button(-text => "Smoothing", 
				    -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');

my $smooth_frame = $leftframe->Frame(-relief => 'sunken', -borderwidth => 1);
$smooth_frame->Label(-text => 'Direction:')->pack(-anchor => 'w');
my $smoothframe2 = $smooth_frame->Frame()->pack(-anchor => 'w');
$smoothframe2->Radiobutton(-text => 'xy', -pady => 0, -padx => 0,
			   -variable => \$smooth_mode, -value => 0)
    ->pack(-side => 'left');
$smoothframe2->Radiobutton(-text => 'x', -pady => 0, -padx => 0,
			   -variable => \$smooth_mode, -value => 1)
    ->pack(-side => 'left');
$smoothframe2->Radiobutton(-text => 'y', -pady => 0, -padx => 0,
		       -variable => \$smooth_mode, -value => 2)
    ->pack(-side => 'left');
$smooth_frame->Label(-text => 'Intensity:')
    ->pack(-anchor => 'w');
$smooth_frame->Scale(-variable => \$smooth_intensity, -showvalue => 0,
		  -orient => 'horizontal', 
		  -from => 0, -to => 100, -length => 100)
    ->pack(-fill => 'x');


# Mapping colors
$map_button = $leftframe->Button(-text => 'Map Colors', 
				 -anchor => 'w', -pady => 0)
    ->pack(-fill => 'x');

my $map_frame = $leftframe->Frame(-relief => 'sunken', 
					 -borderwidth => 1);
$map_frame->Label(-text=> 'Color Tolerance:', -pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$map_frame->Scale(-variable => \$h_tolerance,
			 -from => 0, -to => 600, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');
$map_frame->Label(-text=> 'Saturation Tolerance:', -pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$map_frame->Scale(-variable => \$s_tolerance,
			 -from => 0, -to => 100, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');
$map_frame->Label(-text=> 'Brightness Tolerance:', -pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$map_frame->Scale(-variable => \$v_tolerance,
			 -from => 0, -to => 100, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');

$floodfill_button = $leftframe->Button(-text => 'Flood Fill', 
				       -anchor => 'w', -pady => 0)
    ->pack(-fill => 'x');
my $floodfill_frame = $leftframe->Frame(-relief => 'sunken', 
					-borderwidth => 1);
$floodfill_frame->Checkbutton(-text => 'Adaptive', 
			      -variable => \$adaptive_floodfill)
    ->pack(-anchor => 'w');
			      

$floodfill_frame->Label(-text=> 'Color Tolerance:', -pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$floodfill_frame->Scale(-variable => \$h_tolerance,
			 -from => 0, -to => 600, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');
$floodfill_frame->Label(-text=> 'Saturation Tolerance:', 
			-pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$floodfill_frame->Scale(-variable => \$s_tolerance,
			 -from => 0, -to => 100, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');
$floodfill_frame->Label(-text=> 'Brightness Tolerance:', 
			-pady => 0, -padx => 0)
    ->pack(-anchor => 'w');
$floodfill_frame->Scale(-variable => \$v_tolerance,
			 -from => 0, -to => 100, 
			 -orient => "horizontal", -showvalue => 0) 
    ->pack(-fill => 'x');




# Gradients
$gradient_button = $leftframe->Button(-text => 'Gradient', 
				      -anchor => 'w', -pady => 0)
    ->pack(-fill => 'x');

my $gradient_frame = $leftframe->Frame(-relief => 'sunken',
				       -borderwidth => 1, );
$gradient_frame->Label(-text => 'Type:', -anchor => 'w')
    ->grid(-row => 0, -column => 0, -sticky => 'w', -pady => 3);
my $gradient_type_menu = $gradient_frame
    ->Menubutton(-text => 'Linear', -anchor => 'w', -width => 10,
		 -tearoff => 0, -pady => 1, -relief => 'raised')
    ->grid(-row => 0, -column => 1, -sticky => 'e');
$gradient_type_menu->AddItems(
			      ['command' => 'Linear',
			       -command => [\&menuselect, $gradient_type_menu,
					    'Linear', \$gradient_type, 0]],
			      ['command' => 'Bilinear',
			       -command => [\&menuselect, $gradient_type_menu,
					    'Bilinear', \$gradient_type, 1]],
			      ['command' => 'Radial',
			       -command => [\&menuselect, $gradient_type_menu,
					    'Radial', \$gradient_type, 2]],
			      ['command' => 'Rectangular',
			       -command => [\&menuselect, $gradient_type_menu,
					    'Rect.', \$gradient_type, 3]],
			      ['command' => 'Conic',
			       -command => [\&menuselect, $gradient_type_menu,
					    'Conic', \$gradient_type, 4]]
			      );

$gradient_frame->Label(-text => 'Function:')
    ->grid(-row => 1, -column => 0, -sticky => 'w', -pady => 3);

my $gradient_func_menu = $gradient_frame
    ->Menubutton(-text => 'None', -anchor => 'w', -width => 10,
		 -tearoff => 0, -pady => 1, -relief => 'raised')
    ->grid(-row => 1, -column => 1, -sticky => 'e');
$gradient_func_menu
    ->AddItems( ['command' => 'None',
		 -command => [\&menuselect, $gradient_func_menu,
			      'None', \$gradientfunc, 0]],
		['command' => 'Sqrt',
		 -command => [\&menuselect, $gradient_func_menu,
			      'Sqrt', \$gradientfunc, \&gradient_sqrt]],
		['command' => 'Square',
		 -command => [\&menuselect, $gradient_func_menu,
			      'Square', \$gradientfunc, \&gradient_square]],
		['command' => 'Sine',
		 -command => [\&menuselect, $gradient_func_menu,
			      'Sine', \$gradientfunc, \&gradient_sine]]
		);

$gradient_frame->Label(-text => 'Colors:')
    ->grid(-row => 2, -column => 0, -sticky => 'w', -pady => 3);

my $gradient_color_menu = $gradient_frame
    ->Menubutton(-text => 'Fg->Bg', -anchor => 'w', -width => 10,
		 -tearoff => 0, -pady => 1, -relief => 'raised')
    ->grid(-row => 2, -column => 1, -sticky => 'e');
$gradient_color_menu
    ->AddItems( ['command' => 'Fg->Bg',
		 -command => [\&menuselect, $gradient_color_menu,
			      'Fg->Bg', \$gradient_mode, 0]],
		['command' => 'Fg->Transp',
		 -command => [\&menuselect, $gradient_color_menu,
			      'Fg->Transp', \$gradient_mode, 1]],
		['command' => 'Transp->Fg',
		 -command => [\&menuselect, $gradient_color_menu,
			      'Transp->Fg', \$gradient_mode, 2]],
		);


$gradient_frame->Label(-text => 'Angle:')
    ->grid(-row => 3, -column => 0, -sticky => 'w', -pady => 3);

my $gradient_angle_menu = $gradient_frame
    ->Menubutton(-text => 'Arbitrary', -anchor => 'w', -width => 10,
		 -tearoff => 0, -pady => 1, -relief => 'raised')
    ->grid(-row => 3, -column => 1, -sticky => 'e');
$gradient_angle_menu
    ->AddItems( ['command' => 'Arbitrary',
		 -command => [\&menuselect, $gradient_angle_menu,
			      'Arbitrary', \$restrict_gradient_angle, 0]],
		['command' => '30 ',
		 -command => [\&menuselect, $gradient_angle_menu,
			      '30 ', \$restrict_gradient_angle, 30]],
		['command' => '45 ',
		 -command => [\&menuselect, $gradient_angle_menu,
			      '45 ', \$restrict_gradient_angle, 45]]
		);

# Warping
$warp_button = $leftframe->Button(-text => "Warp", 
				  -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');

my $warp_frame = $leftframe->Frame(-relief => 'sunken', -borderwidth => 1);
$warp_frame->Label(-text=> "Warp Factor:", -pady => 0)
    ->pack(-anchor => 'w');
$warp_frame->Scale(-orient => 'horizontal',
		  -from => 10, -to => 90, 
		  -length => 100, -showvalue => 0,
		  -variable => \$warpfac)
    ->pack(-fill => 'x');

$select_button = $leftframe->Button(-text => 'Select Region',
				    -anchor => "w", -pady => 0)
    ->pack(-fill => 'x');


# configure the tool buttons
$freehand_button->configure(-command => [\&start_tool, \&freehand_tool, 
					 $freehand_button, 0,0]);
$line_button->configure(-command => [\&start_tool, \&line_tool, 
					 $line_button, 
				     $rect_button, $lines_frame]);
$rect_button->configure(-command => [\&start_tool, \&rectangle_tool, 
				     $rect_button, $ellipse_button,
				     $rectangle_frame]);
$ellipse_button->configure(-command => [\&start_tool, \&ellipse_tool, 
					$ellipse_button, 
					$spray_button, 
					$ellipse_frame]);
$spray_button->configure(-command => [\&start_tool, \&spray_tool, 
				      $spray_button, $smooth_button,
				      $spray_frame]);
$smooth_button->configure(-command => [\&start_tool, \&smooth_tool,
				       $smooth_button, $map_button,
				       $smooth_frame]);
$map_button->configure(-command => [\&start_tool, \&map_color,
				    $map_button, $floodfill_button,
				    $map_frame]);
$floodfill_button->configure(-command => [\&start_tool, \&floodfill_tool,
					  $floodfill_button, $gradient_button,
				    $floodfill_frame]);
$gradient_button->configure(-command => [\&start_tool, \&gradient_tool, 
				     $gradient_button, $warp_button, 
				     $gradient_frame]);
$warp_button->configure(-command => [\&start_tool, \&warp_tool, 
				     $warp_button, $select_button, 
				     $warp_frame]);
$select_button->configure(-command => [\&start_tool, \&select_region_tool,
				       $select_button, 0, 0]);



# Middle frame (drawing canvas and some status labels)
my $infoframe = $drawingframe->Frame->pack(-fill => 'x');
$fileinfo = $infoframe->Label(-width => 40, -anchor => 'nw', 
				 -justify => 'left')
    ->pack(-side => 'left', -anchor => 'nw');   
$sizeinfo = $infoframe->Label(-width => 15, -anchor => 'w')
    ->pack(-side => 'right', -anchor => 'ne');   
my $canvasframe = $drawingframe->Frame()->pack(-expand => 1, -fill => "both", -anchor => "nw");
my $scrollbar1 = $canvasframe->Scrollbar(-orient => "horizontal");
my $scrollbar2 = $canvasframe->Scrollbar();
$drawingcanvas = $canvasframe
    ->Canvas(-xscrollcommand => ['set', $scrollbar1],
	     -yscrollcommand => ['set', $scrollbar2]);
$scrollbar1->configure(-command => ['xview', $drawingcanvas]);
$scrollbar2->configure(-command => ['yview', $drawingcanvas]);
$scrollbar1->grid(-row => 0, -column => 1, -sticky => "ew");
$scrollbar2->grid(-row => 1, -column => 0, -sticky => "ns");
$drawingcanvas->grid(-row => 1, -column => 1);
$pixelinfo = $drawingframe->Label(anchor => 'w')
    ->pack(-fill => 'both', -expand => 1);


# Right frame (preview and colors)
my $previewframe = $rightframe->Frame(-relief => "ridge", -borderwidth => 3)
			      ->pack(-fill => "x", -anchor => 'w');
my $colorframe = $rightframe->Frame(-borderwidth => 3, -relief => "ridge")
                            ->pack(-expand => 1, -fill => 'both');

# Preview
$previewcanvasframe = $previewframe->Frame(-background => $preview_bg,
					   -borderwidth => 2,
					   -relief => 'ridge')
    ->pack(-side => 'left');
$previewcanvas = $previewcanvasframe
    ->Canvas(-background => $preview_bg, -borderwidth => 0,
	     -highlightthickness => 0)
    ->pack(-anchor => 'nw', -padx => 10, -pady => 10);
my $preview_bg_frame = $previewframe->Frame()
    ->pack(-side => 'left', -padx => 10, -anchor => 'n');

$preview_bg_frame->Label(-text => 'Preview background:')
    ->grid(-column => 0, -row => 0, -columnspan => 7, -sticky => 'nw');
{
    my $column = 0;
    foreach ("#000000", "#888888", "#ffffff", 
	     "#ff0000", "#00ff00", "#0000ff") {
	$previewbg_button{$_} =
	    $preview_bg_frame->Button(-background => $_, 
				      -activebackground => $_,
				      -command => [\&select_preview_bg, $_])
		->grid(-row => 1, -column => $column++, -sticky => 'nw');
    }
}

# Colors selection
my $cframe1 = $colorframe->Frame(-borderwidth => 10)
    ->pack(-anchor => "n");

$fg_frame = $cframe1->Frame(-borderwidth => 2, -relief => 'groove',
			    -background => '#eeeeee')
    ->pack(-side => 'left', -anchor => 'w');
$fg_frame->Tk::bind('<Button-1>', \&select_foreground);
$fg_button = $fg_frame->Button(-background => $foreground,
			       -activebackground => $foreground,
			       -relief => 'sunken',
			       -command => \&select_foreground)
    ->pack(-anchor => 'w', -ipadx => 5, -ipady => 5);
$fg_label = $fg_frame->Label(-textvariable => \$foreground, -anchor => 'w',
			     -background => '#eeeeee', -width => 8)
    ->pack(-anchor => 'w');
$fg_label->Tk::bind('<Button-1>', \&select_foreground);
$cframe1->Button(-text => ' <-> ', -padx => 0, -pady => 0,
		 -command => \&switch_fg_bg)
    ->pack(-side => 'left', -padx => 30);

$bg_frame = $cframe1->Frame(-borderwidth => 2, -relief => 'groove')
    ->pack(-side => 'left', -anchor => 'e');
$bg_frame->Tk::bind('<Button-1>', \&select_background);
$bg_button = $bg_frame->Button(-background => $background,
			      -activebackground => $background,
			      -command => \&select_background)
    ->pack(-anchor => 'w', -ipadx => 5, -ipady => 5);
$bg_label = 
    $bg_frame->Label(-textvariable => \$background, -width => 8, -anchor => 'w')
    ->pack(-anchor => 'w');
$bg_label->Tk::bind('<Button-1>', \&select_background);

my $cframe2 = $colorframe->Frame()->pack(-anchor => "nw");
$cframe2->Label(-text => 'Enter Hex value (#rrggbb): ')->pack(-side => 'left');
my $hex_entry = $cframe2->Entry(-background => '#ffffff',
				-width => 7)->pack(-side => 'left');
$hex_entry->bind('<Return>', \&set_color_entry);

$pick_button = $colorframe->Button(-text => "Pick Color from the Image", 
				      -padx => 0, -pady => 0, -anchor => 'w')
    ->pack(-anchor => 'w');
$pick_button->configure(-command => [\&start_tool, \&pick_color, 
				     $pick_button, 0, 0]);

$colorframe->Scale(-orient => "horizontal",
		   -from => 0, -to => 255, -length => 256, 
		   -variable => \$select_val, -command => \&set_color_Val)
    ->pack();
$redscale = 
    $colorframe->Scale(-orient => "horizontal", -troughcolor => "red",
		       -from => 0, -to => 255, -length => 256, 
		       -variable => $select_r, -command => \&set_color_RGB)
    ->pack();
$greenscale = 
    $colorframe->Scale(-orient => "horizontal", -troughcolor => "green",
		       -from => 0, -to => 255, -length => 256, 
		       -variable => $select_g, -command => \&set_color_RGB)
    ->pack();
$bluescale =
    $colorframe->Scale(-orient => "horizontal", -troughcolor => "blue",
		       -from => 0, -to => 255, -length => 256, 
		       -variable => $select_b, -command => \&set_color_RGB)
    ->pack();

$colorframe->Label()->pack();

$colorframe->Label()->pack();

# Palette
my $palette_frame = $colorframe->Frame()->pack();
if (-f "$palette_dir/default.pal") { 
    load_palette('default') or load_default_palette();
} else {
    load_default_palette();
}
build_palette_menu();

# Pack the Frames
$menuframe->pack(-fill => "x");
$mainframe->pack(-fill => "x");
$leftframe->pack(-side => "left", -fill => 'both', -anchor => 'n');
$drawingframe->pack(-side => "left", -expand => 1, -fill => "both");
$rightframe->pack(-side => "right", -fill => "both");
$infolabel = $mw->Label(-height => 2, -width => 60,
			-anchor => "nw", -justify => "left",
			-borderwidth => 3, -relief => 'ridge')
                ->pack(-fill => "x");

# Load and draw pixmap (from command line argument or default)
if (@ARGV) {
    $filename = $ARGV[0];
    (-f $filename and load_image($filename)) 
	or new_image($preferences{defaultwidth}, 
		     $preferences{defaultheight}, $filename);
} else {
    new_image($preferences{defaultwidth}, $preferences{defaultheight}, 
	      "untitled.xpm");
}

# Bind the mouse watcher to the drawing canvas
$drawingcanvas->Tk::bind("<Motion>", [\&mousewatcher, 
				      Ev('x'), Ev('y'), Ev('T')]);
$mw->Tk::bind("<Button-1>", [\&mousewatcher, 
					Ev('x'), Ev('y'), Ev('T')]);
$mw->Tk::bind("<ButtonRelease-1>", [\&mousewatcher, 
				      Ev('x'), Ev('y'), Ev('T')]);
$drawingcanvas->Tk::bind("<Enter>", [\&mousewatcher, 
				     Ev('x'), Ev('y'), Ev('T')]);
$drawingcanvas->Tk::bind("<Leave>", [\&mousewatcher, 
				     Ev('x'), Ev('y'), Ev('T')]);
# Watch Button 3 separately (used to cancel drawing tools)
$mw->Tk::bind("<Button-3>", [\&button3watcher, Ev('T')]);
$mw->Tk::bind("<ButtonRelease-3>", [\&button3watcher, Ev('T')]);

$mw->after(300, \&read_fifo);

my $FileBrowser = new FileChooser($mw, $bookmarkfile);
build_plugin_menu();
build_importer_menu();
build_exporter_menu();

$guimessages = 1;

Tk::MainLoop();



# ----------------------------------------------------------------------
# Functions of package main
# ----------------------------------------------------------------------


# ----------------------------------------------------------------------
# Communication with other instances of babygimp (hack)
# ----------------------------------------------------------------------

sub init()
{
    # check if another instance of babygimp is already running
    my ($progname, $progdir, $progext) = fileparse($0, '\..*');
    $progname = "$progname$progext";
    my @pids = `ps --User $ENV{USER} | grep $progname`;
    if (scalar(@pids) > 1) {
	if (scalar(@ARGV) != 1) { exit 1; }
	system "mkfifo $fifoname";
	$? and die "could not create named pipe $fifoname\n";
	open FIFO, "> $fifoname" or 
	    die "could not open named pipe $fifoname for writing\n";
	print FIFO "$ARGV[0]\n";
	close FIFO;
	exit 0;
    }
    
    # no other instance of babygimp running, so proceed
    
    foreach my $dir ($babydir, $plugindir, $tmpdir, $palette_dir) {
	if (!-d $dir) {
	    mkdir $dir, 0700 or die "could not create directory $dir\n";
	}
    }

    read_config();

    # load importers/exporters
    load_convertors($importerfile, \%importers);
    load_convertors($exporterfile, \%exporters);
}

# ----------------------------------------------------------------------

sub read_fifo()
{
    if (-r $fifoname) {
	open FIFO, "< $fifoname";
	my $line = <FIFO>;
	close FIFO;
	system "rm $fifoname";
	$? and die "could not delete named pipe $fifoname\n";
	if ($line) {
	    chomp($line);
	    clipboard_load_file($line);
	}
    }
    $mw->after(300, \&read_fifo);
}


# ----------------------------------------------------------------------
# Wrapper for critical operations 
# ----------------------------------------------------------------------

# wrapper for critical function calls (Tk::Photo is buggy)
# catches hangups and crashes
sub try($)
{
    my $func = shift;

    my $success = 1;
    eval {   # this eval catches hangups
	local $SIG{ALRM} = sub { die "alarm\n"; };
	alarm $preferences{timeout} + 0;
	eval{ &$func(); };  # this eval catches crashes
	if ($@) { $success = 0; }
	alarm 0 ;
    };
    if ($@) {
	die unless $@ eq "alarm\n";
    }
    return $success;
}

# ----------------------------------------------------------------------

# wrapper for shell commands 
sub try_shell_command($)
{
    my $shellcommand = shift;

    my $success = 1;
    eval {   
	local $SIG{ALRM} = sub { die "alarm\n"; };
	alarm $preferences{timeout} + 0;
	system $shellcommand;
	if ($?) { $success = 0; }
	alarm 0 ;
    };
    if ($@) {
	die unless $@ eq "alarm\n";
    }
    $success or message("Shell command\n$shellcommand\nfailed.");
    return $success;
}

# ----------------------------------------------------------------------
# Preferences
# ----------------------------------------------------------------------

sub read_config()
{
    -f $configfile or return;
    
    # Important: use preferences in config file only if the config file 
    # is "safe", i.e. only user and root can write
    # (the config contains the browser shell command!)
    if ( ! is_safe($configfile) ) {
	print STDERR "config file $configfile has unsafe permissions.\n";
	return;
    }

    open FH, $configfile or die "could not open $configfile\n";
    my @valid_options = keys %preferences;
    while (my $line = <FH>) {
	chomp $line;
	$line =~ s/^\s+//;  #remove leading and trailing blanks
	$line =~ s/\s+$//;
	if (length($line) == 0 || substr($line,0,1) eq "#") {  next; }
	# now the line should have the form option = value"
	my @words = split('=', $line);
	scalar(@words) == 2 or 
	    die "config file $configfile corrupted at line $.\n";
	my ($option, $value) = @words;
	$option =~ s/^\s+//;  #remove leading and trailing blanks
	$option =~ s/\s+$//;
	$value =~ s/^\s+//;  
	$value =~ s/\s+$//;
	# check whether the option is valid
	grep { $_ eq $option } @valid_options or die
	    "unknown option $option in configfile $configfile at line $.\n";
	$preferences{$option} = $value;
    }
    close FH;
}

# ----------------------------------------------------------------------

# check whether config file is safe (i.e. only root and user can write)
# perhaps not sufficient on systems where users can ``donate'' files 
sub is_safe($)
{
    my $path = shift;
    my $info = stat($path);
    if (! $info) { return 0; }
    if ($info->mode & 022) {
	return 0; 
    } else {
	return 1;
    }
}

# ----------------------------------------------------------------------

sub write_config()
{
    if (!-d $babydir) {
	if (! mkdir $babydir, 0700) {
	    message("Could not create directory $babydir");
	    return;
	}
    }
    my $fh = new FileHandle;
    if (! open($fh, "> $configfile")) {
	message("Could not write file $configfile");
	return;
    }
    foreach my $option (keys %preferences) {
	print $fh "$option = $preferences{$option}\n";
    }
    close $fh;
}

# ----------------------------------------------------------------------

sub preferences_dialog()
{
    my $DB = $mw->DialogBox(-title => 'Babygimp Preferences',
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);
    my %new_prefs = %preferences;
    
    $DB->Label(-text => "Help Browser: ")
	->grid(-row => 0, -column => 0, -sticky => 'w', -columnspan => 2);
    $DB->Entry(-textvariable => \$new_prefs{helpbrowser})
	->grid(-row => 0, -column => 2, -sticky => 'w');

    $DB->Label(-text => "Documentation directory: ")
	->grid(-row => 1, -column => 0, -sticky => 'w', -columnspan => 2);
    $DB->Entry(-textvariable => \$new_prefs{docdir},
	       -width => 30)
	->grid(-row => 1, -column => 2, -sticky => 'w');

    $DB->Checkbutton(-text => "Create backups", 
		     -variable => \$new_prefs{autobackups})
	->grid(-row => 2, -column => 0, -sticky => 'w');
    $DB->Checkbutton(-text => "Query overwrite", 
		     -variable => \$new_prefs{queryoverwrite})
	->grid(-row => 3, -column => 0, -sticky => 'w');
    $DB->Checkbutton(-text => "Query palette saving", 
		     -variable => \$new_prefs{querypalettesave})
	->grid(-row => 4, -column => 0, -sticky => 'w');

    $DB->Label(-text => 'Timeout (secs):')
	->grid(-row => 5, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$new_prefs{timeout}, -width => 3)
	->grid(-row => 5, -column => 1, -sticky => 'w');
    $DB->Scale(-orient => 'horizontal', -showvalue => 0,
	       -from => 2, -to => 10, -resolution => 1, -length => 200,
	       -variable => \$new_prefs{timeout})
	->grid(-row => 5, -column => 2, -sticky => 'w');

    $DB->Label(-text => 'Undo buffer size:')
	->grid(-row => 6, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$new_prefs{maxundo}, -width => 3)
	->grid(-row => 6, -column => 1, -sticky => 'w');
    $DB->Scale(-orient => 'horizontal', -showvalue => 0,
	       -from => 1, -to => 20, -resolution => 1, -length => 200,
	       -variable => \$new_prefs{maxundo})
	->grid(-row => 6, -column => 2, -sticky => 'w');

    $DB->Label(-text => 'Default width:')
	->grid(-row => 7, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$new_prefs{defaultwidth}, -width => 3)
	->grid(-row => 7, -column => 1, -sticky => 'w');
    $DB->Scale(-orient => 'horizontal', -showvalue => 0,
	       -from => 1, -to => 100, -resolution => 1, -length => 200,
	       -variable => \$new_prefs{defaultwidth})
	->grid(-row => 7, -column => 2, -sticky => 'w');
    $DB->Label(-text => 'Default height:')
	->grid(-row => 8, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$new_prefs{defaultheight}, -width => 3)
	->grid(-row => 8, -column => 1, -sticky => 'w');
    $DB->Scale(-orient => 'horizontal', -showvalue => 0,
	       -from => 1, -to => 100, -resolution => 1, -length => 200,
	       -variable => \$new_prefs{defaultheight})
	->grid(-row => 8, -column => 2, -sticky => 'w');


    my $choice = $DB->Show();
    $choice eq 'Ok' or return;
    %preferences = %new_prefs;
    write_config();
}

# ----------------------------------------------------------------------
# Exporters/Importers
# ----------------------------------------------------------------------

sub load_convertors($$)
{
    my ($filename, $hashref) = @_;
    
    -f $filename or return;

    is_safe($filename) or return 
      message("file $filename has unsafe permissions, ignored.\n");
    
    open FH, $filename or return 
      message("could not read $filename.\n");

    while (my $line = <FH>) {
	chomp $line;
        # remove leading and trailing blanks
	$line =~ s/^\s+//;  
	$line =~ s/\s+$//;
	# remove comments
	if (length($line) == 0 || substr($line,0,1) eq "#") {  next; }
	# now the line should have the form extension: shell command, 
	# where ``*'' matches all extensions, e.g.
	# ``GIF: giftopnm | ppmtoxpm'' or ``*: convert - xpm:-''
	my @words = split(' ', $line);
	scalar (@words) >= 2 or return 
	  message("file $filename corrpupted at line $., skipping\n");
	my $extension = shift @words;
	my $shellcommand = join(' ', @words);
	$extension =~ m/^[A-Z]+|\*:$/ or return 
	  message("file $filename corrpupted at line $., skipping\n");
	$extension = substr($extension, 0, -1);
	$hashref->{$extension} = $shellcommand;
    }
    return scalar(keys %$hashref);
}

# ----------------------------------------------------------------------

sub edit_convertor($$$)
{
    my ($extref, $cmdref, $type) = @_;
    
    my $newext = $$extref;
    my $newcmd = $$cmdref;

    my $DB = $mw->DialogBox(-title => "Edit $type",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Label(-text => 'File extension:')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    $DB->Entry(-textvariable => \$newext, -width => 20)
	->grid(-row => 0, -column => 1, -sticky => 'w');
    $DB->Button(-text => 'Help', -command => [\&help, 'import_export.html'],
		-padx => 0, -pady => 0, -width => 10)
	->grid(-row => 0, -column => 2, -sticky => 'e');
    $DB->Label(-text => 'Shell command:')
	->grid(-row => 1, -column => 0, -sticky => 'w');
    $DB->Entry(-textvariable => \$newcmd, -width => 60)
	->grid(-row => 1, -column => 1, -columnspan => 2, -sticky => 'w');
    
    $DB->Show() eq 'Ok' or return 0;
    
    # remove leading and trailing blanks
    $newext =~ s/^\s+//;  
    $newext =~ s/\s+$//;
    $newext = uc($newext);
    $newcmd =~ s/^\s+//;  
    $newcmd =~ s/\s+$//;

    # basic checks
    $newext =~ m/^([A-Za-z]+)|(\*)$/ or return 
	message("Invalid extension \"$newext\".");
    $newcmd or return 
	message("You did not specify a shell command.");
    
    $$extref = $newext;
    $$cmdref = $newcmd;
    return 1;
}

# ----------------------------------------------------------------------

sub save_convertors($$)
{
    my ($hashref, $filename) = @_;

    info "Saving changes to file $filename ... ";
    
    my $fh = new FileHandle;
    open ($fh, "> $filename");
    if (! $fh) {
      message("Could not write file $configfile");
	info("aborted\n");
	return 0;
    }
    foreach (keys %$hashref) {
	print $fh "$_: $hashref->{$_}\n";
    }
    close $fh;
    info("done\n");
    return 1;
}

# ----------------------------------------------------------------------

sub build_importer_menu()
{
    my $menu = $filemenu->Menu(-tearoff => 0);
    $menu->add('command', -label => 'Create New Importer',
	       -command => \&create_importer);
    foreach my $ext (keys %importers) {
	$menu->cascade(-label => $ext);
	my $submenu = $filemenu
	    ->Menu(-tearoff => 0,
		   -menuitems => 
		   [['command' => 'Edit', -command => [\&edit_importer, $ext]],
		    ['command' => 'Delete', 
		      -command => [\&delete_importer, $ext]]]);
	$menu->entryconfigure($ext, -menu => $submenu);
    }
    $filemenu->entryconfigure('Importers', -menu => $menu);
}


# ----------------------------------------------------------------------

sub create_importer()
{
    my $extension = '';
    my $shellcmd = '';
    
    edit_convertor(\$extension, \$shellcmd, 'Importer') or return;
    
    $importers{$extension} = $shellcmd;
    save_convertors(\%importers, $importerfile);
    build_importer_menu();
}

# ----------------------------------------------------------------------

sub delete_importer($)
{
    my $extension = shift;
    delete($importers{$extension});
    save_convertors(\%importers, $importerfile);
    build_importer_menu();
}


# ----------------------------------------------------------------------

sub edit_importer($)
{
    my $extension = shift;

    my $newext = $extension;
    my $newcmd = $importers{$extension};

    edit_convertor(\$newext, \$newcmd, 'Importer') or return;

    if ($newext ne $extension) { delete($importers{$extension}); }
    $importers{$newext} = $newcmd;
    save_convertors(\%importers, $importerfile);
    build_importer_menu();
}

# ----------------------------------------------------------------------

sub build_exporter_menu()
{
    my $menu = $filemenu->Menu(-tearoff => 0);
    $menu->add('command', -label => 'Create New Exporter',
	       -command => \&create_exporter);
    foreach my $ext (keys %exporters) {
	$menu->cascade(-label => $ext);
	my $submenu = $filemenu
	    ->Menu(-tearoff => 0,
		   -menuitems => 
		   [['command' => 'Edit', -command => [\&edit_exporter, $ext]],
		    ['command' => 'Delete', 
		      -command => [\&delete_exporter, $ext]]]);
	$menu->entryconfigure($ext, -menu => $submenu);
    }
    $filemenu->entryconfigure('Exporters', -menu => $menu);
}

# ----------------------------------------------------------------------

sub create_exporter()
{
    my ($extension, $shellcmd);
    
    edit_convertor(\$extension, \$shellcmd, 'Exporter') or return;
    
    $exporters{$extension} = $shellcmd;
    save_convertors(\%exporters, $exporterfile);
    build_exporter_menu();
}

# ----------------------------------------------------------------------

sub delete_exporter($)
{
    my $extension = shift;
    delete($exporters{$extension});
    save_convertors(\%exporters, $exporterfile);
    build_exporter_menu();
}


# ----------------------------------------------------------------------

sub edit_exporter($)
{
    my $extension = shift;

    my $newext = $extension;
    my $newcmd = $exporters{$extension};

    edit_convertor(\$newext, \$newcmd, 'Exporter') or return;
    
    if ($newext ne $extension) { delete($exporters{$extension}); }
    $exporters{$newext} = $newcmd;
    save_convertors(\%exporters, $exporterfile);
    build_exporter_menu();
}


# ----------------------------------------------------------------------
# Dialogs
# ----------------------------------------------------------------------

sub load_dialog()
{
    if ($changes) {
	my $DB = $mw->DialogBox(-title => "Question",
				-buttons => ['Ok', 'Cancel']);
	$DB->resizable(0,0);

	$DB->Label(-text => 
		   "Image $filename has been changed.\n".
		   "Discard changes and load new file?",
		   -justify => "left")->pack();
	my $choice = $DB->Show();
	$choice ne "Ok" and return;
    }
    my $fname = $FileBrowser->Show($filename);
    $fname or return;
    
    load_image($fname);
}

# ----------------------------------------------------------------------

sub new_dialog()
{
    if ($changes) {
	my $DB = $mw->DialogBox(-title => "Question",
				-buttons => ['Ok', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-text => 
		   "Image $filename has been changed.\n".
		   "Discard changes and load new file?",
		   -justify => "left")->pack();
	my $choice = $DB->Show();
	$choice ne "Ok" and return;
    }
    my $DB = $mw->DialogBox(-title => "Create new image",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);
    my $new_width = $preferences{defaultwidth};
    my $new_height = $preferences{defaultheight};
    my $maxwidth = max(2 * $new_width, 100);
    my $maxheight = max(2 * $new_height, 100);
    $DB->Scale(-orient => "horizontal", -label => "Width",
	       -from => 1, -to => $maxwidth, -length => 300,
	       -variable => \$new_width)
	->pack();
    $DB->Scale(-orient => "horizontal", -label => "Height",
	       -from => 1, -to => $maxheight, -length => 300,
	       -variable => \$new_height)
	->pack();
    $DB->Show() eq "Ok" or return;
    new_image($new_width, $new_height, "untitled.xpm");
}
    

# ----------------------------------------------------------------------

sub quit_dialog()
{
    if ($changes) {
	my $DB = $mw->DialogBox(-title => "Question",
				-buttons => 
				['Save and Exit', 'Exit', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-text => 
		   "Image $filename has been changed.\n".
		   "Save changes before exiting?",
		   -justify => "left")->pack();
	my $choice = $DB->Show();
	if ($choice eq 'Save and Exit') { 
	    save_dialog(); 
	} elsif ($choice eq 'Cancel') { 
	    return; 
	}
    } 

    if ($palette_changed and $preferences{querypalettesave}) {
	my $DB = $mw->DialogBox(-title => "Question",
				-buttons => 
				['Save and Exit', 'Exit', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-text => 
		   "Palette $palette_name has been changed.\n".
		   "Save changes before exiting?",
		   -justify => "left")->pack();
	my $choice = $DB->Show();
	if ($choice eq 'Save and Exit') { 
	    save_palette_dialog(); 
	} elsif ($choice eq 'Cancel') { 
	    return; 
	}
    } 


  Tk::exit;
}

# ----------------------------------------------------------------------

sub save_dialog() {
    my $newname = $FileBrowser->Show($filename);
    
    $newname and  save_image($newname);
}

# ----------------------------------------------------------------------

sub rambo_save()
{
    if ($filename =~ m/untitled\.xpm/) {
	save_dialog();
    } else {
	save_image($filename);
    }
}

# ----------------------------------------------------------------------

sub save_image($)
{
    my $fname = shift || $filename;  # may be called without arg
    
    # Query overwrite and make backup
    if ($preferences{queryoverwrite} and $fname ne $filename and -f $fname) {
	my $DB = $mw->DialogBox(-title => "Question",
				 -buttons => ['Overwrite', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-text => "File $fname exists. Overwrite?")->pack();
	$DB->Show() ne "Overwrite" and return;
    }
    info("Saving image to $fname ... ");
    if ($preferences{autobackups} and -f $fname) {
	system("cp \"$fname\" \"$fname.bak\"");
	if ($?) {
	    my $DB = $mw->DialogBox(-title => 'Question',
				     -buttons => ['Proceed', 'Cancel']);
	    $DB->resizable(0,0);
	    $DB->Label(-text => 
			"Could not create backup file $fname.bak. Proceed?")
		->pack();
	    $DB->Show() ne "Proceed" and return;
	}
    }
    
    # Finally save the image
    save_buffer_to_image($fname, \@pixelmatrix) or return;
    clear_undo();
    $filename = $fname;
    display_info();
    info("done\n");
}

# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
# Loading and saving
# ----------------------------------------------------------------------

sub save_buffer_to_xpm($$)
{
    my ($fname, $buf_ref) = @_;

    if (!sysopen (FH, $fname, O_CREAT|O_WRONLY|O_TRUNC)) {
      message("Could not open file $fname");
	return 0;
    }

    my ($bufwidth, $bufheight) = dimensions($buf_ref);

    # create new image object in order to use the photo->data() method
    my $photo = $mw->Photo(-width => $bufwidth, -height => $bufheight);
    for (my $i = 0; $i < $bufheight; $i++) {
  	for (my $j = 0; $j < $bufwidth; $j++) {
	    if ($buf_ref->[$i][$j]) {
		$photo->put($buf_ref->[$i][$j], -to => ($j, $i));
	    }
	}
    }

    my $success = try( sub { print FH  $photo->data(-format => "xpm"); });
    if ( ! $success) {
	close FH;
	message("Could not save the image");
	return 0;
    }

    close FH;
    return 1;
}

# ----------------------------------------------------------------------

sub load_xpm_to_buffer($)
{
    my $fname = shift;

    # try to load image
    if (!sysopen(FH, $fname, O_RDONLY)) {
      message("Could not load image $fname");
	info("aborted\n");
	return 0;
    }
    my @data = <FH>;
    my $image;
    my $result 
	= try(sub { $image = $mw->Photo(-data => join('', @data)); });
    if (! $result) {
	message("Could not load image $fname");
	info("aborted\n");
	return 0;
    }
    if (!$image) {
	message("Could not load image $fname");
	info("aborted\n");
	return 0;
    }
    
    # write image to buffer
    my @matrix1 = parse_image_data($image->data(-background => "white"));
    my @matrix2 = parse_image_data($image->data(-background => "black"));
    
    for (my $i = 0; $i < $image->height(); $i++) {
  	for (my $j = 0; $j < $image->width(); $j++) {
	    if ($matrix1[$i][$j] ne $matrix2[$i][$j]) {
		$matrix1[$i][$j] = "";
	    }
	}
    }

    if (!@matrix1) {
	message("Could not load image $fname");
	  return info "aborted\n";
      }
    return \@matrix1;
}

# ----------------------------------------------------------------------

sub extension($)
{
    my $filename = shift;
    return (fileparse($filename, '\..*'))[2];
}

# ----------------------------------------------------------------------

sub load_image_to_buffer($)
{
    my $filename = shift;
    
    my $ext = uc(substr(extension($filename),1));
    
    $ext eq 'XPM'  and return load_xpm_to_buffer($filename);
    
    # no xpm: try to apply importer
    
    $importers{$ext} or $importers{'*'} or return 
      message("No importer specified for image type $ext.");

    $importers{$ext} or $ext = '*';

    # try to create temporary xpm
    info("applying importer ($ext) ... ");
    my $tmpfile = "$tmpdir/importer_output.xpm";
    try_shell_command("cat \"$filename\" | $importers{$ext} > $tmpfile")
	or return 0;

    return load_xpm_to_buffer($tmpfile);
}

# ----------------------------------------------------------------------

sub save_buffer_to_image($$)
{
    my ($filename, $buf_ref) = @_;
    
    my $ext = uc(substr(extension($filename),1));
    
    $ext eq 'XPM'  and return save_buffer_to_xpm($filename, $buf_ref);
    
    # no xpm: so try to apply exporter
    $exporters{$ext} or $exporters{'*'} or return 
      message("No exporter specified for image type $ext.");

    $exporters{$ext} or $ext = '*';

    # try to create temporary xpm
    my $tmpfile = "$tmpdir/exporter_input.xpm";
    save_buffer_to_xpm($tmpfile, $buf_ref) or return 0;
    info("applying exporter ($ext) ... ");
    return try_shell_command("cat $tmpfile | $exporters{$ext} > \"$filename\"");
}

# ----------------------------------------------------------------------
# Info
# ----------------------------------------------------------------------

sub info(@)
{
    if (! $guimessages) {
	print STDERR @_;
	return 0;
    }
    foreach (@_) { $infotext .= $_; }
    my $newline = substr($infotext, length($infotext)-1) eq "\n";
    my @lines = split("\n", $infotext);
    if (scalar(@lines) > 2) {
	splice(@lines, 0, scalar(@lines)-2);
    }
    $infotext = join("\n", @lines);
    if ($newline) { $infotext = $infotext . "\n"; }
    $infolabel->grab();
    $infolabel->configure(-text => $infotext);
    $infolabel->update();
    $infolabel->grabRelease();
    return 0; # usefull in order to be able to write 
              # $condition or return info("aborted\n");
}


# ----------------------------------------------------------------------

sub message(@)
{
    my $text = join("\n", @_);
    local $Text::Wrap::columns = 59;
    $text = wrap("", "", $text);
    if (! $guimessages) {
	print STDERR $text;
	return 0;
    }
    
    my $DB = $mw->DialogBox(-title => 'Message',
  			    -buttons => ['Close']);
    $DB->resizable(0,0);
    $DB->Label(-text => $text, -justify => 'left')->pack();
    $DB->Show();
    return 0;
}


# ----------------------------------------------------------------------
# Loading and saving the image
# ----------------------------------------------------------------------

# try to load image (via Tk::Photo) and set the global Variables
# @pixelmatrix, $height, $width, $zoomfac
# returns 1 on success, 0 otherwise
sub load_image($)
{
    my $fname = FileChooser::fullpath(shift);

    info("Loading file $fname ... ");
    
    my $bufref = load_image_to_buffer($fname) or return info("aborted\n");
    @pixelmatrix = @$bufref;
    ($width, $height) = dimensions(\@pixelmatrix);
    
    $zoomfac = propose_zoomfac($width, $height);
    $filename = $fname;
    display_info();
    draw_image();
    clear_undo();
    
    info("done\n");
    return 1;
}

# ----------------------------------------------------------------------

sub new_image($$$) 
{
    ($width, $height, $filename) = @_;
    $filename = FileChooser::fullpath($filename);
    if (@pixelmatrix) { @pixelmatrix = (); }
    for (my $i = 0; $i < $height; $i++) {
  	for (my $j = 0; $j < $width; $j++) {
	    $pixelmatrix[$i][$j] =  "";
	}
    }
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    clear_undo();
    draw_image();
}

# ----------------------------------------------------------------------
# Drawing a new image
# ----------------------------------------------------------------------

sub draw_preview()
{
    $previewimage = $previewcanvas->Photo(-width => $width,
					  -height => $height);
    for (my $i = 0; $i < $height; $i++) {
  	for (my $j = 0; $j < $width; $j++) {
	    if ($pixelmatrix[$i][$j]) {
		$previewimage->put($pixelmatrix[$i][$j], -to => ($j, $i));
	    }
	}
    }
    $previewcanvas->configure(-width => $width+1, -height => $height+1,
			      -bg => $preview_bg);
    $previewcanvas->addtag("all", "all");
    $previewcanvas->delete("all");

    $previewcanvas->createImage(1, 1, -image => $previewimage,
				-anchor => "nw");
}

# ----------------------------------------------------------------------

sub display_info()
{
    my $title = "$filename ($width".'x'."$height, 1:$zoomfac)";
    $mw->configure(-title => $title);
    local $Text::Wrap::columns = 40;
    $fileinfo->configure(-text => wrap('', '', $filename));
    $sizeinfo->configure(-text => $width.'x'."$height, 1:$zoomfac");
}

# ----------------------------------------------------------------------

sub draw_image()
{
    # preview
    draw_preview();
    # drawing canvas
    @canvaspixel = ();
    $drawingcanvas->addtag("all", "all");
    $drawingcanvas->delete("all");
    $drawingcanvas
	->configure(-width =>  min($zoomfac * $width, $max_canvas_width),
		    -height => min($zoomfac * $height, $max_canvas_height));
    $drawingcanvas->configure(-scrollregion => [0, 0, 
						$zoomfac * $width,
						$zoomfac * $height]);
    for (my $i = 0; $i < $height; $i++) {
  	for (my $j = 0; $j < $width; $j++) {
	    my $x1 = $j * $zoomfac;
	    my $y1 = $i * $zoomfac;
	    my $x2 = $x1 + $zoomfac;
	    my $y2 = $y1 + $zoomfac;
	    if ($pixelmatrix[$i][$j]) {
		$canvaspixel[$i][$j] =
		    $drawingcanvas
			->createRectangle($x1, $y1, $x2, $y2, -width => 0,
					  -fill => $pixelmatrix[$i][$j]);
	    } else {
		$canvaspixel[$i][$j] =
		    $drawingcanvas
			->createRectangle($x1, $y1, $x2, $y2, -width => 0,
					  -fill => "black", 
					  -stipple => "gray50");
	    }
	}
    }
}

# ----------------------------------------------------------------------

sub redraw_canvas()
{
    for (my $i = 0; $i < $height; $i++) {
  	for (my $j = 0; $j < $width; $j++) {
	    my $x1 = $j * $zoomfac;
	    my $y1 = $i * $zoomfac;
	    my $x2 = $x1 + $zoomfac;
	    my $y2 = $y1 + $zoomfac;
	    if ($pixelmatrix[$i][$j]) {
		$canvaspixel[$i][$j] =
		    $drawingcanvas
			->createRectangle($x1, $y1, $x2, $y2, -width => 0,
					  -fill => $pixelmatrix[$i][$j]);
	    } else {
		$canvaspixel[$i][$j] =
		    $drawingcanvas
			->createRectangle($x1, $y1, $x2, $y2, -width => 0,
					  -fill => "black", 
					  -stipple => "gray50");
	    }
	}
    }
}

# ----------------------------------------------------------------------
# Drawing functions
# ----------------------------------------------------------------------

sub set_transparency_weights()
{
    $fg_weight = 0.01 * $opacity;
    $bg_weight = 1 - $fg_weight;
}

# ----------------------------------------------------------------------

# ignore transparency
sub draw_forced($$$)
{
    my ($x, $y, $RGB) = @_;
    $RGB or die;
    $pixelmatrix[$y][$x] = $RGB;
    $drawingcanvas->itemconfigure($canvaspixel[$y][$x],
				  -fill => $RGB, -stipple => "");
    $previewimage->put($RGB, -to => ($x, $y));
}

# ----------------------------------------------------------------------

sub draw_normal($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    if ($fg_weight == 1.0) {
	draw_forced($x, $y, RGBtoHex($r, $g, $b));
	return;
    }
    my $RGB = $pixelmatrix[$y][$x];
    if ($RGB) {
	my ($r_old, $g_old, $b_old) = HextoRGB($RGB);
	$r = int($fg_weight * $r + $bg_weight * $r_old);
	$g = int($fg_weight * $g + $bg_weight * $g_old);
	$b = int($fg_weight * $b + $bg_weight * $b_old);
    }
    $RGB = RGBtoHex($r,$g,$b);
    $pixelmatrix[$y][$x] = $RGB;
    $drawingcanvas->itemconfigure($canvaspixel[$y][$x],
				  -fill => $RGB, -stipple => "");
    $previewimage->put($RGB, -to => ($x, $y));
}

# ----------------------------------------------------------------------

sub draw_bg($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    $pixelmatrix[$y][$x] and return;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    draw_forced($x,$y, RGBtoHex($r,$g,$b));
}

# ----------------------------------------------------------------------

sub draw_fg($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    $pixelmatrix[$y][$x] or return;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    draw_normal($x,$y, $r,$g,$b);
}

# ----------------------------------------------------------------------

sub draw_color($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    my $RGB = $pixelmatrix[$y][$x];
    $RGB or return;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    my ($h,$s,$v) = RGBtoHSV($r,$g,$b);
    my ($r_old, $g_old, $b_old) = HextoRGB($RGB);
    my ($h_old, $s_old, $v_old) = RGBtoHSV($r_old, $g_old, $b_old);
    ($r,$g,$b) = HSVtoRGB($h, $s, $v_old);
    ($r, $g, $b) = ( int($fg_weight * $r + $bg_weight * $r_old),
		     int($fg_weight * $g + $bg_weight * $g_old),
		     int($fg_weight * $b + $bg_weight * $b_old));
    draw_forced($x,$y, RGBtoHex($r,$g,$b));
}



# ----------------------------------------------------------------------

sub draw_value($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    my $RGB = $pixelmatrix[$y][$x];
    $RGB or return;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    my ($h,$s,$v) = RGBtoHSV($r,$g,$b);
    my ($r_old, $g_old, $b_old) = HextoRGB($RGB);
    my ($h_old, $s_old, $v_old) = RGBtoHSV($r_old, $g_old, $b_old);
    ($r,$g,$b) = HSVtoRGB($h_old, $s_old, $v);
    ($r, $g, $b) = ( int($fg_weight * $r + $bg_weight * $r_old),
		     int($fg_weight * $g + $bg_weight * $g_old),
		     int($fg_weight * $b + $bg_weight * $b_old));
    draw_forced($x,$y, RGBtoHex($r,$g,$b));
}

# ----------------------------------------------------------------------

sub draw_saturation($$;$$$)
{
    my ($x, $y, $r, $g, $b) = @_;
    my $RGB = $pixelmatrix[$y][$x];
    $RGB or return;
    defined($r) or $r = $fg_r;
    defined($g) or $g = $fg_g;
    defined($b) or $b = $fg_b;
    my ($h,$s,$v) = RGBtoHSV($r,$g,$b);
    my ($r_old, $g_old, $b_old) = HextoRGB($RGB);
    my ($h_old, $s_old, $v_old) = RGBtoHSV($r_old, $g_old, $b_old);
    ($r,$g,$b) = HSVtoRGB($h_old, $s, $v_old);
    ($r, $g, $b) = ( int($fg_weight * $r + $bg_weight * $r_old),
		     int($fg_weight * $g + $bg_weight * $g_old),
		     int($fg_weight * $b + $bg_weight * $b_old));
    draw_forced($x,$y, RGBtoHex($r,$g,$b));
}


# ----------------------------------------------------------------------

sub draw_erase($$;$$$)
{
    my ($x, $y, $dummy1, $dummy2, $dummy3) = @_;
    $pixelmatrix[$y][$x] = '';
    $drawingcanvas->itemconfigure($canvaspixel[$y][$x],
				  -fill => "black", -stipple => "gray50");
    $previewimage->put($preview_bg, -to => ($x, $y));
}

# ----------------------------------------------------------------------
# Drawing figures
# ----------------------------------------------------------------------

sub draw_line(@)
{
    my ($x0, $y0, $x1, $y1) = @_;

    
    if ($x0 == $x1 and $y1 == $y0) {
	&$drawingfunc($x0, $y0);
	return;
    }

    if (abs($x1-$x0) >= abs($y1-$y0)) {
	if ($x1 < $x0) { ($x0, $x1, $y0, $y1) = ($x1, $x0, $y1, $y0); }
	my $fac = ($y1-$y0) / ($x1-$x0);
	for (my $x = $x0; $x <= $x1; $x++) {
	    &$drawingfunc($x, int($y0 + $fac * ($x-$x0) + 0.5));
	}
    } else {
	if ($y1 < $y0) { ($x0, $x1, $y0, $y1) = ($x1, $x0, $y1, $y0); }
	my $fac = ($x1-$x0) / ($y1 - $y0); 
	for (my $y = $y0; $y <= $y1; $y++) {
	    &$drawingfunc(int($x0 + $fac * ($y-$y0) + 0.5), $y);
	}
    }
}

# ----------------------------------------------------------------------

sub draw_rectangle($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    my ($xmin,$xmax) = $x0 < $x1 ? ($x0,$x1) : ($x1,$x0);
    my ($ymin,$ymax) = $y0 < $y1 ? ($y0,$y1) : ($y1,$y0);
    for (my $x = $xmin; $x <= $xmax; $x++) {
	for (my $y = $ymin; $y <= $ymax; $y++) {
	    &$drawingfunc($x, $y);
	}
    }
}

# ----------------------------------------------------------------------

sub draw_ellipse($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    
    if ($x0 == $x1 and $y0 == $y1) { &$drawingfunc($x0,$y0); return; }

    if ($x0 > $x1) { ($x0, $x1) = ($x1, $x0); }
    if ($y0 > $y1) { ($y0, $y1) = ($y1, $y0); }

    my $a = 0.5 * ($x1 - $x0);
    my $b = 0.5 * ($y1 - $y0);
    my $a2 = $a*$a;
    my $b2 = $b * $b;
    my $a2b2 = $a2 * $b2;
    my $xmid = ($x0 + $x1) / 2;
    my $ixmid = int($xmid);
    my $ixmid2 = ($x0 + $x1) % 2 ? $ixmid+1 : $ixmid;
    my $ymid = ($y0 + $y1) / 2;
    my $iymid = int($ymid);
    my $iymid2 = ($y0 + $y1) % 2 ? $iymid+1 : $iymid;
    my ($x, $y, $xb, $yb);
    my ($d1, $d2, $d3);
    my $u;

    if ($a < $b) {
	($x, $y) = ($x0, $iymid);
	$xb = $ixmid2 + ($ixmid - $x);
	$yb = $iymid2 + ($iymid - $y);
	&$drawingfunc($x, $y);
	&$drawingfunc($xb, $y);
	&$drawingfunc($x, $yb);
	&$drawingfunc($xb, $yb);
	do {
	    $d1 = abs($b2*($x+1-$xmid)**2 + $a2*($y-$ymid)**2 - $a2b2);
	    $d2 = abs($b2*($x-$xmid)**2 + $a2*($y-1-$ymid)**2 - $a2b2);
	    $d3 = abs($b2*($x+1-$xmid)**2 + $a2*($y-1-$ymid)**2 - $a2b2);
	    if ($d1 <= $d2 and $d1 <= $d3) {
		$x++;
	    } elsif ($d2 <= $d3) {
		$y--;
	    } else {
		$x++;
		$y--;
	    }
	    $xb = $ixmid2 + ($ixmid - $x);
	    $yb = $iymid2 + ($iymid - $y);
	    &$drawingfunc($x, $y);
	    &$drawingfunc($xb, $y);
	    &$drawingfunc($x, $yb);
	    &$drawingfunc($xb, $yb);
	} while ($x < $ixmid or $y > $y1);
    } else {
	($x, $y) = ($ixmid, $y0);
	$xb = $ixmid2 + ($ixmid - $x);
	$yb = $iymid2 + ($iymid - $y);
	&$drawingfunc($x, $y);
	&$drawingfunc($xb, $y);
	&$drawingfunc($x, $yb);
	&$drawingfunc($xb, $yb);
	do {
	    $d1 = abs($b2*($x-$xmid)**2 + $a2*($y+1-$ymid)**2 - $a2b2);
	    $d2 = abs($b2*($x-1-$xmid)**2 + $a2*($y-$ymid)**2 - $a2b2);
	    $d3 = abs($b2*($x-1-$xmid)**2 + $a2*($y+1-$ymid)**2 - $a2b2);
	    if ($d1 <= $d2 and $d1 <= $d3) {
		$y++;
	    } elsif ($d2 <= $d3) {
		$x--;
	    } else {
		$x--;
		$y++;
	    }
	    $xb = $ixmid2 + ($ixmid - $x);
	    $yb = $iymid2 + ($iymid - $y);
	    &$drawingfunc($x, $y);
	    &$drawingfunc($xb, $y);
	    &$drawingfunc($x, $yb);
	    &$drawingfunc($xb, $yb);
	} while ($y < $iymid or $x > $x1);
    }
}

# ----------------------------------------------------------------------

sub draw_filled_ellipse($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    
    if ($x0 == $x1 or $y0 == $y1) { 
	draw_line($x0, $y0, $x1, $y1);
	return;
    }

    if ($x0 > $x1) { ($x0, $x1) = ($x1, $x0); }
    if ($y0 > $y1) { ($y0, $y1) = ($y1, $y0); }

    my $xmid = 0.5 * ($x0 + $x1);
    my $ymid = 0.5 * ($y0 + $y1);
    my $a = 1 / ($x1 - $xmid);
    $a = $a*$a;
    my $b = 1 / ($y1 - $ymid);
    $b = $b*$b;

    for (my $x = $x0; $x <= $x1; $x++) {
	my $dx = $x - $xmid;
	$dx = $dx * $dx * $a;
	for (my $y = $y0; $y <= $y1; $y++) {
	    my $dy = $y - $ymid;
	    $dy = $dy * $dy * $b;
	    if ($dx + $dy <= 1.05) { &$drawingfunc($x, $y); }
	}
    }
}


# ----------------------------------------------------------------------
# Cutting and pasting
# ----------------------------------------------------------------------

sub save_to_buffer($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    my ($xmin,$xmax) = $x0 < $x1 ? ($x0,$x1) : ($x1,$x0);
    my ($ymin,$ymax) = $y0 < $y1 ? ($y0,$y1) : ($y1,$y0);
    my @buffer = ();
    for (my $x = $xmin; $x <= $xmax; $x++) {
	for (my $y = $ymin; $y <= $ymax; $y++) {
	    $buffer[$y-$ymin][$x-$xmin] = $pixelmatrix[$y][$x];
	}
    }
    return \@buffer;
}

# ----------------------------------------------------------------------

sub insert_buffer($$$;$)
{
    my ($x0, $y0, $buffer, $mode) = @_;
    my ($buf_jmax, $buf_imax) = dimensions($buffer);
    my $x1 = min($x0 + $buf_jmax, $width);
    my $y1 = min($y0 + $buf_imax, $height);
    for (my $x = $x0; $x < $x1; $x++) {
	for (my $y = $y0; $y < $y1; $y++) {
	    if ($$buffer[$y-$y0][$x-$x0]) {
		if ($mode) {
		    &$drawingfunc($x, $y, HextoRGB($$buffer[$y-$y0][$x-$x0]));
		} else {
		    draw_forced($x, $y, $$buffer[$y-$y0][$x-$x0]);
		}
	    }
	}
    }
}

# ----------------------------------------------------------------------

sub overwrite_buffer($$$)
{
    my ($x0, $y0, $buffer) = @_;
    my ($buf_jmax, $buf_imax) = dimensions($buffer);
    my $x1 = min($x0 + $buf_jmax, $width);
    my $y1 = min($y0 + $buf_imax, $height);
    for (my $x = $x0; $x < $x1; $x++) {
	for (my $y = $y0; $y < $y1; $y++) {
	    my $RGB = $$buffer[$y-$y0][$x-$x0];
	    $pixelmatrix[$y][$x] = $RGB;
	    if ($RGB) {
		$drawingcanvas->itemconfigure($canvaspixel[$y][$x],
					      -fill => $RGB, -stipple => "");
		$previewimage->put($RGB, -to => ($x, $y));
	    } else {
		$drawingcanvas->itemconfigure($canvaspixel[$y][$x],
					      -fill => "black", 
					      -stipple => "gray50");
		$previewimage->put($preview_bg, -to => ($x, $y));
	    }
	}
    }
}


# ----------------------------------------------------------------------

sub delete_rectangle($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    my ($xmin,$xmax) = $x0 < $x1 ? ($x0,$x1) : ($x1,$x0);
    my ($ymin,$ymax) = $y0 < $y1 ? ($y0,$y1) : ($y1,$y0);
    for (my $x = $xmin; $x <= $xmax; $x++) {
	for (my $y = $ymin; $y <= $ymax; $y++) {
	    $pixelmatrix[$y][$x] = '';
	    $drawingcanvas->itemconfigure($canvaspixel[$y][$x],
					  -fill => "black", 
					  -stipple => "gray50");
	    $previewimage->put($preview_bg, -to => ($x, $y));
	}
    }
}


# ----------------------------------------------------------------------

sub clear()
{
    enable_undo();
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    $pixelmatrix[$y][$x] = '';
	    $drawingcanvas->itemconfigure($canvaspixel[$y][$x],
					  -fill => "black", 
					  -stipple => "gray50");
	    $previewimage->put($preview_bg, -to => ($x, $y));
	}
    }
}


# ----------------------------------------------------------------------
# Zooming
# ----------------------------------------------------------------------

sub zoom($) 
{
    my $oldzoomfac = $zoomfac;
    $zoomfac = shift;
    my $canvasfac = $zoomfac/$oldzoomfac;
    display_info();
    $drawingcanvas->scale("all", 0, 0, $canvasfac, $canvasfac);
    $drawingcanvas
	->configure(-width => min($zoomfac * $width, $max_canvas_width),
		    -height =>min($zoomfac * $height, $max_canvas_height));
    $drawingcanvas->configure(-scrollregion => [0, 0, 
						$zoomfac * $width,
						$zoomfac * $height]);
}

# ----------------------------------------------------------------------

sub propose_zoomfac($$)
{
    my ($width, $height) = @_;
    for (my $i = 1; $i < scalar(@zoomfacs); $i++) {
	if ( $width * $zoomfacs[$i] > $max_canvas_width or
	     $height * $zoomfacs[$i] > $max_canvas_height) {
	    return $zoomfacs[$i-1];
	}
    }
    return $zoomfacs[$#zoomfacs];
}

# ----------------------------------------------------------------------
# Selecting colors
# ----------------------------------------------------------------------

sub select_preview_bg($)
{
    $preview_bg = shift;    
    $previewcanvasframe->configure(-background => $preview_bg);
    draw_preview();
}

# ----------------------------------------------------------------------

sub select_foreground()
{
    $fg_button->configure(-relief => 'sunken');
    $fg_frame->configure(-background => '#eeeeee');
    $fg_label->configure(-background => '#eeeeee');
    $bg_button->configure(-relief => 'raised');
    $bg_frame->configure(-background => $mw->cget(-background));
    $bg_label->configure(-background => $mw->cget(-background));

    ($select_r, $select_g, $select_b)  = (\$fg_r, \$fg_g, \$fg_b);
    $redscale->configure(-variable => $select_r);
    $greenscale->configure(-variable => $select_g);
    $bluescale->configure(-variable => $select_b);
    $select_val = max($$select_r, $$select_g, $$select_b);
    $select_color_button = \$fg_button;
    $select_color = \$foreground;
}

# ----------------------------------------------------------------------

sub select_background()
{
    $bg_button->configure(-relief => 'sunken');
    $bg_frame->configure(-background => '#eeeeee');
    $bg_label->configure(-background => '#eeeeee');
    $fg_button->configure(-relief => 'raised');
    $fg_frame->configure(-background => $mw->cget(-background));
    $fg_label->configure(-background => $mw->cget(-background));

    ($select_r, $select_g, $select_b)  = (\$bg_r, \$bg_g, \$bg_b);
    $redscale->configure(-variable => $select_r);
    $greenscale->configure(-variable => $select_g);
    $bluescale->configure(-variable => $select_b);
    $select_val = max($$select_r, $$select_g, $$select_b);
    $select_color_button = \$bg_button;
    $select_color = \$background;
}

# ----------------------------------------------------------------------

sub switch_fg_bg()
{
    ($foreground, $background) = ($background, $foreground);
    ($fg_r, $fg_g, $fg_b, $bg_r, $bg_g, $bg_b) = 
	($bg_r, $bg_g, $bg_b, $fg_r, $fg_g, $fg_b);
    $fg_button->configure(-background => $foreground);
    $fg_button->configure(-activebackground => $foreground);
    $bg_button->configure(-background => $background);
    $bg_button->configure(-activebackground => $background);
    ($$select_r, $$select_g, $$select_b) = HextoRGB($$select_color);
    $select_val = max($$select_r, $$select_g, $$select_b);
}

# ----------------------------------------------------------------------

sub set_color_entry()
{
    my $color = $hex_entry->get();
    
    # Check if $color is a valig RGB string
    $color =~ /^#[a-f0-9]{6}\Z/i or
	return message "\"$color\" is not a valid rgb value!";

    $hex_entry->delete(0, 'end');
    set_color_Hex($color);
}


# ----------------------------------------------------------------------

sub set_color_RGB()
{
    $$select_color = RGBtoHex($$select_r, $$select_g, $$select_b);
    $select_val = max($$select_r, $$select_g, $$select_b);
    $$select_color_button->configure(-background => $$select_color,
				     -activebackground => $$select_color);
}

# ----------------------------------------------------------------------

sub set_color_Hex($)
{
    $$select_color = shift;
    ($$select_r, $$select_g, $$select_b) = HextoRGB($$select_color);
    $select_val = max($$select_r, $$select_g, $$select_b);
    $$select_color_button->configure(-background => $$select_color,
				     -activebackground => $$select_color);
}

# ----------------------------------------------------------------------

sub set_color_Val()
{
    my $rgbmax = max($$select_r, $$select_g, $$select_b);
    if ($rgbmax == 0) {
	($$select_r, $$select_g, $$select_b) = 
	    ($select_val, $select_val, $select_val);
    } else {
	my $scalfac = $select_val / $rgbmax;
	$$select_r = min( int($$select_r * $scalfac + 0.5), 255);
	$$select_g = min( int($$select_g * $scalfac + 0.5), 255);
	$$select_b = min( int($$select_b * $scalfac + 0.5), 255);
    }
    $$select_color = RGBtoHex($$select_r, $$select_g, $$select_b);
    $$select_color_button->configure(-background => $$select_color,
				     -activebackground => $$select_color);
}

# ----------------------------------------------------------------------

sub pick_color()
{
    my $color = $pixelmatrix[$mousey][$mousex];
    if ($color) { 
	$$select_color = $color;
	($$select_r, $$select_g, $$select_b) = HextoRGB($color);
	$select_val = max($$select_r, $$select_g, $$select_b);
	$$select_color_button->configure(-background => $$select_color,
				     -activebackground => $$select_color);
    }
    start_tool(\&pick_color, $pick_button, 0, 0);
}

# ----------------------------------------------------------------------
# Palette
# ----------------------------------------------------------------------

sub build_palette_menu()
{
    $palette_menubutton->menu->index('end') > 1 and 
	$palette_menubutton->menu->delete(2, 'end');
    info "Searching palettes ... ";
    if (! (-d $palette_dir) ) {
  	info "directory $palette_dir not found\n";
  	return;
    }
    my @palettes = grep {chomp $_ and -f "$palette_dir/$_" 
			     and /^[a-z0-9]*\.pal$/i } `ls $palette_dir`;
    info scalar(@palettes) . ' palettes found ... ';
    foreach my $palette (@palettes) {
	$palette = substr($palette, 0, length($palette) - 4);
 	$palette_menubutton->cascade(-label => $palette);
	my $submenu = $palette_menubutton
	    ->Menu(-tearoff => 0,
		   -menuitems =>[ ['command' => 'Load',
				   -command => [\&load_palette_dialog, 
						$palette]],
				 ['command' => 'Remove',
				  -command => [\&remove_palette, $palette]]
				 ]);
	$palette_menubutton->entryconfigure($palette, -menu => $submenu);
	
    }
    info "done\n";
}


# ----------------------------------------------------------------------

sub build_palette()
{
    foreach my $button (@palette_buttons) { $button ->destroy(); }
    @palette_buttons = ();
    for (my $i=0; $i < scalar(@palette); $i++) {
	my $column = $i % 10;
	my $row = int($i / 10);
	$palette_buttons[$i] = 
	    $palette_frame->Button(-background => $palette[$i],
				   -activebackground => $palette[$i],
				   -command => [\&set_color_Hex, $palette[$i]])
		->grid(-row => $row, -column => $column);
	$palette_buttons[$i]->bind('<Button-3>', [\&palette_popup, $i]);
    }	
}


# ----------------------------------------------------------------------

sub palette_popup($$)
{
    my ($button, $i) = @_;
    my @menuitems = (['command' => 'Replace color',
		      -command => [\&change_palette_color, $i]]);
    scalar(@palette < 50) and
	push @menuitems, ['command' => 'Insert color before',
			  -command => [\&insert_palette, $i]],
	['command' => 'Insert color after',
	 -command => [\&insert_palette, $i+1]];
    scalar(@palette > 1) and
	push @menuitems, ['command' => 'Remove from palette',
			  -command => [\&remove_from_palette, $i]];
    push @menuitems, ['command' => 'Set as preview background',
		      -command => [\&select_preview_bg, $palette[$i]]];
    my $menu = 
	$button->Menu(-tearoff => 0, -menuitems => \@menuitems);
    $menu->Popup(-popover => $button,
 		 -popanchor => 'se');
}

# ----------------------------------------------------------------------

sub change_palette_color($)
{
    my $i = shift;
    my $color = $$select_color;
    $palette[$i] = $color;
    $palette_buttons[$i]->configure(-background => $color,
				    -activebackground => $color,
				    -command => [\&set_color_Hex, $color]);
    $palette_changed = 1;
}

# ----------------------------------------------------------------------

sub insert_palette($)
{
    my $i = shift;
    my @tmp = splice @palette, $i;
    push @palette, $$select_color, @tmp;
    build_palette();
    $palette_changed = 1;
}


# ----------------------------------------------------------------------

sub remove_from_palette($)
{
    my $i = shift;
    
    splice @palette, $i, 1;
    build_palette();
    $palette_changed = 1;
}

# ----------------------------------------------------------------------

sub save_palette_dialog()
{
    my $DB = $mw->DialogBox(-title => 'Save palette as ...',
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    my @palettes = grep {chomp $_ and -f "$palette_dir/$_" 
			     and /^[a-z0-9]*\.pal$/i } `ls $palette_dir`;
    my $name = ($palette_name or -f "$palette_dir/default.pal") ? 
	$palette_name : 'default';
    foreach (@palettes) {
	$_ = substr($_, 0, length($_) - 4);
    } 
    my $frame = $DB->Frame()->pack();
    my $LB = $frame->Scrolled('Listbox', -selectmode => 'single',
			      -scrollbars => 'ne', -width =>30)->pack();
    $LB->insert('end', @palettes);
    my $entry = $frame->Entry(-background => '#ffffff', -width => 30,
			      -textvariable => \$name)->pack();
    $LB->bind('<Button-1>', sub { $name = $palettes[$LB->curselection()]; });

    $DB->Show() eq 'Ok' or return;
    $name =~ /^[a-z0-9]+?$/  or 
	return message('Palette name must be alphanumeric');
    
    info "Saving palette to file $name ...";
    my $fh = new FileHandle;
    if (! open($fh, "> $palette_dir/$name.pal")) {
  	message("Could not open file $name.");
  	info "aborted\n";
  	return;
    }
    foreach my $color (@palette) { print $fh "$color\n"; }
    close $fh;
    info "done\n";
    $palette_changed = 0;
    $palette_name = $name;
    build_palette_menu();
}

# ----------------------------------------------------------------------

sub load_palette_dialog($)
{
    my $name = shift;
    
    if ($palette_changed and $preferences{querypalettesave}) {
	    my $DB = $mw->DialogBox(-title => "Resize",
				    -buttons => ['Ok', 'Cancel']);
	    $DB->resizable(0,0);
	    $DB->Label(-justify => 'left',
		       -text => "Palette $palette_name has been changed\n".
		       "Discard changes and load new palette?")->pack();
	    $DB->Show() ne 'Ok' and return;
	}
    load_palette($name);
}

# ----------------------------------------------------------------------

sub load_default_palette_dialog()
{
    if ($palette_changed and $preferences{querypalettesave}) {
	    my $DB = $mw->DialogBox(-title => "Resize",
				    -buttons => ['Ok', 'Cancel']);
	    $DB->resizable(0,0);
	    $DB->Label(-justify => 'left',
		       -text => "Palette $palette_name has been changed\n".
		       "Discard changes and load new palette?")->pack();
	    $DB->Show() ne 'Ok' and return;
	}
    load_default_palette();
}


# ----------------------------------------------------------------------

sub load_default_palette()
{
    @palette = @default_palette;
    $palette_name = '';
    $palette_changed = 0;
    build_palette();
}


# ----------------------------------------------------------------------

sub load_palette($)
{
    my $name = shift;
    my $filename = "$palette_dir/$name.pal";

    info "Loading palette $name ...";
    my $fh = new FileHandle();
    open $fh, $filename;
    
    if (! $fh) {
	message("could not open file $filename");
	info "aborted\n";
	return;
    }
    my @newpalette = <$fh>;
    
    if (scalar(@newpalette > 30)) {
	message("palette contains too many colors");
	info "aborted\n";
	return 0;
    }
    foreach my $color (@newpalette) {
	chomp $color;
  	if ($color !~ /^#[a-f0-9]{6}\Z/i) {
  	    message("palette $name contains invalid color \"$color\" ");
  	    info "aborted\n";
  	    return 0;
	}
    }
    
    if (scalar(@newpalette) < 1 or scalar(@newpalette) > 50) {
	message("Palette $name seems corrupted",
		"(too few or to many colors)");
	info "aborted\n";
	return 0;
    }

    @palette = @newpalette;
    $palette_name = $name;
    $palette_changed = 0;
    build_palette();
    info " done\n";
    return 1;
}

# ----------------------------------------------------------------------

sub remove_palette($)
{
    my $name = shift;
    my $file = "$palette_dir/$name.pal";
    info "Removing palette $name ... ";
    system "mv $file $file.bak";
    if ($?) { 
	message("Shell command mv $file $file.bak failed.");
	info "aborted\n";
	return;
    }
    info "done\n";
    build_palette_menu();
}



# ----------------------------------------------------------------------
# Controlling the mouse movvements in the canvas
# ----------------------------------------------------------------------

sub mousewatcher($$$$)
{
    my ($dummy, $x,$y, $eventtype) = @_;
    $eventtype eq "EnterNotify" and $mouseincanvas = 1;
    if ($eventtype eq "LeaveNotify") {
	$mouseincanvas = 0;
	$pixelinfo->configure(-text => "");
    }
    if ($eventtype eq "ButtonPress") {
	$mouse1down = 1;
	$mouse3down = 0;
    }
    if ($eventtype eq "ButtonRelease") { 
	$mouse1down = 0;
	$mouse3down = 0;
    }
    my $mousex_new = int($drawingcanvas->canvasx($x) / $zoomfac);
    my $mousey_new = int($drawingcanvas->canvasy($y) / $zoomfac);
    if ($mousex_new >= $width) { $mousex_new = $width -1; }
    if ($mousey_new >= $height) { $mousey_new = $height -1; }
    if ($mouseincanvas) {
	if ($mousex_new != $mousex or $mousey_new != $mousey) {
	    $mousex = $mousex_new;
	    $mousey = $mousey_new;
	    my $color = $pixelmatrix[$mousey][$mousex] ? 
		$pixelmatrix[$mousey][$mousex] : "(transparent)"; 
	    $pixelinfo->configure(-text => "($mousex,$mousey) $color");
	}
    } 
    if  ($eventtype eq "ButtonPress" and $mouseincanvas and $canvas_callback) {
	my $func = $canvas_callback;
	$canvas_callback = undef;
	&$func(@canvas_callback_args);
    }
}

# ----------------------------------------------------------------------

sub button3watcher($$)
{
    my ($dummy, $eventtype) = @_;
    $mouse3down = $eventtype eq "ButtonPress"; 
}

# ----------------------------------------------------------------------

sub start_tool($$$$;@)
{
    my $pack_before;
    $active_button and $active_button
	->configure(-background => $mw->cget(-background),
		    -relief => 'raised');

    $modeframe and $modeframe->packForget();
    ($canvas_callback, $active_button, $pack_before, $modeframe,
     @canvas_callback_args) = @_;
    $active_button and 
	$active_button->configure(-background => 'white',
				  -relief => 'sunken');
    $modeframe and $modeframe->pack(-before => $pack_before, -fill => 'x');
}

# ----------------------------------------------------------------------
 
sub canvas_unbind()
{
    if ($modeframe) {
	$modeframe->packForget();
	$modeframe = undef;
    }
    if ($active_button) {
	$active_button->configure(-background => $mw->cget(-background),
				  -relief => 'raised');
	$active_button = undef;
    }
    $canvas_callback = undef;
    @canvas_callback_args = ();
}

# ----------------------------------------------------------------------
# Routines to restrict the angle of lines etc.
# ----------------------------------------------------------------------

sub restrict30($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    ($x1 == $x0 or $y1 == $y0)  and return ($x1, $y1);

    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $adx = $dx > 0 ? $dx : - $dx;
    my $ady = $dy > 0 ? $dy : - $dy;
    my $sx = $dx > 0 ? 1 : -1;
    my $sy = $dy > 0 ? 1 : -1;
    my $r = sqrt($dx*$dx + $dy * $dy);	
    my $r1 = int($r/2);
    my $r2 = 2 * $r1 + 1;
    my $angle = ceil(atan2($dy, $dx) * 180. / 3.1415927 + 14) % 360; 
    $angle = int($angle / 30) * 30;

    my $dx1 = $dx > 0 ? int($dx / 2) : int( -$dx / 2);
    my $dx2 = 2 * $dx1;
    my $dy1 = $dy > 0 ? int($dy / 2) : int( -$dy / 2);
    my $dy2 = 2 * $dy1;
    my $d;

    if ($angle == 0) {
	$y1 = $y0;
    } elsif ($angle == 30) {
	$dx1 = int($dx/2);
	$x1 = $x0 + 2 * $dx1;
	$y1 = $y0 + $dx1;
	if ($y1 >= $height) {
	    $d = $y1 - ($height - 1);
	    $y1 = $height - 1;
	    $x1 -= 2 * $d;
	}
    } elsif ($angle == 60) {
	$dy1 = int($dy/2);
	$y1 = $y0 + 2 * $dy1;
	$x1 = $x0 + $dy1;
	if ($x1 >= $width) {
	    $d = $x1 - ($width - 1);
	    $x1 = $width - 1;
	    $y1 -= 2 * $d;
	}
    } elsif ($angle == 90) {
	$x1 = $x0;
    } elsif ($angle == 120) {
	$dy1 = int($dy/2);
	$y1 = $y0 + 2 * $dy1;
	$x1 = $x0 - $dy1;
	if ($x1 < 0) {
	    $y1 += 2 * $x1;
	    $x1 = 0;
	}
    } elsif ($angle == 150) {
	$dx1 = int(-$dx/2);
	$x1 = $x0 - 2 * $dx1;
	$y1 = $y0 + $dx1;
	if ($y1 >= $height) {
	    $d = $y1 - ($height - 1);
	    $y1 = $height - 1;
	    $x1 += 2 * $d;
	}
    } elsif ($angle == 180) {
	$y1 = $y0;
    } elsif ($angle == 210) {
	$dx1 = int(-$dx/2);
	$x1 = $x0 - 2 * $dx1;
	$y1 = $y0 - $dx1;
	if ($y1 < 0) {
	    $x1 -= 2 * $y1;
	    $y1 = 0;
	}
    } elsif ($angle == 240) {
	$dy1 = int(-$dy/2);
	$y1 = $y0 - 2 * $dy1;
	$x1 = $x0 - $dy1;
	if ($x1 < 0) {
	    $y1 -= 2 * $x1;
	    $x1 = 0;
	}
    } elsif ($angle == 270) {
	$x1 = $x0;
    } elsif ($angle == 300) {
	$dy1 = int(-$dy/2);
	$y1 = $y0 - 2 * $dy1;
	$x1 = $x0 + $dy1;
	if ($x1 >= $width) {
	    $d = $x1 - ($width - 1);
	    $x1 = $width - 1;
	    $y1 += 2 * $d;
	}
    } elsif ($angle == 330) {
	$dx1 = int($dx/2);
	$x1 = $x0 + 2 * $dx1;
	$y1 = $y0 - $dx1;
	if ($y1 < 0) {
	    $x1 += 2 * $y1;
	    $y1 = 0;
	}
    }
    return ($x1, $y1);
}


# ----------------------------------------------------------------------

sub restrict_line_30($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    ($x1 == $x0 or $y1 == $y0)  and return ($x1, $y1);

    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $adx = $dx > 0 ? $dx : - $dx;
    my $ady = $dy > 0 ? $dy : - $dy;
    my $sx = $dx > 0 ? 1 : -1;
    my $sy = $dy > 0 ? 1 : -1;
    my $r = sqrt($dx*$dx + $dy * $dy);	
    my $r1 = int($r/2);
    my $r2 = 2 * $r1 + 1;
    my $angle = ceil(atan2($dy, $dx) * 180. / 3.1415927 + 14) % 360; 
    $angle = int($angle / 30) * 30;

    my $dx1 = $dx > 0 ? int($dx / 2) : int( -$dx / 2);
    my $dx2 = 2 * $dx1;
    my $dy1 = $dy > 0 ? int($dy / 2) : int( -$dy / 2);
    my $dy2 = 2 * $dy1;
    my $d;

    if ($angle == 0) {
	$y1 = $y0;
    } elsif ($angle == 30) {
	$dx1 = int($dx/2);
	$x1 = $x0 + 2 * $dx1 + 1;
	$y1 = $y0 + $dx1;
	if ($x1 >= $width) {
	    $x1 -= 2;
	    $y1 -= 1;
	}
	if ($y1 >= $height) {
	    $d = $y1 - ($height - 1);
	    $y1 = $height - 1;
	    $x1 -= 2 * $d;
	}
    } elsif ($angle == 60) {
	$dy1 = int($dy/2);
	$y1 = $y0 + 2 * $dy1 + 1;
	$x1 = $x0 + $dy1;
	if ($y1 >= $height) {
	    $y1 -= 2;
	    $x1 -= 1;
	}
	if ($x1 >= $width) {
	    $d = $x1 - ($width - 1);
	    $x1 = $width - 1;
	    $y1 -= 2 * $d;
	}
    } elsif ($angle == 90) {
	$x1 = $x0;
    } elsif ($angle == 120) {
	$dy1 = int($dy/2);
	$y1 = $y0 + 2 * $dy1 + 1;
	$x1 = $x0 - $dy1;
	if ($y1 >= $height) {
	    $y1 -= 2;
	    $x1 += 1;
	}
	if ($x1 < 0) {
	    $y1 += 2 * $x1;
	    $x1 = 0;
	}
    } elsif ($angle == 150) {
	$dx1 = int(-$dx/2);
	$x1 = $x0 - 2 * $dx1 - 1;
	$y1 = $y0 + $dx1;
	if ($x1 < 0) {
	    $x1 += 2;
	    $y1 -= 1;
	}
	if ($y1 >= $height) {
	    $d = $y1 - ($height - 1);
	    $y1 = $height - 1;
	    $x1 += 2 * $d;
	}
    } elsif ($angle == 180) {
	$y1 = $y0;
    } elsif ($angle == 210) {
	$dx1 = int(-$dx/2);
	$x1 = $x0 - 2 * $dx1 - 1;
	$y1 = $y0 - $dx1;
	if ($x1 < 0) {
	    $x1 += 2;
	    $y1 += 1;
	}
	if ($y1 < 0) {
	    $x1 -= 2 * $y1;
	    $y1 = 0;
	}
    } elsif ($angle == 240) {
	$dy1 = int(-$dy/2);
	$y1 = $y0 - 2 * $dy1 - 1;
	$x1 = $x0 - $dy1;
	if ($y1 < 0) {
	    $y1 += 2;
	    $x1 += 1;
	}
	if ($x1 < 0) {
	    $y1 -= 2 * $x1;
	    $x1 = 0;
	}
    } elsif ($angle == 270) {
	$x1 = $x0;
    } elsif ($angle == 300) {
	$dy1 = int(-$dy/2);
	$y1 = $y0 - 2 * $dy1 - 1;
	$x1 = $x0 + $dy1;
	if ($y1 < 0) {
	    $y1 += 2;
	    $x1 -= 1;
	}
	if ($x1 >= $width) {
	    $d = $x1 - ($width - 1);
	    $x1 = $width - 1;
	    $y1 += 2 * $d;
	}
    } elsif ($angle == 330) {
	$dx1 = int($dx/2);
	$x1 = $x0 + 2 * $dx1 + 1;
	$y1 = $y0 - $dx1;
	if ($x1 >= $width) {
	    $x1 -= 2;
	    $y1 += 1;
	}
	if ($y1 < 0) {
	    $x1 += 2 * $y1;
	    $y1 = 0;
	}
    }
    return ($x1, $y1);
}


# ----------------------------------------------------------------------


sub restrict45($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    ($x1 == $x0 or $y1 == $y0)  and return ($x1, $y1);
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $adx = $dx >= 0 ? $dx : - $dx;
    my $ady = $dy >= 0 ? $dy : - $dy;
    my $adx2 = 2 * $adx;
    my $ady2 = 2 * $ady;
    my $d;
    my $r = sqrt($dx*$dx + $dy * $dy);	
    # restrict angle of the line between (x0,y0) and (x1, y1) to 45 %
    if ($dx >= 0 and $dx >= $ady2) {
	($x1, $y1) = ($x0 + int($r), $y0);
	($x1 >= $width) and $x1 = $width -1;
    } elsif ($dy >= 0 and $dy >= $adx2) {
	($x1, $y1) = ($x0, $y0 + int($r));
	($x1 >= $height) and $y1 = $height -1;
    } elsif ($dx < 0 and $adx >= $ady2) {
	($x1, $y1) = ($x0 - int($r), $y0);
	($x1 < 0) and ($x1 = 0);
    } elsif ($dy < 0 and $ady >= $adx2) {
	($x1, $y1) = ($x0, $y0 - int($r));
	($y1 <= 0) and $y1 = 0;
    } else {
	my $sx = $dx > 0 ? 1 : -1;
	my $sy = $dy > 0 ? 1 : -1;
	my $r = sqrt($dx*$dx + $dy * $dy);	
	my $d = int(0.707108 * $r);
	$x1 = $dx >= 0 ? $x0 + $d : $x0 - $d;
	$y1 = $dy >= 0 ? $y0 + $d : $y0 - $d;
	if ($x1 >= $width) {
	    $d = $x1 - ($width - 1);
	    $x1 = $width - 1;
	    $y1 -= $sy * $d;
	} elsif ($x1 < 0) {
	    $d = -$x1;
	    $x1 = 0;
	    $y1 -= $sy * $d;
	} elsif ($y1 >= $height) {
	    $d = $y1 - ($height - 1);
	    $y1 = $height -1;
	    $x1 -= $sx * $d;
	} elsif ($y1 < 0) {
	    $d = - $y1;
	    $y1 = 0;
	    $x1 -= $sx * $d;
	}
    }
    return ($x1, $y1);
}

# ----------------------------------------------------------------------

sub restrict_diagonal($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;
    ($x1 == $x0 and $y1 == $y0)  and return ($x1, $y1);
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $sx = $dx > 0 ? 1 : -1;
    my $sy = $dy > 0 ? 1 : -1;
    my $r = sqrt($dx*$dx + $dy * $dy);	
    my $d = int(0.707108 * $r);
    $x1 = $dx >= 0 ? $x0 + $d : $x0 - $d;
    $y1 = $dy >= 0 ? $y0 + $d : $y0 - $d;
    if ($x1 >= $width) {
	$d = $x1 - ($width - 1);
	$x1 = $width - 1;
	$y1 -= $sy * $d;
    } elsif ($x1 < 0) {
	$d = -$x1;
	$x1 = 0;
	$y1 -= $sy * $d;
    } elsif ($y1 >= $height) {
	$d = $y1 - ($height - 1);
	$y1 = $height -1;
	$x1 -= $sx * $d;
    } elsif ($y1 < 0) {
	$d = - $y1;
	$y1 = 0;
	$x1 -= $sx * $d;
    }
    return ($x1, $y1);
}

# ----------------------------------------------------------------------
# Drawing tools
# ----------------------------------------------------------------------

sub freehand_tool()
{
     my ($xold, $yold) = (-1, -1);
    enable_undo();
    info("Starting freehand drawing ... ");
    for (;;) {
	if ($mouseincanvas and ($mousex != $xold or $mousey != $yold)) {
	    &$drawingfunc($mousex, $mousey);
	    ($xold, $yold) = ($mousex, $mousey);
	}
	$drawingcanvas->update();
	if (!$mouse1down) {
	    info("done\n");
	    start_tool(\&freehand_tool, $freehand_button, 0, 0);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub smooth_tool()
{
    info('Smoothing ',
	 ['(both directions', '(horizontally', '(vertically']->[$smooth_mode],
	 ", intensity: $smooth_intensity) ... ");
    my $w1 = 0.7 * 0.01 * $smooth_intensity;  # weight of the neighbour pixels
    my $w0 = 1 - $w1;                         # weight of the original pixel
    my ($xold, $yold) = (-1, -1);
    my ($r, $g, $b);
    my $fac;
    enable_undo();
    for (;;) {
	$drawingcanvas->update();
	if (!$mouse1down ) {
	    info("done\n");
	    start_tool(\&smooth_tool, $smooth_button, $map_button,
		       $smooth_frame);
	    return;
	}
	($mousex == $xold and  $mousey == $yold) or (!$mouseincanvas) and next;
	($xold, $yold) = ($mousex, $mousey);
	$pixelmatrix[$mousey][$mousex] or next;
	
	my @neighbours;
	if ($smooth_mode < 2) {
	    $mousex > 1 and 
		push @neighbours, $pixelmatrix[$mousey][$mousex-1];
	    $mousex < $width-1 and 
		push @neighbours, $pixelmatrix[$mousey][$mousex+1];
	}
	if ($smooth_mode != 1) {
	    $mousey > 1 and 
		push @neighbours, $pixelmatrix[$mousey-1][$mousex];
	    $mousey < $height-1 and 
		push @neighbours, $pixelmatrix[$mousey+1][$mousex];
	}
	my ($rsum, $gsum, $bsum) = (0, 0, 0);
	my $n = 0;
	foreach (@neighbours) {
	    $_ or next;
	    ($r, $g, $b) = HextoRGB($_);
	    $rsum += $r; $gsum += $g; $bsum += $b;
	    $n++;
	}
	if ($n) {
	    ($r, $g, $b) = HextoRGB($pixelmatrix[$mousey][$mousex]);
	    $fac = $w1 / $n;
	    $r = int ($w0 * $r + $fac * $rsum);
	    $g = int ($w0 * $g + $fac * $gsum);
	    $b = int ($w0 * $b + $fac * $bsum);
	    draw_forced($mousex, $mousey, RGBtoHex($r, $g, $b));
	}
    }
}

# ----------------------------------------------------------------------

sub line_tool()
{
    my ($x0, $y0) = ($mousex, $mousey);
    my ($x1, $y1) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $canvas_x0 = $zoomfac / 2 + $zoomfac * $mousex;
    my $canvas_y0 = $zoomfac / 2 + $zoomfac * $mousey;
    my ($canvas_x1, $canvas_y1);
    my $line;
    my $fill = $foreground;
    my $stipple = "gray75";
    info("Starting line at ($x0,$y0) (press button 3 to abort) ... ");

    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    # delete old preview line
	    if ($line) { $drawingcanvas->delete($line); }
	    if ($restrict_lines_angle == 45) {
		($x1, $y1) = restrict45($x0, $y0, $mousex, $mousey);
	    } elsif ($restrict_lines_angle == 30) {
		($x1, $y1) = restrict_line_30($x0, $y0, $mousex, $mousey);
	    } else {
		($x1, $y1) = ($mousex, $mousey);
	    }
	    # draw new preview line
	    $canvas_x1 = $zoomfac / 2 + $zoomfac * $x1;
	    $canvas_y1 = $zoomfac / 2 + $zoomfac * $y1;
	    $line = $drawingcanvas->createLine($canvas_x0, $canvas_y0,
					       $canvas_x1, $canvas_y1,
					       -fill => $fill,
					       -width => $zoomfac/2,
					       -stipple => $stipple);
	}
	$drawingcanvas->update();
	if ($mouse3down) { # cancelled
	    # delete preview line
	    if ($line) { $drawingcanvas->delete($line); }
	    info("aborted\n");
	    start_tool(\&line_tool, $line_button, $rect_button, $lines_frame);
	    return;
	} elsif (!$mouse1down) {
	    # delete preview line
	    if ($line) { $drawingcanvas->delete($line); }
	    info("done\n");
	    # draw the line
	    enable_undo();
	    draw_line($x0, $y0, $x1, $y1);
	    start_tool(\&line_tool, $line_button, $rect_button, $lines_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub rectangle_tool()
{
    my ($x0, $y0) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $canvas_x0 = $zoomfac / 2 + $zoomfac * $mousex;
    my $canvas_y0 = $zoomfac / 2 + $zoomfac * $mousey;
    my ($canvas_x1, $canvas_y1);
    my @lines = ();
    my $rect;
    my $fill = $foreground;
    my $stipple = "gray75";
    info("Starting rectangle at ($x0,$y0) (press button 3 to abort) ... ");
    my ($x1, $y1) = ($mousex, $mousey);
    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    # delete old preview rectangle
	    if ($rect) { $drawingcanvas->delete($rect); }
	    while (@lines) { $drawingcanvas->delete(pop(@lines)); }
	    if ($rectangle_force_square) {
		($x1, $y1) = restrict_diagonal($x0, $y0, $mousex, $mousey);
	    } else {
		($x1, $y1) = ($mousex, $mousey);
	    }
	    # draw new preview rectangle
	    if ($filled_rectangle) {
		$rect = create_selection_rectangle($x0, $y0, $x1, $y1,
						   $fill, $stipple);
	    } else {
		$canvas_x1 = $zoomfac / 2 + $zoomfac * $x1;
		$canvas_y1 = $zoomfac / 2 + $zoomfac * $y1;
		foreach ( [$canvas_x0,$canvas_y0,$canvas_x1,$canvas_y0],
			  [$canvas_x1,$canvas_y0,$canvas_x1,$canvas_y1],
			  [$canvas_x1,$canvas_y1,$canvas_x0,$canvas_y1],
			  [$canvas_x0,$canvas_y1,$canvas_x0,$canvas_y0] ) {
		    push @lines, $drawingcanvas
			->createLine(@$_, -fill => $fill, -width => $zoomfac/2,
				     -stipple => $stipple);
		}
	    }
	}
	$drawingcanvas->update();
	if ($mouse3down) { # cancelled
	    if ($rect) { $drawingcanvas->delete($rect); }
	    while (@lines) { $drawingcanvas->delete(pop(@lines)); }
	    info("aborted\n");
	    start_tool(\&rectangle_tool, $rect_button, $ellipse_button, 
		       $rectangle_frame);
	    return;
	} elsif (!$mouse1down) {
	    info("done\n");
	    if ($rect) { $drawingcanvas->delete($rect); }
	    while (@lines) { $drawingcanvas->delete(pop(@lines)); }
	    enable_undo();
	    if ($filled_rectangle) {
		draw_rectangle($x0, $y0, $x1, $y1);
	    } else {
		if ( $x0 > $x1 ) { ($x0, $x1) = ($x1, $x0); }
		if ( $y0 > $y1 ) { ($y0, $y1) = ($y1, $y0); }
		if ($x0 == $x1) { 
		    draw_line($x0, $y0, $x0, $y1); 
		} elsif ($y0 == $y1) {
		    draw_line($x0, $y0, $x1, $y0); 
		} else {
		    draw_line($x0, $y0, $x1, $y0);
		    draw_line($x0, $y1, $x1, $y1);
		    if ($y1 > $y0+1) {
			draw_line($x0, $y0+1, $x0, $y1-1);
			draw_line($x1, $y0+1, $x1, $y1-1);
		    }
		}
	    }
	    start_tool(\&rectangle_tool, $rect_button, $ellipse_button, 
		       $rectangle_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub ellipse_tool()
{
    my ($x0, $y0) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $oval;
    my $outline = $foreground;
    my $stipple = "gray75";
    info("Starting ellipse at ($x0,$y0) (press button 3 to abort) ... ");
    my ($x1, $y1) = ($mousex, $mousey);

    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    # delete old preview rectangle
	    if ($oval) { $drawingcanvas->delete($oval); }
	    # draw new preview rectangle
	    if ($ellipse_force_circle) {
		($x1, $y1) = restrict_diagonal($x0, $y0, $mousex, $mousey);
	    } else {
		($x1, $y1) = ($mousex, $mousey);
	    }

	    $oval = create_canvas_oval($x0, $y0, $x1, $y1, $filled_ellipse);
	}
	$drawingcanvas->update();
	if ($mouse3down) { # cancelled
	    $drawingcanvas->delete($oval); 
	    info("aborted\n");
	    start_tool(\&ellipse_tool, $ellipse_button, $spray_button,
		       $ellipse_frame);
	    return;
	} elsif (!$mouse1down) {
	    info("done\n");
	    $drawingcanvas->delete($oval); 
	    enable_undo();
	    if ($filled_ellipse) {
		draw_filled_ellipse($x0, $y0, $x1, $y1);
	    } else {
		draw_ellipse($x0, $y0, $x1, $y1);
	    }
	    start_tool(\&ellipse_tool, $ellipse_button, $spray_button,
		       $ellipse_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub create_canvas_oval($$$$$)
		       {
    my ($x0, $y0, $x1, $y1, $filled) = @_;
    if ($x0 > $x1) { ($x0, $x1) = ($x1, $x0); }
    if ($y0 > $y1) { ($y0, $y1) = ($y1, $y0); }
    
    if ($filled) {
	return $drawingcanvas
	    ->createOval($x0 * $zoomfac, $y0 * $zoomfac,
			  ($x1 + 1) * $zoomfac, ($y1 + 1) * $zoomfac,
			  -fill => $foreground,
			  -outline => 'black',
			  -width => 2,
			  -stipple => 'gray75');
    } else {
	my $d = $zoomfac/2;
	return $drawingcanvas
	    ->createOval($x0 * $zoomfac + $d, $y0 * $zoomfac + $d,
			 $x1 * $zoomfac + $d, $y1 * $zoomfac + $d,
			 -outline => $foreground, -width => $zoomfac/2);
    }
}

# ----------------------------------------------------------------------

sub spray_tool()
{
    my $intensity = 0.00004 * $spray_intensity * $spray_intensity;
    my ($xold, $yold) = (-1, -1);
    enable_undo();
    info("Starting spray mode (radius = $spray_radius, ".
	 "intensity = $spray_intensity) ... ");

    my $randomization = (($spray_h_randomfak > 0) or
                 	($spray_s_randomfak > 0) or
	                ($spray_v_randomfak > 0)) ? 1 : 0;

    my ($h, $s, $v) = RGBtoHSV($fg_r, $fg_g, $fg_b);
    my $h_min = $h - 0.01 * $spray_h_randomfak;
    my $dh = 2 * 0.01 * $spray_h_randomfak;

    my $s_min = max($s - 0.01 * $spray_s_randomfak, 0);
    my $s_max = min($s + 0.01 * $spray_s_randomfak, 1);
    my $ds = $s_max - $s_min;

    my $v_min = max($v - 0.01 * $spray_v_randomfak, 0);
    my $v_max = min($v + 0.01 * $spray_v_randomfak, 1);
    my $dv = $v_max - $v_min;

    for (;;) {
	if ($mouseincanvas and ($mousex != $xold or $mousey != $yold)) {
	    if ($randomization) {
		spray_randomized($mousex, $mousey, 
				 $h_min, $s_min, $v_min, $dh, $ds, $dv,
				 $spray_radius, $intensity);
	    } else {
		spray($mousex, $mousey, $spray_radius, $intensity);
	    }
	    ($xold, $yold) = ($mousex, $mousey);
	}
	$drawingcanvas->update();
	if (!$mouse1down) {
	    info("done\n");
	    start_tool(\&spray_tool, $spray_button, $smooth_button, 
		       $spray_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub spray($$$$)
{
    my ($x0, $y0, $radius, $intensity) = @_;

    my $xmin = $x0 -$radius;
    if ($xmin < 0) { $xmin = 0; }
    my $xmax = $x0 + $radius;
    if ($xmax >= $width) { $xmax = $width -1; }
    my $ymin = $y0 -$radius;
    if ($ymin < 0) { $ymin = 0; }
    my $ymax = $y0 + $radius;
    if ($ymax >= $height) { $ymax = $height -1; }

    for (my $x = $xmin; $x <= $xmax; $x++) {
	for (my $y = $ymin; $y <= $ymax; $y++) {
	    if (rand(1) <= $intensity) { &$drawingfunc($x, $y); }
	}
    }
}

# ----------------------------------------------------------------------

sub spray_randomized($$$$$$$$$$)
{
    my ($x0, $y0, $h0, $s0, $v0, $dh, $ds, $dv, $radius, $intensity) = @_;

    my $xmin = $x0 -$radius;
    if ($xmin < 0) { $xmin = 0; }
    my $xmax = $x0 + $radius;
    if ($xmax >= $width) { $xmax = $width -1; }
    my $ymin = $y0 -$radius;
    if ($ymin < 0) { $ymin = 0; }
    my $ymax = $y0 + $radius;
    if ($ymax >= $height) { $ymax = $height -1; }
    my ($h, $s, $v, $r, $g, $b);

    for (my $x = $xmin; $x <= $xmax; $x++) {
	for (my $y = $ymin; $y <= $ymax; $y++) {
	    if (rand(1) <= $intensity) {
		$h = $h0 + $dh * rand(1);
		$h > 6 and $h -= 6;
		$h < 0 and $h += 6;
		$s = $s0 + $ds * rand(1);
		$v = $v0 + $dv * rand(1);
		($r, $g, $b) = HSVtoRGB($h, $s, $v);
		&$drawingfunc($x, $y, $r, $g, $b); 
	    }
	}
    }
}



# ----------------------------------------------------------------------
# mapping colors
# ----------------------------------------------------------------------

sub floodfill_tool()
{
    my $color = $pixelmatrix[$mousey][$mousex];
    info("Applying flood fill ... ");
    enable_undo();
    # mark which pixels are already filled in order to
    # avoid infinite recursion
    my @marked;
    if ($adaptive_floodfill) {
	adaptive_floodfill($mousex, $mousey, \@marked);
    } else {
	recursive_floodfill($mousex, $mousey, $color, \@marked);
    }
    info("done\n");
    start_tool(\&floodfill_tool, $floodfill_button, $gradient_button,
	       $floodfill_frame);
}

# ----------------------------------------------------------------------

sub recursive_floodfill($$$$)
{
    my ($x, $y, $color, $marked) = @_;
    &$drawingfunc($x, $y);
    $marked->[$y][$x] = 1;
    if ($x-1 >= 0 and hsv_match($pixelmatrix[$y][$x-1],$color)
	and !$marked->[$y][$x-1]) {
	recursive_floodfill($x-1, $y, $color, $marked);
    }
    if ($x+1 < $width and hsv_match($pixelmatrix[$y][$x+1], $color)
	and !$marked->[$y][$x+1]) {
	recursive_floodfill($x+1, $y, $color, $marked);
    }
    if ($y-1 >= 0 and hsv_match($pixelmatrix[$y-1][$x], $color)
	and !$marked->[$y-1][$x]) {
	recursive_floodfill($x, $y-1, $color, $marked);
    }
    if ($y+1 < $height and hsv_match($pixelmatrix[$y+1][$x], $color)
	and !$marked->[$y+1][$x]) {
	recursive_floodfill($x, $y+1, $color, $marked);
    }
}

# ----------------------------------------------------------------------

sub adaptive_floodfill($$$)
{
    my ($x, $y, $marked) = @_;
    my $color = $pixelmatrix[$y][$x];
    &$drawingfunc($x, $y);
    $marked->[$y][$x] = 1;
    if ($x-1 >= 0 and hsv_match($pixelmatrix[$y][$x-1],$color)
	and !$marked->[$y][$x-1]) {
	adaptive_floodfill($x-1, $y, $marked);
    }
    if ($x+1 < $width and hsv_match($pixelmatrix[$y][$x+1], $color)
	and !$marked->[$y][$x+1]) {
	adaptive_floodfill($x+1, $y, $marked);
    }
    if ($y-1 >= 0 and hsv_match($pixelmatrix[$y-1][$x], $color)
	and !$marked->[$y-1][$x]) {
	adaptive_floodfill($x, $y-1, $marked);
    }
    if ($y+1 < $height and hsv_match($pixelmatrix[$y+1][$x], $color)
	and !$marked->[$y+1][$x]) {
	adaptive_floodfill($x, $y+1, $marked);
    }
}

# ----------------------------------------------------------------------

sub map_color()
{
    my $color = $pixelmatrix[$mousey][$mousex];
    info("Mapping colors ... ");
    enable_undo();
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    hsv_match($pixelmatrix[$y][$x], $color) and &$drawingfunc($x, $y);
	}
    }
    info("done\n");
    start_tool(\&map_color, $map_button, $floodfill_button, 
		$map_frame);
}

# ----------------------------------------------------------------------

sub hsv_match($$)
{
    my ($hex1, $hex2) = @_;
    ($hex1 and $hex2) or return $hex1 eq $hex2;
    my ($r1, $g1, $b1) = HextoRGB($hex1);
    my ($h1, $s1, $v1) = RGBtoHSV($r1, $g1, $b1);

    my ($r2, $g2, $b2) = HextoRGB($hex2);
    my ($h2, $s2, $v2) = RGBtoHSV($r2, $g2, $b2);

    (abs($h1-$h2) <= 0.01 * $h_tolerance) and 
	(abs($s1-$s2) <= 0.01 * $s_tolerance) and
	(abs($v1-$v2) <= 0.01 * $v_tolerance) and return 1;
    return 0;
}


# ----------------------------------------------------------------------
# gradients
# ----------------------------------------------------------------------


sub menuselect($$$$)
{
    my ($menubutton, $string, $var_ref, $value) = @_;
    $menubutton->configure(-text => $string);
    $$var_ref = $value;
}

# ----------------------------------------------------------------------

sub gradient_tool()
{
    if ($drawingfunc == \&draw_erase) {
	info("Gradient in erase mode make no sense\n");
	start_tool(\&gradient_tool, $gradient_button, $warp_button,
		   $gradient_frame);
	return;
    }
    my $modestring = ('Linear gradient mode', 'Bilinear gradient mode', 
		      'Radial gradient mode')[$gradient_type];

    my ($x0, $y0) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $canvas_x0 = $zoomfac / 2 + $zoomfac * $mousex;
    my $canvas_y0 = $zoomfac / 2 + $zoomfac * $mousey;
    my ($canvas_x1, $canvas_y1);
    my ($x1, $y1) = ($mousex, $mousey);
    my $line;
    my $width = max($zoomfac/4, 2);
    info("Starting gradient at ($x0,$y0) (press button 3 to abort) ... ");

    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    # delete old preview line
	    if ($line) { $drawingcanvas->delete($line); }
	    if ($restrict_gradient_angle == 30) {
		($x1, $y1) = restrict30($x0, $y0, $mousex, $mousey);
	    } elsif ($restrict_gradient_angle == 45) {
		($x1, $y1) = restrict45($x0, $y0, $mousex, $mousey);
	    } else {
		($x1, $y1) = ($mousex, $mousey);
	    }
	    # draw new preview line
	    $canvas_x1 = $zoomfac / 2 + $zoomfac * $x1;
	    $canvas_y1 = $zoomfac / 2 + $zoomfac * $y1;
	    $line = $drawingcanvas
		->createLine($canvas_x0, $canvas_y0,
			     $canvas_x1, $canvas_y1,
			     -fill => $foreground,
			     -arrow => "last",
			     -stipple => 'gray75',
			     -width => $zoomfac,
			     -arrowshape => [$zoomfac, $zoomfac, $zoomfac]);

	}
	$drawingcanvas->update();
	if ($mouse3down) { # cancelled
	    if ($line) { $drawingcanvas->delete($line); }
	    info("aborted\n");
	    start_tool(\&gradient_tool, $gradient_button, $warp_button,
		       $gradient_frame);
	    return;
	} elsif (!$mouse1down) {
	    if ($x0 == $x1 and $y0 == $y1) {
		if ($line) { $drawingcanvas->delete($line); }
		info("aborted\n");
		start_tool(\&gradient_tool, $gradient_button, $warp_button,
			   $gradient_frame);
		return;
	    }
	    if ($line) { $drawingcanvas->delete($line); }
	    info("done\n");
	    if ($gradient_type == 0) {
		linear_gradient($x0, $y0, $x1, $y1, 
				$foreground, $background); 
	    } elsif ($gradient_type == 1) {
		bilinear_gradient($x0, $y0, $x1, $y1, 
				$foreground, $background);
	    } elsif ($gradient_type == 2) {
		radial_gradient($x0, $y0, $x1, $y1,
				  $foreground, $background);
	    } elsif ($gradient_type == 3) {
		rectangular_gradient($x0, $y0, $x1, $y1,
				  $foreground, $background);
	    } else {
		conic_gradient($x0, $y0, $x1, $y1,
				  $foreground, $background);
	    }
	    start_tool(\&gradient_tool, $gradient_button, $warp_button,
		       $gradient_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub gradient_square($)
{
    my $x = shift;
    $x <= 0 and return 0;
    $x >= 1 and return 1;
    return $x*$x;
}

#----------------------------------------------------------------------

sub gradient_sqrt($)
{
    my $x = shift;
    $x <= 0 and return 0;
    $x >= 1 and return 1;
    return sqrt($x);
}		  

# ----------------------------------------------------------------------

sub gradient_sine($)
{
    my $x = shift;
    return 0.5 + 0.5 * sin( ($x - 0.75)  * 6.2831853);
}


# ----------------------------------------------------------------------

sub linear_gradient($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $color0, $color1) = @_;
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $a = 1 / ($dx * $dx + $dy * $dy);
    my ($r, $g, $b, $r_old, $g_old, $b_old);
    my ($r0, $g0, $b0) = HextoRGB($color0);
    my ($r1, $g1, $b1) = HextoRGB($color1);
    my ($mu, $nu);
    my ($fg_weight_orig, $bg_weight_orig) = ($fg_weight, $bg_weight);

    enable_undo();
    info('Applying linear gradient ... ');
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    $mu = (($x - $x0) * $dx + ($y - $y0) * $dy) * $a;
	    $gradientfunc and $mu = &$gradientfunc($mu);
   	    if ($mu <= 0) {
		$mu = 0;
	    } elsif ($mu >= 1) {
		$mu = 1;
	    }
	    $nu = 1 - $mu;
	    if ($gradient_mode == 0) {
		($r, $g, $b) = ( int($nu * $r0 + $mu * $r1),
				 int($nu * $g0 + $mu * $g1),
				 int($nu * $b0 + $mu * $b1));
		&$drawingfunc($x, $y, $r, $g, $b);
	    } elsif ($gradient_mode == 1) {
		$fg_weight = $fg_weight_orig * $nu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    } else {
		$fg_weight = $fg_weight_orig * $mu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    }
	}
    }
    ($fg_weight, $bg_weight) = ($fg_weight_orig, $bg_weight_orig);
    info("done\n");
}

# ----------------------------------------------------------------------

sub bilinear_gradient($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $color0, $color1) = @_;
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $a = 1 / ($dx * $dx + $dy * $dy);
    my ($r, $g, $b, $r_old, $g_old, $b_old);
    my ($r0, $g0, $b0) = HextoRGB($color0);
    my ($r1, $g1, $b1) = HextoRGB($color1);
    my ($mu, $nu);
    my ($fg_weight_orig, $bg_weight_orig) = ($fg_weight, $bg_weight);
    
    enable_undo();
    info('Applying bilinear gradient ... ');
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    $mu = (($x - $x0) * $dx + ($y - $y0) * $dy) * $a;
	    if ($mu <= 0) { 
		$mu = - $mu; 
	    }
	    $gradientfunc and $mu = &$gradientfunc($mu);
	    if ($mu >= 1) {
		$mu = 1;
	    }
	    $nu = 1 - $mu;
	    if ($gradient_mode == 0) {
		($r, $g, $b) = ( int($nu * $r0 + $mu * $r1),
				 int($nu * $g0 + $mu * $g1),
				 int($nu * $b0 + $mu * $b1));
		&$drawingfunc($x, $y, $r, $g, $b);
	    } elsif ($gradient_mode == 1) {
		$fg_weight = $fg_weight_orig * $nu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    } else {
		$fg_weight = $fg_weight_orig * $mu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    }
	}
    }
    ($fg_weight, $bg_weight) = ($fg_weight_orig, $bg_weight_orig);
    info("done\n");
}


# ----------------------------------------------------------------------

sub radial_gradient($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $color0, $color1) = @_;
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    my $d = sqrt($dx*$dx + $dy * $dy);
    my ($r, $g, $b, $r_old, $g_old, $b_old);
    my ($r0, $g0, $b0) = HextoRGB($color0);
    my ($r1, $g1, $b1) = HextoRGB($color1);
    my ($mu, $nu);
    my ($fg_weight_orig, $bg_weight_orig) = ($fg_weight, $bg_weight);

    enable_undo();
    info('Applying radial gradient ... ');
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    $dx = $x - $x0;
	    $dy = $y - $y0;
	    my $d1 = sqrt($dx*$dx + $dy * $dy);
	    $mu = $d1 / $d;
	    $gradientfunc and $mu = &$gradientfunc($mu);
	    if ($mu >= 1) {
		$mu = 1;
	    }
	    $nu = 1 - $mu;
	    if ($gradient_mode == 0) {
		($r, $g, $b) = ( int($nu * $r0 + $mu * $r1),
				 int($nu * $g0 + $mu * $g1),
				 int($nu * $b0 + $mu * $b1));
		&$drawingfunc($x, $y, $r, $g, $b);
	    } elsif ($gradient_mode == 1) {
		$fg_weight = $fg_weight_orig * $nu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    } else {
		$fg_weight = $fg_weight_orig * $mu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    }
	}
    }
    ($fg_weight, $bg_weight) = ($fg_weight_orig, $bg_weight_orig);
    info("done\n");
}

# ----------------------------------------------------------------------

sub rectangular_gradient($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $color0, $color1) = @_;
    info('Applying rectangular gradient ... ');
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;
    ($dx == 0 or $dy == 0) and return
	info("invalid rectangle ... aborted\n");
    my $ax = 1/$dx;
    my $ay = 1/$dy;
    my ($r, $g, $b, $r_old, $g_old, $b_old);
    my ($r0, $g0, $b0) = HextoRGB($color0);
    my ($r1, $g1, $b1) = HextoRGB($color1);
    my ($mux, $muy, $mu, $nu);
    my ($fg_weight_orig, $bg_weight_orig) = ($fg_weight, $bg_weight);
    
    enable_undo();
    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    $mux = ($x - $x0) * $ax;
	    $mux < 0 and $mux = - $mux;
	    $muy = ($y - $y0) * $ay;
	    $muy < 0 and $muy = - $muy;
	    $mu = max($mux, $muy);
	    $gradientfunc and $mu = &$gradientfunc($mu);
	    if ($mu >= 1) {
		$mu = 1;
	    }
	    $nu = 1 - $mu;
	    if ($gradient_mode == 0) {
		($r, $g, $b) = ( int($nu * $r0 + $mu * $r1),
				 int($nu * $g0 + $mu * $g1),
				 int($nu * $b0 + $mu * $b1));
		&$drawingfunc($x, $y, $r, $g, $b);
	    } elsif ($gradient_mode == 1) {
		$fg_weight = $fg_weight_orig * $nu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    } else {
		$fg_weight = $fg_weight_orig * $mu;
		$bg_weight = 1 - $fg_weight;
		&$drawingfunc($x, $y);
	    }
	}
    }
    ($fg_weight, $bg_weight) = ($fg_weight_orig, $bg_weight_orig);
    info("done\n");
}

# ----------------------------------------------------------------------

sub conic_gradient($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $color0, $color1) = @_;
    my $dx0 = $x1 - $x0;
    my $dy0 = $y1 - $y0;
    my $r0_inv = 1. / sqrt($dx0 * $dx0 + $dy0 * $dy0);
    my ($dx, $dy, $rho);

    my ($r, $g, $b, $r_old, $g_old, $b_old);
    my ($r0, $g0, $b0) = HextoRGB($color0);
    my ($r1, $g1, $b1) = HextoRGB($color1);
    my ($cosine, $mu, $nu);
    my ($fg_weight_orig, $bg_weight_orig) = ($fg_weight, $bg_weight);

    enable_undo();
    info('Applying conic gradient ... ');
      for (my $x = 0; $x < $width; $x++) {
  	for (my $y = 0; $y < $height; $y++) {
  	    if ($x == $x0 and $y == $y0) {
  		$mu = 0;
  	    } else {
  		$dx = $x - $x0;
  		$dy = $y - $y0;
  		$rho = sqrt($dx*$dx + $dy*$dy);
		$cosine = ($dx * $dx0 + $dy * $dy0) * $r0_inv / $rho;
		if ($cosine > 1) {$cosine = 1;}
		if ($cosine < -1) {$cosine = -1;}
		$mu = acos($cosine) / 3.141593;
  	    }
	    if ($mu > 1) { $mu = 1;}
	    if ($mu < 0) { $mu = 0;}
 	    $gradientfunc and $mu = &$gradientfunc($mu);
  	    $nu = 1 - $mu;
  	    if ($gradient_mode == 0) {
  		($r, $g, $b) = ( int($nu * $r0 + $mu * $r1),
  				 int($nu * $g0 + $mu * $g1),
  				 int($nu * $b0 + $mu * $b1));
  		&$drawingfunc($x, $y, $r, $g, $b);
  	    } elsif ($gradient_mode == 1) {
  		$fg_weight = $fg_weight_orig * $nu;
  		$bg_weight = 1 - $fg_weight;
  		&$drawingfunc($x, $y);
  	    } else {
  		$fg_weight = $fg_weight_orig * $mu;
  		$bg_weight = 1 - $fg_weight;
  		&$drawingfunc($x, $y);
  	    }
	}
    }
    ($fg_weight, $bg_weight) = ($fg_weight_orig, $bg_weight_orig);
    info("done\n");
}





# ----------------------------------------------------------------------
# warp
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------

sub warp_tool()
{
    my ($x0, $y0) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $canvas_x0 = $zoomfac / 2 + $zoomfac * $mousex;
    my $canvas_y0 = $zoomfac / 2 + $zoomfac * $mousey;
    my ($canvas_x1, $canvas_y1);
    my $line;
    my $width = max($zoomfac/4, 2);
    info("Select warp direction (press button 3 to abort) ... ");

    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    # delete old preview line
	    if ($line) { $drawingcanvas->delete($line); }
	    # draw new preview line
	    $canvas_x1 = $zoomfac / 2 + $zoomfac * $mousex;
	    $canvas_y1 = $zoomfac / 2 + $zoomfac * $mousey;
	    $line = $drawingcanvas
		->createLine($canvas_x0, $canvas_y0,
			     $canvas_x1, $canvas_y1,
			     -fill => $foreground,
			     -arrow => "last",
			     -stipple => 'gray75',
			     -width => $zoomfac,
			     -arrowshape => [$zoomfac, $zoomfac, $zoomfac]);

	}
	$drawingcanvas->update();
	if ($mouse3down) { # cancelled
	    if ($line) { $drawingcanvas->delete($line); }
	    start_tool(\&warp_tool, $warp_button, $select_button, $warp_frame);
	    info("aborted\n");
	    return;
	} elsif (!$mouse1down) {
	    if ($x0 == $mousex and $y0 == $mousey) {
		if ($line) { $drawingcanvas->delete($line); }
		info("aborted\n");
		return;
	    }
	    if ($line) { $drawingcanvas->delete($line); }
	    warp($x0, $y0, $mousex, $mousey);
	    start_tool(\&warp_tool, $warp_button, $select_button, $warp_frame);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub warp($$$$)
{
    my ($x0, $y0, $x1, $y1) = @_;

    info("warping ... ");
    enable_undo();
    my $dx = $x1 - $x0;
    my $dy = $y1 - $y0;

    my @new_image;
    
    my $fx1 = spline(0, $x1, 0.01 * $warpfac);
    my $fx2 = spline($width-1, $x1, 0.01 * $warpfac);
    my $fy1 = spline(0, $y1, 0.01 * $warpfac);
    my $fy2 = spline($height-1, $y1, 0.01 * $warpfac);

    my @xfak;
    for (my $x = 0; $x < $width; $x++) {
	$xfak[$x] = $x < $x1 ? &$fx1($x) : &$fx2($x);
    }
    my @yfak;
    for (my $y = 0; $y < $height; $y++) {
	$yfak[$y] = $y < $y1 ? &$fy1($y) : &$fy2($y);
    }

    for (my $x = 0; $x < $width; $x++) {
	for (my $y = 0; $y < $height; $y++) {
	    my $fak = $xfak[$x] * $yfak[$y];
	    my $xx = $x - $fak * $dx;
	    my $yy = $y - $fak * $dy;
	    $new_image[$y][$x] = smoothpixel($xx, $yy);
	}
    }
    @pixelmatrix = @new_image;
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

# auxiliary function for warping
# spline($x0, $x1, $alpha) returns a reference to a monotonic smooth function
# f:[min(x0,x1), max(x0,x1)]->[0,1] with
# f(x0)=0, f(x1)=1, f'(x0)=f'(x1)=1.
# The parameter alpha determines the shape of this function (f(alpha)=0.5)
sub spline($$$)
{
    my ($x0, $x1, $alpha) = @_;

    if ($x0 == $x1) {
	print STDERR "spline: invalid arguments\n";
	return sub { return 0; };
    }

    my $flag = $x0 < $x1 ? 1 : -1;

    if ($alpha > 1) { $alpha = 1; }
    if ($alpha < 0) { $alpha = 0; }

    $alpha = 0.05 + 0.9 * $alpha;
    
    $alpha = 0.05 + 0.9 * $alpha;
    my $xmid = 1. - $alpha;
    my $b = 1. / ( (1-$xmid)*(1-$xmid) + (1-$xmid)*$xmid );
    my $a = $b * (1-$xmid) / $xmid;
    my $z = $x1 - $x0;
    my $z2 = $z * $z;
    $a /= $z2;
    $b /= $z2;
    $xmid = $x0 + $xmid * $z;
    my $xmin = $x0;
    my $xmax = $x1;
    
    return sub {
	my $x = shift;
	if ( ($flag == 1 && $x < $xmid) || ($flag == -1 && $x > $xmid) ) {
	    my $z = $x - $xmin;
	    return $a * $z * $z;
	} else {
	    $z = $xmax - $x;
	    return 1 - $b * $z * $z;
	}
    };
}


# ----------------------------------------------------------------------
# selection handling
# ----------------------------------------------------------------------

sub create_selection_rectangle($$$$$$)
{
    my ($x0, $y0, $x1, $y1, $fill, $stipple) = @_;
    my ($u0, $v0, $u1, $v1);
    if ($x0 < $x1) {
	($u0, $u1) = ($x0, $x1);
    } else {
	($u0, $u1) = ($x1, $x0);
    }
    if ($y0 < $y1) {
	($v0, $v1) = ($y0, $y1);
    } else {
	($v0, $v1) = ($y1, $y0);
    }
    return $drawingcanvas
	->createRectangle($u0 * $zoomfac, $v0 * $zoomfac,
			  ($u1 + 1) * $zoomfac, ($v1 + 1) * $zoomfac,
			  -fill => $fill,
			  -outline => "black",
			  -width => 2,
			  -stipple => $stipple);
}


# ----------------------------------------------------------------------

sub select_region_tool()
{
    my ($x0, $y0) = ($mousex, $mousey);
    my ($xold, $yold) = (-1, -1);
    my $canvas_x0 = $zoomfac / 2 + $zoomfac * $mousex;
    my $canvas_y0 = $zoomfac / 2 + $zoomfac * $mousey;
    my ($canvas_x1, $canvas_y1);
    my $rect;
    info("Starting selection at ($x0,$y0) (press button 3 to abort) ... ");

    for (;;) {
	$drawingcanvas->update();
	if ($mousex != $xold or $mousey != $yold) {
	    ($xold, $yold) = ($mousex, $mousey);
	    if ($rect) { $drawingcanvas->delete($rect); }
	    $rect = create_selection_rectangle($x0,$y0, $mousex, $mousey,
					       "white", "gray50");
	}
	if ($mouse3down) { #cancelled
	    $drawingcanvas->delete($rect);
	    info("aborted\n");
	    start_tool(\&select_region_tool, $select_button, 0, 0); 
	    return;
	} elsif (!$mouse1down) {
	    my $u1 = min($x0, $mousex);
	    my $v1 = min($y0, $mousey);
	    my $u2 = max($x0, $mousex);
	    my $v2 = max($y0, $mousey);
	    info("done (rectangle [$u1,$u2]x[$v1,$v2] selected)\n");
	    select_region_dialog($u1, $v1, $u2, $v2, $rect);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub select_region_dialog($$$$$)
{
    my ($x0, $y0, $x1, $y1, $rect) = @_;
    my $DW = $mw->Toplevel(-title => 'Selection Dialog');
    $DW->grab();
    $DW->protocol('WM_DELETE_WINDOW' => sub {});
    $DW->transient($DW->Parent->toplevel);
    $DW->resizable(0,0);
    $DW->geometry(sprintf("+%d+%d", $DW->pointerx(), $DW->pointery()));
    
    $DW->Button(-text => 'Cut', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_cut, $DW, @_])
	->grid(-column => 0, -row => 0, -sticky => 'nsew');
    $DW->Button(-text => 'Clip', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_clip, $DW, @_])
	->grid(-column => 0, -row => 1, -sticky => 'nsew');
    $DW->Button(-text => 'Move', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_move, $DW, @_, 1])
	->grid(-column => 0, -row => 2, -sticky => 'nsew');
    $DW->Button(-text => 'Copy', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_move, $DW, @_, 0])
	->grid(-column => 0, -row => 3, -sticky => 'nsew');
    
    $DW->Button(-text => 'Flip Vertically', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_flip_vert, $DW, @_])
	->grid(-column => 1, -row => 0, -sticky => 'nsew');
    $DW->Button(-text => 'Flip Horizontally', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_flip_horiz, $DW, @_])
	->grid(-column => 1, -row => 1, -sticky => 'nsew');
    
    $DW->Button(-text => 'Color Equalizer', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_color_dialog, $DW, @_])
	->grid(-column => 1, -row => 2, -sticky => 'nsew');
    $DW->Button(-text => 'Sample Colorizer', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_colorize_dialog, $DW, @_])
	->grid(-column => 1, -row => 3, -sticky => 'nsew');
    $DW->Button(-text => 'Gaussian Blur', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_gaussian_blur_dialog, $DW, @_])
	->grid(-column => 1, -row => 4, -sticky => 'nsew');
    $DW->Button(-text => 'Isolated Pixels', -anchor => 'w', 
		-padx => 0, -pady => 0, -width => 16,
		-command => [\&select_region_remove_isolated_dialog, $DW, @_])
	->grid(-column => 1, -row => 5, -sticky => 'nsew');

    if (@regionfilters) {
	my $plug_button = $DW->Menubutton(-text => "Apply Plugin", 
					 -padx => 0, -pady => 0, -width => 16,
					 -tearoff => 0, -relief => "raised",
					 -menuitems => [])
	    ->grid(-column => 2, -row => 0, -sticky => 'nsew');
	foreach my $plugin (@regionfilters) {
	    $plug_button->AddItems(['command' => $plugin->alias(),
				    -command => [\&select_region_apply_plugin,
						 $DW, @_, $plugin]]);
	}
    }
    
    $DW->Button(-text => 'Cancel', -pady => 0,
		-command => [\&select_region_cancel, $DW, $rect])
	->grid(-column => 0, -row => 6, -columnspan => 3, -sticky => 'nsew');
}


# ----------------------------------------------------------------------

sub select_region_cancel($$)
{
    my ($DW, $rect) = @_;
    $drawingcanvas->delete($rect);
    start_tool(\&select_region_tool, $select_button, 0, 0); 
    $DW->destroy();
}

# ----------------------------------------------------------------------


sub select_region_cut($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $drawingcanvas->delete($rect); 
    $DW->destroy();
    clipboard_add(save_to_buffer($x0, $y0, $x1, $y1));
    enable_undo();
    delete_rectangle($x0, $y0, $x1, $y1);
    info("Cutted rectangle was added to clipboard (", clipboard_items(),
	 " item(s) in clipboard)\n");
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_move($$$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect, $erase_flag) = @_;
    $DW->destroy();
    $drawingcanvas->grab();
    info("Starting selection move at ($x0,$y0) (press button 3 to abort)",
	 " ... ");

    # Save selected rectangle to buffer
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);

    $drawingcanvas->itemconfigure($rect, -stipple => "gray50");
    my $rect2 = create_selection_rectangle($x0,$y0,$x1,$y1,
					   "white", "gray25");
    my ($xold, $yold) = ($x0, $y0);
    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    $drawingcanvas->move($rect2, ($mousex-$xold) * $zoomfac,
				 ($mousey-$yold) * $zoomfac);
	    ($xold, $yold) = ($mousex, $mousey);
	}
	$drawingcanvas->update();
	if ($mouse3down) { #cancelled
	    $drawingcanvas->grabRelease();
	    $drawingcanvas->delete($rect); 
	    $drawingcanvas->delete($rect2); 
	    info("aborted\n");
	    start_tool(\&select_region_tool, $select_button, 0, 0);
	    return;
	} elsif ($mouse1down) {
	    $drawingcanvas->grabRelease();
	    $drawingcanvas->delete($rect);
	    $drawingcanvas->delete($rect2);
	    enable_undo();
	    $erase_flag and delete_rectangle($x0, $y0, $x1, $y1);
	    insert_buffer($mousex, $mousey, $buffer);	    
	    info("done\n");
	    start_tool(\&select_region_tool, $select_button, 0, 0);
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub select_region_clip($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    $drawingcanvas->delete($rect); 
    clipboard_add(save_to_buffer($x0, $y0, $x1, $y1));
    info("Selected rectangle was added to clipboard (", clipboard_items(),
	 " item(s) in clipboard)\n");
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_color_dialog($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    color_dialog($buffer, $x0, $y0);
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_gaussian_blur_dialog($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    gaussian_blur_buffer_dialog($buffer, $x0, $y0);
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_remove_isolated_dialog($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    remove_isolated_buffer_dialog($buffer, $x0, $y0);
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_flip_vert($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    enable_undo();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    delete_rectangle($x0, $y0, $x1, $y1);
    @$buffer = reverse @$buffer;
    insert_buffer($x0, $y0, $buffer);	    
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_flip_horiz($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    enable_undo();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    delete_rectangle($x0, $y0, $x1, $y1);
    foreach (@$buffer) {
	my @tmp = reverse(@$_);
	$_ = \@tmp;
    }
    insert_buffer($x0, $y0, $buffer);	    
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_colorize_dialog($$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect) = @_;
    $DW->destroy();
    my $buffer = save_to_buffer($x0, $y0, $x1, $y1);
    sample_colorize_dialog($buffer, $x0, $y0);
    $drawingcanvas->delete($rect); 
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------

sub select_region_apply_plugin($$$$$$$)
{
    my ($DW, $x0, $y0, $x1, $y1, $rect, $plugin) = @_;

    $DW->destroy();       
    $drawingcanvas->delete($rect); 
    info("Applying plugin ", $plugin->alias(), " to selection ... ");

    # apply plugin to the selected region
    my $shellcmd = $plugin->plugin_dialog($mw, 0);
    if (! $shellcmd) {
	start_tool(\&select_region_tool, $select_button, 0, 0);
	return info("aborted\n");
    }
    my $bufref_old = save_to_buffer($x0, $y0, $x1, $y1);
    my $tmpfile1 = "$tmpdir/plugin_input.xpm";
    my $tmpfile2 = "$tmpdir/plugin_output.xpm";
    # save to temporary file
    save_buffer_to_xpm($tmpfile1, $bufref_old) or return info("aborted\n");
    # apply shell command
    my $success = try_shell_command("cat $tmpfile1 | $shellcmd > $tmpfile2");
    if (! $success) {
	start_tool(\&select_region_tool, $select_button, 0, 0);
	return info("aborted\n");
    }
    my $bufref_new =  load_xpm_to_buffer($tmpfile2);
    if (! $bufref_new) {
	start_tool(\&select_region_tool, $select_button, 0, 0);
	return info("aborted\n");
    }
    
    # check dimensions
    my ($oldwidth, $oldheight) = dimensions($bufref_old);
    my ($newwidth, $newheight) = dimensions($bufref_new);
    if ($oldwidth != $newwidth or $oldheight ne $newheight) {
	message("Region filters must not change dimensions.\n",
		"You should change the type of this plugin ",
		"in the plugin editor.");
	start_tool(\&select_region_tool, $select_button, 0, 0);
	return info("aborted\n");
    }
    
    # insert transformed buffer
    enable_undo();
    insert_buffer($x0, $y0, $bufref_new);
    info("done\n");
    start_tool(\&select_region_tool, $select_button, 0, 0);
}

# ----------------------------------------------------------------------
# Transformations
# ----------------------------------------------------------------------

sub resize_dialog()
{
    my $DB = $mw->DialogBox(-title => "Resize",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    my $new_width = $width;
    my $new_height = $height;
    my $min = 2;

    $DB->Label(-text => "Current size: $width".'x'."$height")
	->pack(-anchor => 'w');
    $DB->Scale(-orient => "horizontal", -label => "New width",
	       -from => $min, -to => 2 * $width, -length => 300,
	       -variable => \$new_width)
	->pack();
    $DB->Scale(-orient => "horizontal", -label => "New height",
	       -from => $min, -to => 2 * $height, -length => 300,
	       -variable => \$new_height)
	->pack();

    $DB->Show() eq "Ok" or return;
    if ($new_width != $width or $new_height != $height) {
	info('Resizing image ... ');
	resize_image($new_width, $new_height);
	info("done\n");
    }
}

# ----------------------------------------------------------------------

sub resize_image($$)
{
    my ($new_width, $new_height) = @_;

    enable_undo();
    
    # adjust number of rows
    if ($new_height < $height) {
	splice(@pixelmatrix, $new_height);
    } elsif ($new_height > $height) {
	for (my $i = $height; $i < $new_height; $i++) {
	    for (my $j = 0; $j < $new_width; $j++) {
		$pixelmatrix[$i][$j] = "";
	    }
	}
    }
    
    # adjust number of columns (only for old rows)
    if ($new_width < $width) {
	for (my $i = 0; $i < min($height, $new_height); $i++) {
	    splice( @{$pixelmatrix[$i]}, $new_width);
	}
    } elsif ($new_width > $width) {
	for (my $i = 0; $i < min($new_height, $height); $i++) {
	    for (my $j = $width; $j < $new_width; $j++) {
		$pixelmatrix[$i][$j] = "";
	    }
	}
    }
    ($width, $height) = ($new_width, $new_height);
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    draw_image();
}


# ----------------------------------------------------------------------

sub add_border_dialog()
{
    my $DB = $mw->DialogBox(-title => "Add Border",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);
    
    my ($xborder, $yborder) = (0, 0);

    $DB->Scale(-orient => "horizontal", -label => "Left/Right",
	       -from => 0, -to => 20, -length => 200,
	       -variable => \$xborder)->pack();
    $DB->Scale(-orient => "horizontal", -label => "Top/Bottom",
	       -from => 0, -to => 20, -length => 200,
	       -variable => \$yborder)->pack();

    $DB->Show() eq "Ok" or return;

    if ($xborder or $yborder) { add_border($xborder, $yborder); }
}



# ----------------------------------------------------------------------

sub add_border($$)
{
    my ($xborder, $yborder) = @_;

    info("Adding transparent border ($xborder x $yborder) ... ");

    enable_undo();
    $width += 2 * $xborder;
    $height += 2 * $yborder;
    
    # add left and right border
    foreach my $row(@pixelmatrix) {
	unshift @$row, ("") x $xborder;
	push @$row, ("") x $xborder;
    }
    
    # add top and bottom border
    for (my $i = 0; $i < $yborder; $i++) {
	my @tmp1 = ("") x $width;
	my @tmp2 = ("") x $width;
	unshift @pixelmatrix, \@tmp1;
	push @pixelmatrix, \@tmp2;
    }
    info("redrawing ... ");
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

# Utility function for transformations like scaling or rotating.
# If the arguments ($x,$y) are not integer, smoothpixel($x,$y) 
# returns the weighted mean of the max. four pixels in the neighbourhood
# of ($x,$y).
sub smoothpixel($$;$)
{
    my ($x0, $y0, $buffer) = @_;
    $buffer ||= \@pixelmatrix;
    my ($xmax, $ymax) = dimensions($buffer);
    my ($ix, $iy) = (int(floor($x0)), int(floor($y0)));
    my ($x,$y);
    my ($err_x, $err_y, $weight);
    
    # determine neighbours of ($x0, $y0) and rounding errors
    my $transparent_neighbours = 0;
    my $transparent_wsum = 0;
    my @visible_neighbours = ();
    my @visible_weights = ();
    my $visible_wsum = 0;
    foreach ([$ix,$iy], [$ix+1,$iy], [$ix,$iy+1],[$ix+1,$iy+1]) {
	($x,$y) = @$_;
	($x < 0 || $x >= $xmax || $y < 0 || $y >= $ymax) and next;
	$err_x = $x - $x0;
	$err_y = $y - $y0;
	$weight = 1 - abs($err_x * $err_y);
	if ($buffer->[$y][$x]) {
	    push @visible_neighbours, $buffer->[$y][$x];
	    push @visible_weights, $weight;
	    $visible_wsum += $weight;
	} else {
	    $transparent_neighbours++;
	    $transparent_wsum +=  $weight;
	}
    }
    @visible_neighbours or return "";
    $visible_wsum > $transparent_wsum or return "";

    # now calculate the weighted mean of the visible neighbours
    my ($r, $g, $b) = (0, 0, 0);
    my ($r1, $g1, $b1);
    for (my $i = 0; $i < scalar(@visible_neighbours); $i++) {
	($r1, $g1, $b1) = HextoRGB($visible_neighbours[$i]);
	$r += $visible_weights[$i] * $r1;
	$g += $visible_weights[$i] * $g1;
	$b += $visible_weights[$i] * $b1;
    }
    $r = int($r / $visible_wsum);
    $g = int($g / $visible_wsum);
    $b = int($b / $visible_wsum);
    return RGBtoHex($r, $g, $b);
}

# ----------------------------------------------------------------------

# Utility function for transformations like scaling or rotating.
sub bestpixel($$;$)
{
    my ($x0, $y0, $buffer) = @_;
    $buffer ||= \@pixelmatrix;
    my ($xmax, $ymax) = dimensions($buffer);
    my ($x, $y) = (int($x0 +0.5), int($y0+0.5));

    if ($x < 0 || $x >= $xmax || $y < 0 || $y >= $ymax) {
	return '';
    } else {
	return $buffer->[$y][$x];
    }
}

# ----------------------------------------------------------------------

sub scale_dialog()
{
    my $DB = $mw->DialogBox(-title => "Scale",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);
    
    my $smoothing = 0;
    my $new_width = $width;
    my $new_height = $height;
    my $min = 2;
    my $max = max(2 * $width, 2 * $width, 64);
    my $scale_len = min(max($max - $min, 250), 400);
    my $keep_aspect = 1;
    my $ratio = $height / $width;

    $DB->Label(-text => "Current size: $width".'x'."$height")
	->grid(-row => 0, -column => 0, -columnspan => 2);
    $DB->Checkbutton(-text => "Keep aspect ratio", 
		     -variable => \$keep_aspect,
		     -command => [\&keep_x_aspect, \$keep_aspect,
				  $ratio, \$new_width, \$new_height])
	->grid(-row => 1, -column => 0);
    $DB->Checkbutton(-text => 'Smoothing', -variable => \$smoothing)
	->grid(-row => 1, -column => 1);
    $DB->Scale(-orient => "horizontal", -label => "New width",
	       -from => $min, -to => $max, -length => $scale_len,
	       -variable => \$new_width,
	       -command => [\&keep_x_aspect, \$keep_aspect,
			    $ratio, \$new_width, \$new_height])
	->grid(-row => 2, -column => 0, -columnspan => 2);
    $DB->Scale(-orient => "horizontal", -label => "New height",
	       -from => $min, -to => $max, -length => $scale_len,
	       -variable => \$new_height,
	       -command => [\&keep_y_aspect, \$keep_aspect,
			    $ratio, \$new_width, \$new_height])
	->grid(-row => 3, -column => 0, -columnspan => 2);

    $DB->Show() eq "Ok" or return;
    if ($new_width != $width or $new_height != $height) {
	info('Scaling image ... ');
	scale_image($new_width, $new_height, $smoothing);
	info("done\n");
    }
}

# ----------------------------------------------------------------------

sub keep_x_aspect($$$$)
{
    my ($flag_ref, $ratio, $x_ref, $y_ref) = @_; 
    $$flag_ref or return;
    $$y_ref = int($ratio * $$x_ref);
}

# ----------------------------------------------------------------------

sub keep_y_aspect($$$$)
{
    my ($flag_ref, $ratio, $x_ref, $y_ref) = @_;
    $$flag_ref or return;
    $$x_ref = int($$y_ref / $ratio);
}

# ----------------------------------------------------------------------

sub scale_image($$$)
{
    my ($new_width, $new_height, $smoothing) = @_;
    enable_undo();

    my @new_image;

    my $ifac = $height / $new_height;
    my $jfac = $width / $new_width;
    for (my $i = 0; $i < $new_height; $i++) {
	for (my $j = 0; $j < $new_width; $j++) {
	    $new_image[$i][$j] = 
		$smoothing ? smoothpixel($j * $jfac, $i * $ifac) :
                             bestpixel($j * $jfac, $i * $ifac);
	}
    }
    @pixelmatrix = @new_image;
    ($width, $height) = ($new_width, $new_height);
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    draw_image();
}

# ----------------------------------------------------------------------

sub rotate_dialog()
{
    my $angle = 0;
    my $smoothing = 0;
    my $clockwise = 1;
    my $DB = $mw->DialogBox(-title => 'Select Rotation Angle',
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Checkbutton(-text => 'Rotate clockwise', -variable => \$clockwise)
	->grid(-row => 0, -column => 0, -sticky => 'w');

    $DB->Checkbutton(-text => 'Smoothing', -variable => \$smoothing)
	->grid(-row => 0, -column => 1, -sticky => 'w');
    $DB->Scale(-label => 'Rotation angle', -orient => 'horizontal',
	       -from => 0, -to => 180, -length => 180,
	       -variable => \$angle)
	->grid(-row => 1, -column => 0, -columnspan => 2);
    $DB->Radiobutton(-text => '90', -variable => \$angle, -value => 90)
	->grid(-row => 2, -column => 0, -sticky => 'w');
    $DB->Radiobutton(-text => '180', -variable => \$angle, -value => 180)
	->grid(-row => 2, -column => 1, -sticky => 'w');
    
    $DB->Show() ne 'Ok' and return;

    if ($angle == 90) {
	rotate_90($clockwise);
	return;
    } elsif ($angle == 180) {
	flip_vert();
	return;
    }

    info("Rotating image ... ");
    enable_undo();
    my $phi = $angle * 3.1215 / 180;
    $clockwise or $phi = - $phi;
    my $cosphi = cos($phi);
    my $sinphi = sin($phi);

    # Calculate size of the rotated image
    my ($xmin, $xmax, $ymin, $ymax) = (0, 0, 0, 0);
    foreach ( [$width, 0], [0, $height], [$width, $height]) {
	my ($x, $y) = @$_;
	my ($u, $v) = ($x * $cosphi + $y * $sinphi, 
		       - $x * $sinphi + $y * $cosphi);
    
	$xmin = min($xmin, $u);
	$xmax = max($xmax, $u);
	$ymin = min($ymin, $v);
	$ymax = max($ymax, $v);
    }
    $xmin = int(floor($xmin)) - 2;
    $xmax = int(ceil($xmax)) + 2;
    $ymin = int(floor($ymin)) - 2;
    $ymax = int(ceil($ymax)) + 2;
    my $new_width = $xmax - $xmin;
    my $new_height = $ymax - $ymin;
    my @new_image;
    my ($x1, $y1, $u, $v);
    for (my $y = $ymin; $y < $ymax; $y++) {
	for (my $x = $xmin; $x < $xmax; $x++) {
	    ($u, $v) = ($x * $cosphi - $y * $sinphi, 
			+ $x * $sinphi + $y * $cosphi);
	    $new_image[$y-$ymin][$x-$xmin] 
		= $smoothing ? smoothpixel($u, $v) : bestpixel($u, $v);
	}
    }
    info('calculating new size ... ');
    autocrop_buffer(\@new_image);
    ($width, $height) = dimensions(\@new_image);
    @pixelmatrix = @new_image;
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

sub rotate_90($)
{
    my $clockwise = shift;
    info("Rotating image ... ");
    enable_undo();
    my @new_image;
    
    if ($clockwise) {
	for (my $i = 0; $i < $height; $i++) {
	    for (my $j = 0; $j < $width; $j++) {
		$new_image[$width - $j - 1][$i] = $pixelmatrix[$i][$j];
	    }
	}
    } else {
	for (my $i = 0; $i < $height; $i++) {
	    for (my $j = 0; $j < $width; $j++) {
		$new_image[$j][$height - $i - 1] = $pixelmatrix[$i][$j];
	    }
	}
    }
    @pixelmatrix = @new_image;
    ($width, $height) = ($height, $width);
    display_info();
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

sub autocrop()
{
    info("Applying autocrop ... ");
    enable_undo();
    autocrop_buffer(\@pixelmatrix);
    ($width, $height) = dimensions(\@pixelmatrix);
    $zoomfac = propose_zoomfac($width, $height);
    display_info();
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

# remove blank borders of the image in $buffer
sub autocrop_buffer($)
{
    my $buffer = shift;
    my ($w, $h) = dimensions($buffer);

    my $i1;  # first row which is not blank
    my $j1;  # first column which is not blank
    my $i2;  # last blank row
    my $j2;  # last blank column
    
    # search first row which is not blank
    $i1 = $h;
    BREAK1: for (my $i = 0; $i < $h; $i++) {
	for (my $j = 0; $j < $width; $j++) {
	    if ($buffer->[$i][$j]) { $i1 = $i; last BREAK1; }
	}
    }
    $i1 == $h and return; ; # do not autocrop an empty image

    # search last blank row
    $i2 = $i1 + 1;
    BREAK2: for (my $i = $h-1; $i > $i1; $i--) {
	for (my $j = 0; $j < $w; $j++) {
	    if ($buffer->[$i][$j]) { $i2 = $i+1; last BREAK2; }
	}
    }

    # search first column which is not blank
    $j1 = $w;
    BREAK3: for (my $j = 0; $j < $w; $j++) {
	for (my $i = 0; $i < $h; $i++) {
	    if ($buffer->[$i][$j]) { $j1 = $j; last BREAK3; }
	}
    }

    # search last blank row
    $j2 = $j1 + 1;
    BREAK4: for (my $j = $w-1; $j > $j1; $j--) {
	for (my $i = 0; $i < $h; $i++) {
	    if ($buffer->[$i][$j]) { $j2 = $j+1; last BREAK4; }
	}
    }
    
    $i2-$i1 == $h and $j2-$j1 == $w and return; 

    # now shrink the image
    splice @$buffer, 0, $i1;
    splice @$buffer, $i2-$i1;
    foreach my $row (@$buffer) {
	splice @$row, 0, $j1;
	splice @$row, $j2-$j1;
    }
}

# ----------------------------------------------------------------------

sub flip_vert()
{
    info("Flipping vertically ... ");
    enable_undo();
    @pixelmatrix = reverse @pixelmatrix;
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------

sub flip_horiz()
{
    info("Flipping horizontally ... ");
    enable_undo();
    foreach (@pixelmatrix) {
	my @tmp = reverse(@$_);
	$_ = \@tmp;
    }
    draw_image();
    info("done\n");
}

# ----------------------------------------------------------------------
# Colorizing
# ----------------------------------------------------------------------

sub color_dialog($;$$)
{
    my ($buffer, $x, $y) = @_;
    my ($r_exp, $g_exp, $b_exp, $val_exp, $saturation_exp, $contrast_exp) = 
	(100, 100, 100, 100, 100, 100);

    my $DB = $mw->DialogBox(-title => "Color Equalizer",
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Label(-text => 'more grey', -bg => 'grey')
	->grid(-row => 0, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'more', -bg => 'red', -fg => 'blue')
	->grid(-row => 0, -column => 2, -sticky => 'ew');
    $DB->Label(-text => 'colors', -bg => 'green', -fg => 'red')
	->grid(-row => 0, -column => 3, -sticky => 'ew');
    $DB->Label(-text => 'more red', -bg => 'red')
	->grid(-row => 1, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'more cyan', -bg => 'cyan')
	->grid(-row => 1, -column => 2, -sticky => 'ew', -columnspan => 2);
    $DB->Label(-text => 'more green', -bg => 'green')
	->grid(-row => 2, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'more magenta', -bg => 'magenta')
	->grid(-row => 2, -column => 2, -sticky => 'ew', -columnspan => 2);
    $DB->Label(-text => 'more blue', -bg => 'blue')
	->grid(-row => 3, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'more yellow', -bg => 'yellow')
	->grid(-row => 3, -column => 2, -sticky => 'ew', -columnspan => 2);
    $DB->Label(-text => 'darker', -bg => 'black', -fg => 'white')
	->grid(-row => 4, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'brighter', -bg => 'white')
	->grid(-row => 4, -column => 2, -sticky => 'ew', -columnspan => 2);

    $DB->Label(-text => 'low contrast', -bg => '#777777', -fg => '#999999')
	->grid(-row => 5, -column => 0, -sticky => 'ew');
    $DB->Label(-text => 'high contrast', -bg => 'white')
	->grid(-row => 5, -column => 2, -sticky => 'ew', -columnspan => 2);

    $DB->Scale(-variable => \$saturation_exp,
	       -orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 0, -column => 1);
    $DB->Scale( -variable => \$r_exp,
		-orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 1, -column => 1);
    $DB->Scale(-variable => \$g_exp,
	       -orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 2, -column => 1);
    $DB->Scale(-variable => \$b_exp,
	       -orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 3, -column => 1);
    $DB->Scale(-variable => \$val_exp,
	       -orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 4, -column => 1);

    $DB->Scale(-variable => \$contrast_exp,
	       -orient => "horizontal", -showvalue => 0,
	       -from => 0, -to => 200, -length => 200)
       ->grid(-row => 5, -column => 1);

    $DB->Show() ne 'Ok' and return;
    enable_undo();
    my $gamma_red = 0.1 * 10 ** (0.01 * $r_exp);
    my $gamma_green = 0.1 * 10 ** (0.01 * $g_exp);
    my $gamma_blue = 0.1 * 10 ** (0.01 * $b_exp);
    my $val_fac = 0.25 * 4 ** (2 - (0.01 * $val_exp));
    my $saturation = 0.1 * 10 ** (2 - (0.01 * $saturation_exp));
    my $gamma_contrast = 0.25 * 4 ** (2 - (0.01 * $contrast_exp));

    info('Starting color equalizer ... ');
    if ($saturation != 100) {
	info('adjusting HSV saturation ... ');
	adjust_saturation($buffer, $saturation) ;
    }
    if 	($gamma_red != 100 or $gamma_green != 100 or $gamma_blue != 100) {
	info('RGB gamma correction ... ');
	gamma_correct($buffer, $gamma_red, $gamma_green, $gamma_blue);
    }
    if ($val_fac != 100) {
	info('adjusting HSV value ... ');
	adjust_brightness($buffer, $val_fac);
    }
    if ($gamma_contrast != 100) {
	info('adjusting contrast ... ');
	adjust_contrast($buffer, $gamma_contrast);
    }


    info('redrawing ... ');
    if ($buffer eq \@pixelmatrix) {
	draw_image();
    } else {
	insert_buffer($x, $y, $buffer);
    }
    info("done\n");
}

# ----------------------------------------------------------------------

sub gamma_correct($$$$)
{
    my ($buffer, $gamma_r, $gamma_g, $gamma_b) = @_;
    my ($r, $g, $b);
    foreach my $line(@$buffer) {
	foreach my $pixel(@$line) {
	    $pixel or next;
	    ($r, $g, $b) = HextoRGB($pixel);
	    $r = int(($r/255) ** $gamma_r * 255);
	    if ($r > 255) { $r = 255; }
	    $g = int(($g/255) ** $gamma_g * 255);
	    if ($g > 255) { $g = 255; }
	    $b = int(($b/255) ** $gamma_b * 255);
	    if ($b > 255) { $b = 255; }
	    $pixel = RGBtoHex($r, $g, $b);
	}
    }   
}

# ----------------------------------------------------------------------

sub adjust_brightness($$)
{
    my ($buffer, $fac) = @_;
    my ($r, $g, $b, $h, $s, $v);
    foreach my $line(@$buffer) {
	foreach my $pixel(@$line) {
	    $pixel or next;
	    ($r, $g, $b) = HextoRGB($pixel);
	    ($h,$s,$v) = RGBtoHSV($r,$g,$b);
	    $v = $v ** $fac;
	    ($r,$g,$b) = HSVtoRGB($h,$s,$v);
	    $pixel = RGBtoHex($r,$g,$b);
	}
    }   
}

# ----------------------------------------------------------------------

sub adjust_saturation($$)
{
    my ($buffer, $colorfac) = @_;
    my ($r, $g, $b, $h, $s, $v);
    foreach my $line(@$buffer) {
	foreach my $pixel(@$line) {
	    $pixel or next;
	    ($r, $g, $b) = HextoRGB($pixel);
	    ($h,$s,$v) = RGBtoHSV($r,$g,$b);
	    $s = $s ** $colorfac;
	    ($r,$g,$b) = HSVtoRGB($h,$s,$v);
	    $pixel = RGBtoHex($r,$g,$b);
	}
    }
}

# ----------------------------------------------------------------------

sub adjust_contrast($$)
{
    my ($buffer, $gamma) = @_;
    my ($r, $g, $b, $d);
    foreach my $line(@$buffer) {
	foreach my $pixel(@$line) {
	    $pixel or next;
	    ($r, $g, $b) = HextoRGB($pixel);
	    foreach ($r, $g, $b) {
		$d = (abs($_ - 127.5) / 127.5) ** $gamma * 127.5;
		if ($_ > 127.5) {
		    $_ = 127.5 + $d;
		    if ($_ > 255) { $_ = 255; }
		} else {
		    $_ = 127.5 - $d;
		    if ($_ < 0) { $_ = 0; }
		}
	    }
	    $pixel = RGBtoHex($r,$g,$b);
	}
    }
}

# ----------------------------------------------------------------------

sub sample_colorize_dialog($;$$)
{
    my ($buffer, $x, $y) = @_;

    my @labels = sort keys %clipboard_photos;
    my $selection = $labels[0];
    if (! %clipboard_buffers) {
	message('You must load an image to the clipboard first');
	return;
    }

    my $DB = $mw->DialogBox(-title => 'Sample Colorizer', 
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Label(-justify => 'left', -text => 
	       'Choose sample from which the colors should be taken')
	->pack(-fill => 'x');

    my $frame = $DB->Frame()->pack(-anchor => 'w');
    my $i = 1;
    my ($row, $column) = (0, 0);
    foreach my $label (@labels) {
	$frame->Radiobutton(-variable => \$selection, -value => $label,
			    -text => "Clip $i")
	    ->grid(-row => $row, -column => $column);
	$frame->Label(-image => $clipboard_photos{$label})
	    ->grid(-row => $row, -column => $column + 1, -sticky => 'w');
 	if ($i++ % 2 == 0) {
	    $column = 0;
	    $row++;
	} else {
	    $column = 2;
	}
    }
    
    ($DB->Show() eq 'Ok') and $selection or return;

    enable_undo();
    sample_colorize($buffer, $clipboard_buffers{$selection});
    if ($buffer eq \@pixelmatrix) {
	draw_image();
    } else {
	insert_buffer($x, $y, $buffer);
    }
}

# ----------------------------------------------------------------------

sub sample_colorize($$)
{
    my ($buffer1, $buffer2) = @_;
    info( 'Sample colorizer: creating color lookup table ... ');
    
    # extract colors from buffer1, buffer2
    my (@colors1, @colors2);
    my %seen;
    foreach my $row(@$buffer1) {
	foreach my $color(@$row) {
	    $color or next;
	    if (!$seen{$color}) {
		push @colors1, $color;
		$seen{$color} = 1;
	    }
	}
    }
    undef %seen;
    foreach my $row(@$buffer2) {
	foreach my $color(@$row) {
	    $color or next;
	    if (!$seen{$color}) {
		push @colors2, $color;
		$seen{$color} = 1;
	    }
	}
    }
    if (!(@colors1 && @colors2)) {
	info("aborted\n");
	return;
    }

    # build lookup table
    my %lookup;
    my ($color1, $color2, $r1, $g1, $b1, $r2, $g2, $b2, 
	$delta, $best, $deltabest);
    foreach $color1 (@colors1) { # find best match in @colors2
	$deltabest = 1000000;
	($r1, $g1, $b1) = HextoRGB($color1);
	foreach $color2 (@colors2) {
	    ($r2, $g2, $b2) = HextoRGB($color2);
	    $delta = ($r1-$r2) ** 2 + ($g1 - $g2) ** 2 + ($b1 - $b2) ** 2;
	    if ($delta < $deltabest) {
		$deltabest = $delta;
		$best = $color2;
	    }
	}
	$lookup{$color1} = $best;
    }
    info('replacing colors ... ');
    # now replace 
    foreach my $row(@$buffer1) {
	foreach my $color(@$row) {
	    if ($color) { $color = $lookup{$color}; }
	}
    }
    info("done\n");
}

# ----------------------------------------------------------------------

sub gaussian_blur_buffer_dialog($$$)
{
    my ($buffer, $x, $y) = @_;

    my $DB = $mw->DialogBox(-title => 'Blur Options',
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Label(-text => 'Horizontal blur radius:', -anchor => 'w')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$gaussian_blur_rx)
	->grid(-row => 0, -column => 1);
    $DB->Scale(-variable => \$gaussian_blur_rx, 
	       -from => 0, -to => 4, resolution => 1,
	       -orient => 'horizontal', -showvalue => 0, -length => 100)
	->grid(-row => 0, -column => 2);

    $DB->Label(-text => 'Vertical blur radius:', -anchor => 'w')
	->grid(-row => 1, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$gaussian_blur_ry)
	->grid(-row => 1, -column => 1);
    $DB->Scale(-variable => \$gaussian_blur_ry, 
	       -from => 0, -to => 4, resolution => 1,
	       -orient => 'horizontal', -showvalue => 0, -length => 100)
	->grid(-row => 1, -column => 2);

    $DB->Checkbutton(-text => 'Ignore transparent pixels',
		     -variable => \$gaussian_blur_ignore_transparency)
	->grid(-row => 2, -column => 0, -columnspan => 3);

    $DB->Show() ne 'Ok' and return;

    enable_undo();

    gaussian_blur_buffer($buffer, $gaussian_blur_rx, 
			 $gaussian_blur_ry, 
			 $gaussian_blur_ignore_transparency);
    info("Redrawing ... ");
    if ($buffer eq \@pixelmatrix) {
	draw_image();
    } else {
	insert_buffer($x, $y, $buffer);
    }
    info("done\n");
}

# ----------------------------------------------------------------------

sub gaussian_blur_buffer($$$)
{
    my ($buffer, $rx, $ry, $ignore_transparency) = @_;

    info('Applying Gaussian blur (', $rx, 'x', $ry, ') ');
    ($rx == 0 or $rx == 1 or $rx == 2 or $rx == 3) or $rx = 4;
    ($ry == 0 or $ry == 1 or $ry == 2 or $rx == 3) or $ry = 4;
    my $dx = 2 * $rx + 1;
    my $dy = 2 * $ry + 1;

    # smoothing mask
    my @binkoeff = ( [1],
		     [1, 2, 1],
		     [1, 4, 6, 4, 1],
		     [1, 6, 15, 20, 15, 6, 1],
		     [1, 8,  28,  56, 70, 56, 28, 8, 1]
		     );
    my @mask;
    for (my $j = 0; $j < $dx; $j++) {
	for (my $i = 0; $i < $dy; $i++) {
	    $mask[$i][$j] = $binkoeff[$rx][$j] * $binkoeff[$ry][$i];
	}
    }
	
    my @buffer_old = @{matrixclone($buffer)};
    my ($r, $g, $b, $R, $G, $B);
    my ($sum, $weight, $threshhold);
    my ($x1, $y1);
    my $hex;

    my ($xmax, $ymax) = dimensions($buffer);
   
    for (my $y = 0; $y < $ymax; $y++) {
	info('.');
	for (my $x = 0; $x < $xmax; $x++) {
	    ($ignore_transparency and !$buffer_old[$y][$x]) and next;
	    $buffer->[$y][$x] = '';
	    ($R, $G, $B) = (0, 0, 0);
	    $sum = 0;
	    $threshhold = 0;
	    for (my $j = - $rx; $j <= $rx; $j++) {
		$x1 = $x + $j;
		($x1 >= 0 and $x1 < $xmax) or next;
		for (my $i = - $ry; $i <= $ry; $i++) {		    
		    $y1 = $y + $i;
		    ($y1 >= 0 and $y1 < $ymax) or next;
		    $weight = $mask[$ry + $i][$rx + $j];	
		    $threshhold += $weight;
		    ($hex = $buffer_old[$y1][$x1]) or next;
		    $sum += $weight;
		    ($r, $g, $b) = HextoRGB($hex);
		    $R += $weight * $r;
		    $G += $weight * $g,
		    $B += $weight * $b;
		}
	    }
	    if ($ignore_transparency or $sum > $threshhold / 2) {
		$R /= $sum;
		$G /= $sum;
		$B /= $sum;
		$buffer->[$y][$x] = RGBtoHex($R, $G, $B);
	    }
	}
    }
    info( " done\n");
}

# ----------------------------------------------------------------------

sub remove_isolated_buffer_dialog($$$)
{
    my ($buffer, $x, $y) = @_;

    my $DB = $mw->DialogBox(-title => 'Remove Isolated Pixels',
			    -buttons => ['Ok', 'Cancel']);
    $DB->resizable(0,0);

    $DB->Label(-text => 'Remove pixels with less than', -anchor => 'w')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    $DB->Label(-textvariable => \$remove_isolated_min_neighbours)
	->grid(-row => 0, -column => 1);
    $DB->Scale(-variable => \$remove_isolated_min_neighbours, 
	       -from => 1, -to => 3, resolution => 1,
	       -orient => 'horizontal', -showvalue => 0, -length => 100)
	->grid(-row => 0, -column => 2);
    $DB->Label(-text => 'neighbours')
    	->grid(-row => 0, -column => 3);

    $DB->Checkbutton(-text => 'Diagonals are neighbours',
		     -variable => \$remove_isolated_diagonal_neighbours)
	->grid(-row => 1, -column => 0, -columnspan => 3, -sticky => 'w');

    $DB->Checkbutton(-text => 'Remove visible pixels',
		     -variable => \$remove_isolated_remove_visible)
	->grid(-row => 2, -column => 0, -columnspan => 3, -sticky => 'w');
    $DB->Checkbutton(-text => 'Remove transparent pixels',
		     -variable => \$remove_isolated_remove_transparent)
	->grid(-row => 3, -column => 0, -columnspan => 3, -sticky => 'w');

    $DB->Show() ne 'Ok' and return;

    enable_undo();

    remove_isolated_buffer($buffer, 
			   $remove_isolated_min_neighbours, 
			   $remove_isolated_diagonal_neighbours,
			   $remove_isolated_remove_visible, 
			   $remove_isolated_remove_transparent);
    info("Redrawing ... ");
    if ($buffer eq \@pixelmatrix) {
	draw_image();
    } else {
	insert_buffer($x, $y, $buffer);
    }
    info("done\n");
}

# ----------------------------------------------------------------------

sub remove_isolated_buffer($$)
{
    my ($buffer, $min_neighbours, $diagonal_neighbours, $remove_visible,
	$remove_transparent) = @_;
    
    info('Removing isolated pixels ...');

    my @buffer_old = @{matrixclone($buffer)};
    my ($xmax, $ymax) = dimensions($buffer);

    my @visible_neighbours;
    my $neighbours;
    my ($r, $g, $b, $R, $G, $B);

    for (my $y = 1; $y < $ymax-1; $y++) {
	for (my $x = 1; $x < $xmax-1; $x++) {
	    if ($buffer_old[$y][$x]) {
		$remove_visible or next;
		# count non transparent neighbours
		$neighbours = 0;
		$buffer_old[$y-1][$x] and $neighbours++;
		$buffer_old[$y+1][$x] and $neighbours++;
		$buffer_old[$y][$x-1] and $neighbours++;
		$buffer_old[$y][$x+1] and $neighbours++;
		if ($diagonal_neighbours) {
		    $buffer_old[$y-1][$x-1] and $neighbours++;
		    $buffer_old[$y+1][$x-1] and $neighbours++;
		    $buffer_old[$y-1][$x+1] and $neighbours++;
		    $buffer_old[$y+1][$x+1] and $neighbours++;
		}
		$neighbours >= $min_neighbours or $buffer->[$y][$x] = '';
	    }  else { 
		$remove_transparent or next;
		# count transparent neighbours and collect nontransparent 
		#  neighbours
		$neighbours = 0;
		@visible_neighbours = ();
		if ($buffer_old[$y-1][$x]) {
		    push @visible_neighbours, $buffer_old[$y-1][$x];
		} else {
		    $neighbours++;
		}
		if ($buffer_old[$y+1][$x]) {
		    push @visible_neighbours, $buffer_old[$y+1][$x];
		} else {
		    $neighbours++;
		}
		if ($buffer_old[$y][$x-1]) {
		    push @visible_neighbours, $buffer_old[$y][$x-1];
		} else {
		    $neighbours++;
		}
		if ($buffer_old[$y][$x+1]) {
		    push @visible_neighbours, $buffer_old[$y][$x+1];
		} else {
		    $neighbours++;
		}
		if ($diagonal_neighbours) {
		    if ($buffer_old[$y-1][$x-1]) {
			push @visible_neighbours, $buffer_old[$y-1][$x-1];
		    } else {
			$neighbours++;
		    }
		    if ($buffer_old[$y+1][$x-1]) {
			push @visible_neighbours, $buffer_old[$y+1][$x-1];
		    } else {
			$neighbours++;
		    }
		    if ($buffer_old[$y-1][$x+1]) {
			push @visible_neighbours, $buffer_old[$y-1][$x+1];
		    } else {
			$neighbours++;
		    }
		    if ($buffer_old[$y+1][$x+1]) {
			push @visible_neighbours, $buffer_old[$y+1][$x+1];
		    } else {
			$neighbours++;
		    }
		}
		if (($neighbours < $min_neighbours) and @visible_neighbours) {
		    ($R, $G, $B) = (0, 0, 0);
		    foreach (@visible_neighbours) {
			($r, $g, $b) = HextoRGB($_);
			$R += $r;
			$G += $g;
			$B += $b;
		    }
		    $R = int($R / scalar(@visible_neighbours));
		    $G = int($G / scalar(@visible_neighbours));
		    $B = int($B / scalar(@visible_neighbours));
		    $buffer->[$y][$x] = RGBtoHex($R, $G, $B);
		}
	    }
	}
    }
    info("done\n");
}




# ----------------------------------------------------------------------
# Clipboard
# ----------------------------------------------------------------------

sub clipboard_items()
{
    return $clipbutton->menu->index('end') - 2;
}

# ----------------------------------------------------------------------

sub clipboard_add($)
{
    my $buffer = shift;
    my $photo = clipboard_photo($buffer);
    $cliplabel += 1;
    my $label = "Clip $cliplabel";
    $clipboard_buffers{$label} = $buffer;
    $clipboard_photos{$label} = $photo;
    $clipbutton->cascade(-label => "$label");
    my $submenu = $clipbutton->menu->Menu(-tearoff => 0);
    $submenu->add('command', -label => "Paste normal",
		  -command => [\&clipboard_paste, $buffer, 0]);
    $submenu->add('command', -label => "Paste in current drawing mode",
		  -command => [\&clipboard_paste, $buffer, 1]);
    $submenu->add('command', -label => "Exchange with image",
		  -command => [\&clipboard_exchange, $label, $buffer]);
    $submenu->add('command', -label => "Delete",
		  -command => [\&clipboard_delete, $label]);
    $clipbutton->entryconfigure($label, -menu => $submenu,
				-image => $photo);
    $clipbutton->configure(-state => "normal");
}

# ----------------------------------------------------------------------

sub clipboard_delete($)
{
    my $label = shift;
    $clipbutton->menu->delete($label);
    delete $clipboard_buffers{$label};
    delete $clipboard_photos{$label};
    info("Item removed from clipboard\n");
}

# ----------------------------------------------------------------------

sub clipboard_clear()
{
    my $n = $clipbutton->menu->index('end') - 2;
    undef %clipboard_buffers;
    undef %clipboard_photos;
    if ($n > 0) {
	$clipbutton->menu->delete(3, 'end');
	info("$n item(s) removed from clipboard\n");
    }
}

# ----------------------------------------------------------------------

sub clipboard_photo($)
{
    my $buffer = shift;
    my ($width, $height) = (scalar(@{$buffer->[0]}), scalar(@$buffer));
    my $image = $mw->Photo(-width => $width, -height => $height);
    for (my $i = 0; $i < $height; $i++) {
	for (my $j = 0; $j < $width; $j++) {
	    if ($buffer->[$i][$j]) {
		$image->put($buffer->[$i][$j], -to => ($j,$i));
	    }
	}
    }
    return $image;
}

# ----------------------------------------------------------------------

sub clipboard_paste($$)
{
    my ($buffer, $mode) = @_;
    
    my $bufheight = scalar(@$buffer);
    my $bufwidth = scalar(@{$buffer->[0]});
    if ($bufwidth > $width or $bufheight > $height) {
	my $DB = $mw->DialogBox(-buttons => ['Yes', 'No', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-justify => "left",
		   -text => <<EOF)->pack();
The clipboard buffer ($bufwidth x $bufheight) is
too large for the image ($width x $height). 
Do you want to resize the image before pasting?
EOF
    
    my $choice = $DB->Show();
    $choice eq 'Cancel' and return;
    $choice eq 'Yes' and resize_image(max($width, $bufwidth),
				      max($height, $bufheight));
    }
    
    info('Pasting clipboard item (press button 3 to abort) ...');
    $drawingcanvas->grab();
    canvas_unbind();
    $drawingcanvas->update();
    while ($mouse1down) {     $drawingcanvas->update(); }
    my $i = shift;
    my ($height, $width) = (scalar(@$buffer), scalar(@{$buffer->[0]}));
    my $rect = create_selection_rectangle(0, 0, $width-1, $height-1,
					  "white", "gray25");
    my ($xold, $yold) = (0, 0);
    for (;;) {
	if ($mousex != $xold or $mousey != $yold) {
	    $drawingcanvas->move($rect, ($mousex-$xold) * $zoomfac,
				 ($mousey-$yold) * $zoomfac);
	    ($xold, $yold) = ($mousex, $mousey);
	}
	$drawingcanvas->update();
	if ($mouse3down) { #cancelled
	    $drawingcanvas->grabRelease();
	    $drawingcanvas->delete($rect); 
	    info("aborted\n");
	    return;
	} elsif ($mouse1down) {
	    $drawingcanvas->grabRelease();
	    enable_undo();
	    $drawingcanvas->delete($rect);
	    insert_buffer($mousex, $mousey, $buffer, $mode);	
	    info("done\n");
	    return;
	}
    }
}

# ----------------------------------------------------------------------

sub clipboard_exchange($$)
{
    my ($label, $buffer) = @_;
    info('Exchanging image whith clipboard item ... ');
    enable_undo();
    clipboard_add(save_to_buffer(0, 0, $width-1, $height-1));
    @pixelmatrix = @$buffer;
    my ($oldwidth, $oldheight) = ($width, $height);
    $height = scalar(@pixelmatrix);
    $width = scalar(@{$pixelmatrix[0]});
    if ($oldwidth != $width or $oldheight != $height) {
	$zoomfac = propose_zoomfac($width, $height);
	display_info();
    }
    draw_image();
    $clipbutton->menu->delete($label);
    delete $clipboard_buffers{$label};
    delete $clipboard_photos{$label};
    info("done\n");
}

# ----------------------------------------------------------------------

sub clipboard_save_image()
{
    info('Saving current image to clipboard ...');
    clipboard_add(save_to_buffer(0, 0, $width-1, $height-1));
    info("done (", clipboard_items(), " item(s) in clipboard)\n");
}

# ----------------------------------------------------------------------

sub clipboard_load_file_dialog()
{
    my $fname = $FileBrowser->Show($filename);
    $fname or return;
    clipboard_load_file($fname) or return;
}

# ----------------------------------------------------------------------

sub clipboard_load_file($)
{
    my $fname = shift;

    info("Loading file $fname to clipboard ... ");
    my $bufref = load_image_to_buffer($fname) or return;
    clipboard_add($bufref);
    info("done (", clipboard_items(), " item(s) in clipboard)\n");
}

# ----------------------------------------------------------------------
# Undo
# ----------------------------------------------------------------------

sub undo()
{
    info('Undoing last operation ... ');
    $changes--;
    my $tmp = pop(@undobuffer);
    @pixelmatrix = @$tmp;
    my ($oldwidth, $oldheight) = ($width, $height);
    $height = scalar(@pixelmatrix);
    $width = scalar(@{$pixelmatrix[0]});
    if ($oldwidth != $width or $oldheight != $height) {
	$zoomfac = propose_zoomfac($width, $height);
	display_info();
    }
    draw_image();
    @undobuffer or $undobutton->configure(-state => "disabled");
    info("done\n");
}

# ----------------------------------------------------------------------

sub enable_undo()
{
    while (scalar(@undobuffer) >= $preferences{maxundo}) { shift @undobuffer; }
    push @undobuffer, matrixclone(\@pixelmatrix);
    $changes++;
    $undobutton->configure(-state => "normal");
}

# ----------------------------------------------------------------------

sub clear_undo()
{
    @undobuffer = ();
    $changes = 0;
    $undobutton->configure(-state => "disabled");
}


# ----------------------------------------------------------------------
# Colorpace conversions
# ----------------------------------------------------------------------

sub RGBtoHex($$$) {
    my ($r, $g, $b) = @_;
    my $rhex = sprintf("%x", $r);
    if (length($rhex) == 1) { $rhex = "0$rhex"; }
    my $ghex = sprintf("%x", $g);
    if (length($ghex) == 1) { $ghex = "0$ghex"; }
    my $bhex = sprintf("%x", $b);
    if (length($bhex) == 1) { $bhex = "0$bhex"; }
    return "#$rhex$ghex$bhex";
}    

# ----------------------------------------------------------------------

sub HextoRGB($)
{
    my $hexval = shift;
    $hexval or return ();
    return ( hex(substr($hexval, 1, 2)),
	     hex(substr($hexval, 3, 2)),
	     hex(substr($hexval, 5, 2)));
}

# ----------------------------------------------------------------------

sub RGBtoHSV($$$)
{
    my ($r, $g, $b) = @_;
    $r /= 255;
    $g /= 255;
    $b /= 255;

    my $max = max($r,$g,$b);
    my $min = min($r,$g,$b);
    my $delta = $max - $min;

    $delta == 0 and return (0, 0,  $max);
    
    my $v = $max;
    my $s = $delta / $max;
    my $h;

    if( $r == $max ) { # between yellow & magenta
	$h = ( $g - $b ) / $delta;
    } elsif( $g == $max ) { # between cyan & yellow
	$h = 2 + ( $b - $r ) / $delta;
    } else { # between magenta & cyan
	$h = 4 + ( $r - $g ) / $delta;
    }
    if ($h < 0) { $h += 6; }
    return ($h, $s, $v);
}

# ----------------------------------------------------------------------

sub HSVtoRGB($$$)
{
    my ($h, $s, $v) = @_;
    my ($i, $f, $p, $q, $t);

    if( $s == 0 ) { # grey
	$v = int($v * 255);
	$v < 0 and $v = 0;
	$v > 255 and $v = 255;
	return ($v, $v, $v); 
    } 

    
    $i = floor( $h );
    $f = $h - $i;
    $p = $v * ( 1 - $s );
    $q = $v * ( 1 - $s * $f );
    $t = $v * ( 1 - $s * ( 1 - $f ) );

    foreach ($v, $p, $q, $t) {
	$_ = int($_ * 255);
	if ($_ < 0) { $_ = 0; }
	if ($_ > 255) { $_ = 255; }
    }

    $i == 0 and return ($v, $t, $p);
    $i == 1 and return ($q, $v, $p);
    $i == 2 and return ($p, $v, $t);
    $i == 3 and return ($p, $q, $v);
    $i == 4 and return ($t, $p, $v);
    return($v, $p, $q);
}


# ----------------------------------------------------------------------
# Auxiliary functions
# ----------------------------------------------------------------------

sub min(@)
{
    return (sort( {$a <=> $b} @_))[0];
}

# ----------------------------------------------------------------------

sub max(@) 
{
    return (sort({ $a <=> $b} @_))[$#_];
}

# ----------------------------------------------------------------------

# parses the string returned by the $image->data() method (see Tk::Photo)
# and returnes a matrix containg the rgb values
sub parse_image_data($)
{
    my $string = shift;
    my @lines = ();
    my @matrix = ();

    foreach (split( "} {", $string)) {
	s/[{}]//g;
	my @line = split( " ", $_);
        push @matrix, \@line;
    }
    return @matrix;
}

# ----------------------------------------------------------------------

sub matrixclone($) 
{
    my $orig = shift;
    my @clone;
    foreach my $row (@$orig) {
	my @tmp = @$row;
	push @clone, \@tmp;
    }
    return \@clone;
}

# ----------------------------------------------------------------------

# returns the dimensions as a list ($w, $h) of the image contained in $buffer
sub dimensions($)
{
    my $buffer = shift;

    return (scalar(@{$buffer->[0]}), scalar(@$buffer));
}


# ----------------------------------------------------------------------
# Help
# ----------------------------------------------------------------------

sub help($)
{
    my $file = shift;
    my $docfile = "$preferences{docdir}/$file";
    my $browser = $preferences{helpbrowser};
    system "which $browser >/dev/null";
    if ( $? ) {
	message("Help browser $browser not found.\n".
		"You may choose your favourite browser in the options menu.");
	return;
    }
    if (! -r $docfile) {
	message("File $docfile not found.\n".
		"Enter the correct path in the options menu.");
	return;
    }
    my $shellcmd = "$browser $docfile &";
    info "Launching shell command $shellcmd\n";
    system $shellcmd;
}

# ----------------------------------------------------------------------
# Plugins
# ----------------------------------------------------------------------

sub load_plugins()
{
    main::info "Scanning plugins ... ";
    @plugins = ();
    my @filters = ();
    @regionfilters = ();
    my @creators = ();
    my @pluginfiles = grep { chomp $_ and -f "$plugindir/$_" 
				 and /^[a-z0-9]*.bpl$/i } `ls $plugindir/`;
    main::info "loading ", scalar(@pluginfiles), " plugins ... ";

    foreach my $file (@pluginfiles) {
	chomp $file;
	my $plugin =  Plugin::load($plugindir, $file);
	$plugin or next;
	if ($plugin->type() eq 'regionfilter') {
	    push @regionfilters, $plugin;
	} elsif ($plugin->type() eq 'filter') {
	    push @filters, $plugin;
	} elsif ($plugin->type() eq 'creator') {
	    push @creators, $plugin;
	} else {
	  main::message("\nFile $plugindir/$file has unknown plugin type: \"",
			$plugin->type(), "\", skipping\n");
	}
    }
    @plugins = (@filters, @regionfilters, @creators);
    main::info "done\n";
}

# ----------------------------------------------------------------------

sub build_plugin_menu()
{
    $pluginbutton->menu->index('end') > 1 and 
	$pluginbutton->menu->delete(2, 'end');
    foreach my $plugin (@plugins) {
	my $label = $plugin->alias()." (".ucfirst($plugin->type()).")";
	$pluginbutton->cascade(-label => $label);
	my $submenu = $pluginbutton->menu->Menu(-tearoff => 0);
	$submenu->add('command', -label => "Apply",
		  -command => [\&apply_plugin, $plugin]);
	$submenu->add('command', -label => "Edit",
		  -command => [\&edit_plugin, $plugin]);
	$submenu->add('command', -label => "Delete",
		  -command => [\&delete_plugin, $plugin]);
	$pluginbutton->entryconfigure($label, -menu => $submenu);
    }
}

# ----------------------------------------------------------------------

sub rescan_plugins()
{
    info "Reloading plugins ... ";
    load_plugins();
    info "Rebuilding plugin menu ... ";
    build_plugin_menu();
    info "done\n";
}

# ----------------------------------------------------------------------

sub apply_plugin($)
{
    my $plugin = shift;

    info "Applying plugin " . $plugin->alias() . " ... ";

    my $type = $plugin->type();
    if ($type eq 'filter' or $type eq 'regionfilter') {
	apply_filter_plugin($plugin) or return info("aborted\n");
    } elsif ($type eq 'creator') {
	apply_creator_plugin($plugin) or return info("aborted\n");
    }
    info("done\n");
}

# ----------------------------------------------------------------------

sub apply_filter_plugin($)
{
    my $plugin = shift;

    my $shellcmd = $plugin->plugin_dialog($mw, 0) or return 0;
    my $tmpfile1 = "$tmpdir/plugin_input.xpm";
    my $tmpfile2 = "$tmpdir/plugin_ouput.xpm";
    # save to temporary file
    save_buffer_to_xpm($tmpfile1, \@pixelmatrix) or return 0;
    # apply shell command
    try_shell_command("cat $tmpfile1 | $shellcmd > $tmpfile2") or return 0;
    print "test123n";
    my $bufref_new =  load_xpm_to_buffer($tmpfile2) or return 0;
    enable_undo();
    @pixelmatrix = @$bufref_new;
    my ($old_width, $old_height) = ($width, $height);
    ($width, $height) = dimensions(\@pixelmatrix);

    if ($old_width != $width or $old_height ne $height) {
	$zoomfac = propose_zoomfac($width, $height);
	display_info();
    }
    draw_image();
    return 1;
}

# ----------------------------------------------------------------------

sub apply_creator_plugin($)
{
    my $plugin = shift;
    
    my $shellcmd = $plugin->plugin_dialog($mw, 0) or return 0;
    my $tmpfile = "$tmpdir/plugin_output.xpm";
    try_shell_command("$shellcmd > $tmpfile") or return 0;
    clipboard_load_file($tmpfile);
    return 1;
}

# ----------------------------------------------------------------------

sub edit_plugin($)
{
    my $plugin = shift;
    info "Starting pluging editor ... ";
    my $result = $plugin->edit_dialog();
    if ($result) {
	info "done\n";
	rescan_plugins();
    } else {
	info "aborted\n";
    }
}

# ----------------------------------------------------------------------

sub delete_plugin($)
{
    my $plugin = shift;
    my $file = "$plugindir/".$plugin->alias().".bpl";
    system "mv $file $file.bak";
    $? and main::message("Shell command mv $file $file.bak failed.");
    rescan_plugins();
}

# ----------------------------------------------------------------------

sub create_plugin()
{
    my $plugin = new Plugin;
    info "Starting pluging editor ... ";
    my $result = $plugin->edit_dialog();
    if ($result) {
	info "done\n";
	rescan_plugins();
    } else {
	info "aborted\n";
    }
}

# ----------------------------------------------------------------------

package Plugin;
use Data::Dumper;
use Cwd;

sub new() {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $parent = ref($proto) && $proto;

    my $self = {};

    if ($parent) { # create clone
	$self->{type} = $parent->{type};
	$self->{alias} = $parent->{alias};
	$self->{commandstring} = $parent->{commandstring};
	$self->{comment} = $parent->{comment};
	$self->{params} = {};
	foreach (keys %{$parent->{params}}) {
	    my %tmp = %{$parent->{params}->{$_}};
	    $self->{params}->{$_} = \%tmp;
	}
    } else { # create new object
	$self->{type} = 'filter';
	$self->{alias} = '';
	$self->{commandstring} = '';
	$self->{comment} = '';
	$self->{params} = {};
    }

    bless ($self, $class);
    return $self;
}


# ----------------------------------------------------------------------

sub alias($)
{
    my $self = shift;
    return $self->{alias};
}

# ----------------------------------------------------------------------

sub type($)
{
    my $self = shift;
    return $self->{type};
}



# ----------------------------------------------------------------------

# edit (and save) plugin
# returns 1 if the plugin is changed and successfully saved, 0 otherwise
sub edit_dialog() 
{
    my $self = shift;

    my $clone = $self->new();  
    my $flag = 0;              # set to 1 when edits are accepted
    my $tw;                    # text widget for the comment

    my $DW = $mw->Toplevel(-title => 'Plugin Editor');
    $DW->grab();
    $DW->protocol('WM_DELETE_WINDOW' => sub {});
    $DW->transient($DW->Parent->toplevel);
    $DW->resizable(0,0);

    my $frame0 = $DW->Frame()
	->pack(-side => 'top', -anchor => 'w', -fill => 'x', -expand =>'both');
    my $frame1 = $DW->Frame()
	->pack(-side => 'top', -anchor => 'w', -fill => 'x', -expand =>'both');
    my $frame2 = $DW->Frame();

    $frame0->Button(-text => 'Ok', -padx => 0, -pady => 0, -width => 10,
		    -command => sub { 
			chomp($clone->{comment} = $tw->get('1.0', 'end'));
			$clone->save($self->{alias}) or return;
			$flag = 1; 
			$DW->destroy(); 
		    })
	->pack(-side => 'left');
    $frame0->Button(-text => 'Cancel', -padx => 0, -pady => 0, -width => 10,
		    -command => [\&Tk::destroy, $DW])
	->pack(-side => 'left');
    $frame0->Button(-text => 'Preview', -padx => 0, -pady => 0, -width => 10,
		    -command => sub {
			chomp($clone->{comment} = $tw->get('1.0', 'end'));
			$clone->plugin_dialog($DW, 1);
		    })
	->pack(-side => 'left');
    $frame0->Button(-text => 'Help', -padx => 0, -pady => 0, -width => 10,
		    -command => [\&main::help, 'plugins.html'])
	->pack(-side => 'right');


    $frame1->Label(-text => 'Plugin type:')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    my $frame11 = $frame1->Frame()
	->grid(-row => 0, -column => 1, -sticky => 'w');  
    $frame11->Radiobutton(-text => 'Filter', 
			 -value => 'filter', -variable => \$clone->{type})
	->pack(-side => 'left');
    $frame11->Radiobutton(-text => 'Region Filter', 
			 -value => 'regionfilter', 
			  -variable => \$clone->{type})
	->pack(-side => 'left');
    $frame11->Radiobutton(-text => 'Creator', 
			 -value => 'creator', -variable => \$clone->{type})
	->pack(-side => 'left');
    
    $frame1->Label(-text => "Alias:")
	->grid(-row => 1, -column => 0, -sticky => 'w');
    my $frame12 = $frame1->Frame()
	->grid(-row => 1, -column => 1, -sticky => 'w');  
    $frame12->Entry(-textvariable => \$clone->{alias})
	->pack(-side => 'left');
    $frame12->Label(-text => "(only letters, digits and underscores)")
	->pack(-side => 'left');
    
    
    $frame1->Label(-text => "Shell command:")
	->grid(-row => 2, -column => 0, -sticky => 'w');
    my $entry = $frame1->Entry(-textvariable => \$clone->{commandstring},
			       -width => 70)
	->grid(-row => 2, -column => 1, -sticky => 'w');
    $entry->Tk::bind('<Key>', [\&watch_command, $clone, $frame2]);
    
    $frame1->Label(-text => "Comment:")
	->grid(-row => 3, -column => 0, -sticky => 'nw');
    $tw = $frame1->Scrolled('Text', -scrollbars => 'se', 
			    -height => 5, -width => 70)
	->grid(-row => 3, -column => 1, -sticky => 'w');
    $tw->insert('end', $clone->{comment});

    $clone->create_param_menu($frame2);

    $DW->waitWindow();
    if ($flag) {
	%$self = %$clone;
	return 1;
    } else {
	return 0;
    }
}

# ----------------------------------------------------------------------

sub create_param_menu($$)
{
    my ($self, $frame) = @_;

    # rebuild the menu
    $frame->packForget();
    foreach ($frame->children()) { $_->destroy(); }
    return unless %{$self->{params}};

    $frame->Label(-text => 'Formal Parameters')
	    ->grid(-row => 0, -column => 0, -columnspan => 5, -sticky => 'w');

    $frame->Label(-text => 'Param.')
	    ->grid(-row => 1, -column => 0, -sticky => 'w');
    $frame->Label(-text => 'Alias')
	    ->grid(-row => 1, -column => 1, -sticky => 'w');
    $frame->Label(-text => 'Default')
	    ->grid(-row => 1, -column => 2, -sticky => 'w');
    $frame->Label(-text => 'Minimum')
	    ->grid(-row => 1, -column => 3, -sticky => 'w');
    $frame->Label(-text => 'Maximum')
	    ->grid(-row => 1, -column => 4, -sticky => 'w');
    my $row = 1;
    foreach (sort keys %{$self->{params}}) {
	$row++;
	$frame->Label(-text => "$_")
	    ->grid(-row => $row, -column => 0, -sticky => 'w');
	$frame->Entry(-textvariable => \$self->{params}->{$_}->{alias},
		      -width => 20)
	    ->grid(-row => $row, -column => 1, -sticky => 'w');
	if (/int/) { 
	    $frame->Entry(-textvariable => \$self->{params}->{$_}->{default},
			  -width => 10)
		->grid(-row => $row, -column => 2, -sticky => 'w');
	    $frame->Entry(-textvariable => \$self->{params}->{$_}->{min},
			  -width => 10)
		->grid(-row => $row, -column => 3, -sticky => 'w');
	    $frame->Entry(-textvariable => \$self->{params}->{$_}->{max},
			  -width => 10)
		->grid(-row => $row, -column => 4, -sticky => 'w');
	} elsif (/string/) {
	    $frame->Entry(-textvariable => \$self->{params}->{$_}->{default},
			  -width => 10)
		->grid(-row => $row, -column => 2, -sticky => 'w');
	} elsif (/font/) {
	    $frame->Entry(-textvariable => \$self->{params}->{$_}->{default},
			  -width => 30)
		->grid(-row => $row, -column => 2, -sticky => 'w', 
		       -columnspan => 3);
	    $frame->Button(-text => 'Select', -padx => 0, -pady => 0,
			   -command => [\&select_font, 
					\$self->{params}->{$_}->{default}])
		->grid(-row => $row, -column => 5, -sticky => 'w');
	}
    }
    $frame->pack(-side => 'top', -anchor => 'w', -expand => 'both');
}

# ----------------------------------------------------------------------

sub watch_command()
{
    shift;
    my ($self, $frame) = @_;
    
    my @oldlist = keys (%{$self->{params}});
    my @newlist = param_list($self->{commandstring}, 
			     'int', 'string', 'font', 'file');

    # check which parameters are new and which are to be removed
    my (@oldonly, @newonly);
    my (%seen_old, %seen_new);
    @seen_old{@oldlist} = ();
    @seen_new{@newlist} = ();
    foreach (@oldlist) { push @oldonly, $_ unless exists $seen_new{$_}; }
    foreach (@newlist) { push @newonly, $_ unless exists $seen_old{$_}; }
    
    return unless @newonly || @oldonly;

    # update $self->{params}
    foreach (@oldonly) { delete $self->{params}->{$_}; }
    foreach (@newonly) { 
	if (/int/) {
	    $self->{params}->{$_} = 
		{alias => $_, min => 0, max => 100, default => 50};
	}  elsif (/string/) {
	    $self->{params}->{$_} = {alias => $_, default => ''};
	}  elsif (/font/) {
	    $self->{params}->{$_} = 
		{alias => $_, default =>'-*-*-*-*-*-*-*-*-*-*-*-*-*-*'};
	}  else {
	    $self->{params}->{$_} = {alias => $_, default => ''};
	}
    }
	
    # rebuild the menu
    $self->create_param_menu($frame);
}

# ----------------------------------------------------------------------

sub pluginerror()
{
    my $self = shift;

    # Check the fields alias and commandstring
    $self->{alias} or return "The plugin has no alias.";
    $self->{alias} =~ m/[^A-Za-z0-9_]/ and 
	return "The plugin alias must be alphanumeric.";
    $self->{commandstring} or return "Empty commandstring.";

    # Check Parameters
    my %params = %{$self->{params}};
    foreach (keys %params) {
	$params{$_}->{alias} or  return "Parameter $_ has no alias.";
	if ( /int/) {
	    ( $params{$_}->{default} =~ m/^[+-]?\d+$/ and
	      $params{$_}->{min} =~ m/^[+-]?\d+$/ and
	      $params{$_}->{max} =~ m/^[+-]?\d+$/ and
	      $params{$_}->{min} <= $params{$_}->{default} and
	      $params{$_}->{default} <= $params{$_}->{max} )
		or return 
		"Error in default, minimum, maximum for parameter $_.";
	}
    }
    return 0;
}

# ----------------------------------------------------------------------

sub plugin_dialog($$$)
{
    my ($self, $parent, $previewmode) = @_;
    
    my $message = $self->pluginerror();
    if ($message) {
	main::message($message);
	return;
    }
    
    my $DW = $mw->Toplevel(-title => 'Plugin Dialog');
    $DW->grab();
    $DW->protocol('WM_DELETE_WINDOW' => sub {});
    $DW->transient($DW->Parent->toplevel);
    $DW->resizable(0,0);

    my $frame0 = $DW->Frame()->pack(-side => 'top', -anchor => 'w');
    my $frame1 = $DW->Frame()->pack(-side => 'top', -anchor => 'w');
    my $frame2 = $DW->Frame()->pack(-side => 'top', -anchor => 'w');
    my $frame3 = $DW->Frame()->pack(-anchor => 'w', -fill => 'x');

    $frame0->Label(-text => "$self->{alias} (\u$self->{type})")
	->pack(-anchor => 'w');
    if ($self->{comment}) { 
  	$frame0->Label(-text => $self->{comment}, -justify => 'left')
  	    ->pack(-anchor => 'w');
    }

    my %params = %{$self->{params}};

    if (%params) { 
	$frame0->Label(-text => 'Parameters:')->pack(-anchor => 'w'); 
    }
    
    my $row = 0;
    foreach (sort keys %params) {
	$row++;
	$params{$_}->{val} = $params{$_}->{default};
	$frame1->Label(-text => "$params{$_}->{alias}:")
		->grid(-row=>$row,-column => 0,-sticky => 'w');
	if (/int/) {
	    my $length = $params{$_}->{max} - $params{$_}->{min};
	    while ($length < 200) { $length *= 2; }
	    $frame1->Scale(-orient => 'horizontal',
			   -from => $params{$_}->{min},
			   -to => $params{$_}->{max},
			   -length => $length,
			   -variable => \$params{$_}->{val})
		->grid(-row=>$row,-column => 1,-columnspan => 2,-sticky =>'w');
	} elsif (/string|font|file/) {
	    $frame1->Entry(-textvariable => $params{$_}->{alias},
			   -textvariable => \$params{$_}->{val},
			   -width => 60)
		->grid(-row=>$row,-column => 1,-sticky => 'w');
	    if (/file/) {
		$params{$_}->{val} = cwd().'/';
		$frame1->Button(-text => 'Browse', -padx => 0, -pady => 0,
				-command => [\&plugin_select_file, 
					     \$params{$_}->{val}])
		    ->grid(-row=>$row,-column => 2,-sticky => 'w');
	    }
	    if (/font/) {
		$frame1
		    ->Button(-text => 'Browse', -padx => 0, -pady => 0,
			     -command => [\&select_font, \$params{$_}->{val}])
		    ->grid(-row=>$row,-column => 2,-sticky => 'w');
	    }
	}    
    }

    $frame3->Button(-text => 'Cancel', -pady => 0,
		    -command => [\&Tk::destroy, $DW])
	->pack(-side => 'left');
    $frame3->Button(-text => 'Info', -pady => 0,
		    -command => [\&preview_command, $self->{commandstring},
				 \%params, $self->{type}])
	->pack(-side => 'left');
    my $applybutton = 
	$frame3->Button(-text => 'Apply', -pady => 0,
			-state => 'disabled')->pack(-side => 'right');
    
    my $shellcmd = undef;
    $previewmode or
	$applybutton
	    ->configure(-state => 'normal',
			-command => 
			[\&leave_plugin_dialog, $DW,
			 $self->{commandstring}, \$shellcmd, \%params]);
    
    $DW->waitWindow();
    $parent->grab(); 

    return $shellcmd;
}

# ----------------------------------------------------------------------


sub leave_plugin_dialog()
{
    my ($DW, $commandstring, $shellcmd_ref, $param_ref) = @_;
    
    $$shellcmd_ref = substitute($commandstring, $param_ref);
    $DW->destroy();
}


# ----------------------------------------------------------------------

sub preview_command($$$)
{
    my ($commandstring, $param_ref, $type) = @_;
    my $command = substitute($commandstring, $param_ref);
    my $message;
    if ($type eq 'filter' or $type eq 'regionfilter') {
	$message = 
	    "The image will be piped through the shellcommand\n\n$command";
    } else { # creator
	$message = 
	    "The standard output of the shellcommand\n\n$command\n\n".
		"will be loaded to the clipboard.";
    }
    main::message($message);
}

# ----------------------------------------------------------------------

sub select_font($)
{
    my $font_ref = shift;
    my $newfont = `xfontsel -print`;
    $? and main::message("Shell command xfontsel -print failed.");
    $$font_ref = $newfont;
}

# ----------------------------------------------------------------------

sub plugin_select_file($)
{
    my $file_ref = shift;
    my $newfile =  $FileBrowser->Show('.');
    $newfile and $$file_ref = $newfile;
}

# ----------------------------------------------------------------------

sub save($)
{
    my ($self, $oldalias) =  @_;

    # check whether the plugin is consistent
    my $message = $self->pluginerror();
    if ($message) {
	main::message($message);
	return;
    }

    my $fname = "$plugindir/$self->{alias}.bpl";

    # query overwrite, create backup
    if (-f $fname) {
	my $DB = $mw->DialogBox(-title => "Question",
				-buttons => ['Overwrite', 'Cancel']);
	$DB->resizable(0,0);
	$DB->Label(-text => "File $fname exists. Overwrite?")->pack();
	$DB->Show() ne "Overwrite" and return 0;
	system("cp $fname $fname.bak");
	if ($?) {
	    my $DB = $mw->DialogBox(-title => 'Question',
				    -buttons => ['Proceed', 'Cancel']);
	    $DB->resizable(0,0);
	    $DB->Label(-text => 
		       "Could not create backup file $fname.bak. Proceed?")
		->pack();
	    	$DB->Show() ne "Proceed" and return 0;
	}
    }

    # remove old file is the alias has changed
    my $oldname =  "$plugindir/$oldalias.bpl";
    if ($self->{alias} ne $oldalias and -f $oldname) {
	system("mv $oldname $oldname.bak");
	if ($?) {
	    my $DB = $mw->DialogBox(-title => 'Question',
				    -buttons => ['Proceed', 'Cancel']);
	    $DB->resizable(0,0);
	    $DB->Label(-text => 
		 "Could not create move $oldname to $oldname.bak. Proceed?")
		->pack();
	    $DB->Show() ne "Proceed" and return 0;
	}
    }

    # now save the plugin
    my $fh = new FileHandle;
    if (! open($fh, "> $fname")) {
	main::message("Could not open file $fname");
	return 0;
    }

    print $fh Dumper($self);
    close $fh;
}

# ----------------------------------------------------------------------

sub load($$)
{
    my ($plugindir, $filename) = @_;
    my $pluginfile = "$plugindir/$filename";

    # check permissions (important since the file contains a shell command)
    if (! main::is_safe($pluginfile) ){
      main::message ("Plugin $pluginfile has unsafe permissions, skipping.");
	return 0;
    }

    my $clone;
    # return a clone of the plugin (seems safer if the plugin file is
    # corrupted)
    eval {
	package Load; 
	my $VAR1 = undef;
	do $pluginfile; 
	
	$clone = $Load::VAR1->Plugin::new();
    };
    if ($@ or ! $clone->isa('Plugin') 
	or $clone->pluginerror() or $filename ne "$clone->{alias}.bpl" ) {
      main::message("Plugin $pluginfile seems corrupted, skipping");
	return 0;
    }

#    return $Load::VAR1;
    return $clone;
}


# ----------------------------------------------------------------------
# Auxiliary functions (without object notation)
# ----------------------------------------------------------------------

sub param_list(@)
{
    my $string = shift;
    my @param_names = @_;

    my @param_list;

    foreach my $param_name(@param_names) {
	my $pattern = '\$'.$param_name;
	while($string =~ m/$pattern\d+/) { 
	    push @param_list, $&;
	    my $match = "\\$&";
	    $string =~ s/$match//g; 
	}
    }
    return @param_list;
}

# ----------------------------------------------------------------------

sub substitute($$)
{
    my ($string, $param_ref) = @_;
    my %params = %$param_ref;

    foreach (keys %params) { 
	my $pattern = "\\$_";
	$string =~ s/$pattern/$params{$_}->{val}/g; }
    
    return $string;
}


# ----------------------------------------------------------------------
# ----------------------------------------------------------------------
# ----------------------------------------------------------------------

package FileChooser;

use DirHandle;
use Cwd;

# ----------------------------------------------------------------------

# class methods

sub new();

# auxiliary functions
sub scan_directory($$);
sub split_path($);
sub dir_file($);
sub filename_ok($);


# ----------------------------------------------------------------------
# Class Methods
# ----------------------------------------------------------------------

# Read the config file, build the window and hide it
sub new()
{
    shift;
    my $self = {};
    my ($parent, $bookmarks_file) = @_;

    $self->{parent} = $parent;    # parent widget
    $self->{bookmarksfile} = $bookmarks_file;
    $self->{bookmarks} = [];
    $self->{show_hidden} = 0;
    $self->{dir} = '';            # currently selected dir
    $self->{file} = '';           # currently selected file
    $self->{startdir} = '';       # 
    $self->{startfile} = '';
    $self->{entry_dir} = '';
    $self->{files} = [];
    $self->{dirs} = [];
    $self->{mask_string} = '';
    $self->{regexps} = [];
    $self->{filebox} = '';
    $self->{dirbox} = '';
    $self->{bookmark_button} = undef;
    $self->{accepted} = undef;

    my $window = $self->{window} = 
	$parent->Toplevel(-title => 'File Chooser');
    $window->protocol('WM_DELETE_WINDOW' => sub {});
    $window->transient($window->Parent->toplevel);
    $window->resizable(0,0);
    
        my $frame0 = $window->Frame->pack(-fill => 'x');
    $self->{bookmark_button} = 
	$frame0->
	    Menubutton(-text  => 'Bookmarks', 
		       -padx => 0, -pady => 1, -width => 10,
		       -tearoff => 0, -relief => 'raised',
		       -menuitems => [['command' => 'Set Bookmark',
				       -command => [\&add_bookmark, $self]],
				      ['command' => 'Clear Bookmarks',
				       -command => [\&clear_bookmarks, $self]]])
		->pack(-side => 'left');
    $frame0->Button(-text => 'Home', -command => 
		    [\&goto_dir, $self, "$ENV{HOME}/"],
		    -padx => 0, -pady => 0, -width => 10)
	->pack(-side => 'left');
    $frame0->Button(-text => 'Cwd', -command => 
		    [\&goto_dir, $self, cwd().'/'],
		    -padx => 0, -pady => 0, -width => 10)
	->pack(-side => 'left');


    $frame0->Button(-text => 'Reset', -command => [\&reset, $self],
		    -padx => 0, -pady => 0, -width => 10)
	->pack(-side => 'left');
    $frame0->Button(-text => 'Accept', -command => [\&accept, $self],
		    -padx => 0, -pady => 0, -width => 10)
	->pack(-side => 'right');
    $frame0->Button(-text => 'Cancel', -command => [\&cancel, $self],
		    -padx => 0, -pady => 0, -width => 10)
	->pack(-side => 'right');
    
    my $frame1 = $window->Frame->pack(-fill => 'x');
    $frame1->Checkbutton(-text => "Show Hidden Files", 
			 -variable => \$self->{show_hidden},
			 -command => [\&reread, $self])
	->pack(-side => 'left');

    $frame1->Entry(-textvariable => \$self->{mask_string},
		   -width => 25, -background =>'white')
	->pack(-side => 'right')
	    ->bind('<Return>', [\&mask, $self]);
    $frame1->Label(-text => 'File Mask:')
	->pack(-side => 'right');

    my $frame2 = $window->Frame->pack(-anchor => 'w');
    $frame2->Label(-text => 'Goto Directory:')
	->pack(-side => 'left');
    $frame2->Entry(-textvariable => \$self->{entry_dir}, 
		   -width => 35, -background =>'white')
	->pack(-side => 'left')
	    ->bind('<Return>', [\&entry_select_dir, $self]);

    my $frame3 = $window->Frame->pack(-anchor => 'w');
    $frame3->Label(-text => 'Directories')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    $frame3->Label(-text => 'Files')
	->grid(-row => 0, -column => 1, -sticky => 'w');
    $self->{dirbox} = $frame3->Scrolled('Listbox', -selectmode => 'single',
					-scrollbars => 'ne', -width => 25)
	->grid(-row => 1, -column => 0);
    $self->{filebox} = $frame3->Scrolled('Listbox',-selectmode => 'single',
					 -scrollbars => 'ne', -width => 35)
	->grid(-row => 1, -column => 1);

    my $frame4 = $window->Frame->pack(-anchor => 'w');
    $frame4->Label(-text => 'Directory:')
	->grid(-row => 0, -column => 0, -sticky => 'w');
    $frame4->Label(-textvariable => \$self->{dir})
	->grid(-row => 0, -column => 1, -sticky => 'w');
    $frame4->Label(-text => 'File:')
	->grid(-row => 1, -column => 0, -sticky => 'w');
    $frame4->Entry(-textvariable => \$self->{file}, -width => 35, 
		   -background =>'white')
	->grid(-row => 1, -column => 1, -sticky => 'w');


    $self->{filebox}->bind('<Button-1>', [\&filebox_select, $self]);
    $self->{dirbox}->bind('<Button-1>', [\&dirbox_select, $self]);

    $window->withdraw();
    
    bless($self);
    $self->load_bookmarks();
    $self->make_bookmark_menu();
    return($self);
}

# ----------------------------------------------------------------------

sub Show($$)
{
    my ($self, $path) = @_;

    ($self->{dir}, $self->{file}) = dir_file($path);
    ($self->{startdir}, $self->{startfile}) = ($self->{dir}, $self->{file});
    $self->{accepted} = undef;
    
    $self->goto_dir($self->{dir});

    $self->{window}->deiconify();
    $self->{window}->raise();
#    $self->{window}->geometry(sprintf("+%d+%d", 
#				      $self->{window}->pointerx(), 
#				      $self->{window}->pointery()));
    $self->{window}->grab();

    $self->{window}->waitVariable(\$self->{accepted});
    $self->{window}->grabRelease();
    $self->{window}->withdraw();

    return $self->{accepted} ? $self->{dir}.$self->{file} : '';
}

# ----------------------------------------------------------------------

sub goto_dir($$)
{
    my ($self, $newdir) = @_;
    $self->scan_directory($newdir);
    $self->{dir} = $newdir;
    $self->{filebox}->delete(0, 'end');
    $self->{dirbox}->delete(0, 'end');
    $self->{filebox}->insert('end', @{$self->{files}});
    $self->{dirbox}->insert('end', @{$self->{dirs}});
    $self->{entry_dir} = $self->{dir};
}


# ----------------------------------------------------------------------

sub reread($)
{
    my $self = shift;
    $self->goto_dir($self->{dir});
}


# ----------------------------------------------------------------------

sub reset($)
{
    my $self = shift;
    $self->{file} = $self->{startfile};
    $self->goto_dir($self->{startdir});

}


# ----------------------------------------------------------------------

sub filebox_select($$)
{
    shift;
    my $self = shift;
    $self->{file} = $self->{files}->[$self->{filebox}->curselection()];
}

# ----------------------------------------------------------------------

sub dirbox_select($$)
{
    shift;
    my $self = shift;
    my $relative_dir = $self->{dirs}->[$self->{dirbox}->curselection()];
    my ($newdir, $dummy) = dir_file($self->{dir}.$relative_dir);
    $self->goto_dir( $newdir);
}


# ----------------------------------------------------------------------

sub entry_select_dir($$)
{
    shift;
    my $self = shift;
    my @components = split_path($self->{entry_dir});
    if (@components) {
	$self->{entry_dir} = '/' . join('/', @components) .'/';
    } else { 
	$self->{entry_dir} = '/';
    }
    $self->goto_dir($self->{entry_dir});
}

# ----------------------------------------------------------------------


sub mask()
{
    shift;
    my $self = shift;
    my %globmap = ( '*' => '.*',  # Use to convert shell wildcharts to 
		'?' => '.' ); # regular expressions
    my @filepatterns = split(' ', $self->{mask_string});
    # convert file patterns into regular expressions
    $self->{regexps} = [];
    foreach (@filepatterns) {
	$_ =~ s{(.)} { $globmap{$1} || "\Q$1" }ge;
	push @{$self->{regexps}},  '^' . $_ . '$';
    }
    $self->reread();
}

# ----------------------------------------------------------------------

sub accept($)
{
    my $self = shift;
    if (! $self->{file}) {
	main::message("You did not choose a file.");
	return;
    } elsif ( !filename_ok($self->{file}) ) {
	main::message("Invalid filename \"$self->{file}\"");
	return;
    }
    $self->{accepted} = 1;
}

# ----------------------------------------------------------------------

sub cancel($)
{
    my $self = shift;
    $self->{accepted} = 0;
}

# ----------------------------------------------------------------------

sub make_bookmark_menu($)
{
   my $self = shift;
   foreach(@{$self->{bookmarks}}) {
       $self->{bookmark_button}->cascade(-label => $_);
       my $submenu = $self->{bookmark_button}->menu->Menu(-tearoff => 0);
       $submenu->add('command', -label => "Goto Directory",
		     -command => [\&goto_dir, $self, $_]);
       $submenu->add('command', -label => "Delete Bookmark",
		     -command => [\&delete_bookmark, $self, $_]);
       $self->{bookmark_button}->entryconfigure($_, -menu => $submenu);
   }
}

# ----------------------------------------------------------------------

sub add_bookmark($) 		 
{
    my $self = shift;
    grep { $_ eq $self->{dir} } @{$self->{bookmarks}} and return;
    push @{$self->{bookmarks}}, $self->{dir};
    $self->{bookmark_button}->cascade(-label => $self->{dir});
    my $submenu = $self->{bookmark_button}->menu->Menu(-tearoff => 0);
    $submenu->add('command', -label => "Goto Directory",
		  -command => [\&goto_dir, $self, $self->{dir}]);
    $submenu->add('command', -label => "Delete Bookmark",
		  -command => [\&delete_bookmark, $self, $self->{dir}]);
    $self->{bookmark_button}->entryconfigure($self->{dir}, -menu => $submenu);
    $self->save_bookmarks();
}

# ----------------------------------------------------------------------

sub delete_bookmark($$) {
    my ($self, $bookmark) = @_;
    $self->{bookmark_button}->menu->delete($bookmark);
    my $i0;
    for (my $i = 0; $i < @{$self->{bookmarks}}; $i++) {
	if ($bookmark eq $self->{bookmarks}->[$i]) {
	    $i0 = $i;
	    last;
	}
    }
    splice(@{$self->{bookmarks}}, $i0, 1);
    $self->save_bookmarks();
}

# ----------------------------------------------------------------------

sub clear_bookmarks($) {
    my $self = shift;
    @{$self->{bookmarks}} = ();
    if ($self->{bookmark_button}->menu->index('end') - 1 > 0) {
	$self->{bookmark_button}->menu->delete(2, 'end');
    }
    $self->save_bookmarks();
}
  

# ----------------------------------------------------------------------
# Auxiliary functions
# ----------------------------------------------------------------------

sub load_bookmarks($)
{
    my $self = shift;
    
    $self->{bookmarks} = [];
    -f $self->{bookmarksfile} or return;
    if (! open(FH, $self->{bookmarksfile})) {
	print STDERR "Could not open bookmark file $self->{bookmarksfile}\n";
	return;
    }
    @{$self->{bookmarks}} = <FH>;
    close FH;
    foreach (@{$self->{bookmarks}}) { chomp $_; }
}


# ----------------------------------------------------------------------

sub save_bookmarks($)
{
    my $self = shift;
    if (! open(FH, "> $self->{bookmarksfile}")) {
	print STDERR "Could not open bookmark file $self->{bookmarksfile}\n";
	return;
    }
    
    foreach (@{$self->{bookmarks}}) { print FH $_, "\n"; }
    close FH;
}


# ----------------------------------------------------------------------

sub scan_directory($$)
{
    my ($self, $dir) = @_;
    my $dh = new DirHandle($dir);
    if (! $dh) {
	main::message("Cannot read directory $dir");
	return;
    }
    @{$self->{files}} = ();
    @{$self->{dirs}} = ();
    while (my $f = $dh->read()) {
	$f eq '.' and next;
	substr($f, 0, 1) ne '.' or  $f eq '..' or $self->{show_hidden} or next;
	if (-d "$dir/$f") {
	    push @{$self->{dirs}}, $f;
	} else {
	    if (@{$self->{regexps}}) {
		grep { $f =~ $_ } @{$self->{regexps}} or next;
	    }
	    push @{$self->{files}}, $f;
	}
    }
    @{$self->{files}} = sort @{$self->{files}};
    @{$self->{dirs}} = sort @{$self->{dirs}};
    return 1;
}

# ----------------------------------------------------------------------

# split path into single components of the corresponding absolute path,
# '.', and '..' are resolved
sub split_path($)
{
    my $path = shift;

    # 1. replace relative path whith absolute path
    if (substr($path, 0, 2) eq './') {
	$path = cwd() . '/' . substr($path, 2);
    } elsif (substr($path, 0, 1) ne '/') {
	$path = cwd() . '/' . $path;
    } 

    # 2. Split into components
    my @tmp = split('/', $path);
    # remove empty fields (from //) and '.'
    my @tmp2 = ();
    foreach (@tmp) { $_ and $_ ne '.' and push @tmp2, $_; }
	
    # 3. Resolve '..'
    my @components = ();
    foreach (@tmp2) {
	if ($_ ne '..') {
	    push @components, $_;
	} else {
	    @components or return (); # not a valid path (above '/' !)
	    pop @components;
	}
    }
    return @components;
}

# ----------------------------------------------------------------------

# split a path in a directory an a file component
sub dir_file($)
{
    my $path = shift;
    my @components = split_path($path);
    @components or return ('/', '');

    my ($dir, $file) = ('/', '');
    -d $path or $file = pop @components;
    @components and $dir .= join('/', @components) . '/';
    return ($dir, $file);
}

# ----------------------------------------------------------------------

sub fullpath($)
{
    my ($dir, $file) = dir_file(shift);
    return "$dir$file";
}

# ----------------------------------------------------------------------

sub filename_ok($)
{
    my $fname = shift;
    if (index($fname, '/') >= 0 or index($fname, '*') >= 0) {
	return 0;
    } 
    return 1;
}




