Loads images. Makes thumbnails in top bit. Drag images below line. Makes a gif of images below line in left to right order. Y-axis doesn’t matter. Can load same images more than once. Can quickly check movement. Gif saved to “output.gif”. Image sequence .CSV files saved to ./LISTS/image_list_*.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Canvas;
use Tk::Scrollbar;
use File::Basename;
use File::Copy;
use File::Path qw(remove_tree);
use Image::Imlib2;
use Tk::PNG;
use Tk::JPEG;
use Tk::Photo;
use feature "say";
use Data::Dumper qw(Dumper);
my ($gif,$canvas2,$frame,$window2,$max_frames,$image_item,$ww,$wh,$counter);
my $number=0;
my @saved;
my $mw = MainWindow->new;
$mw->title("Drag & Re-order Images");
my $button_frame = $mw->Frame(-bg => 'lightgray')->pack(-fill => 'x', -side => 'top');
my @lists;
my $chk=0;
$button_frame->Button(
-text => "Load Images",
-command => \&load_images,
-font => ['Arial', 14],
-width => 15,
-height => 2
)->pack(-side => 'left', -padx => 10);
$button_frame->Button(
-text => "NEW GIF",
-command => sub{&rename_images;&make_gif;&play_gif;&remove;},
-font => ['Arial', 14],
-width => 15,
-height => 2
)->pack(-side => 'left', -padx => 10);
$button_frame->Button(
-text => "CLOSE",
-command => sub{&exit},
-font => ['Arial', 14],
-width => 15,
-height => 2
)->pack(-side => 'left', -padx => 10);
# Main canvas frame (contains both scrollable areas)
my $canvas_frame = $mw->Frame()->pack(-fill => 'both', -expand => 1);
my $canvas = $canvas_frame->Canvas(-width => 2000, -height => 500, -bg => 'white');
my $scroll_x = $canvas_frame->Scrollbar(-orient => 'horizontal', -command => sub { $canvas->xview(@_) });
$canvas->configure(-xscrollcommand => ['set', $scroll_x]);
$canvas->pack(-side => 'top', -fill => 'both', -expand => 1);
$scroll_x->pack(-side => 'bottom', -fill => 'x');
# Separation line
my $separation_y = 220;
my $separation_line = $canvas->createLine(0, $separation_y, 10000, $separation_y, -fill => 'black', -width => 2);
my %image_data;
my $dragging;
my ($drag_offset_x, $drag_offset_y);
MainLoop;
sub load_images {
my @files = @{$mw->getOpenFile(
-multiple => 1,
-filetypes => [['Images', ['.png', '.jpg', '.jpeg', '.gif']]],
)};
return unless @files;
#say Dumper (\@files);
my $x = 10;
my $max_x = 10;
foreach my $file (@files) {
next unless -f $file;
my $img = create_thumbnail($file);
my $id = $canvas->createImage($x, 10, -image => $img, -anchor => 'nw');
$image_data{$id} = { file => $file, x => $x, y => 10, image => $img };
# Enable dragging
$canvas->bind($id, '<ButtonPress-1>' => [\&start_drag, $id]);
$canvas->bind($id, '<B1-Motion>' => [\&do_drag, $id]);
$canvas->bind($id, '<ButtonRelease-1>' => [\&stop_drag, $id]);
$x += 100; # check this
$max_x = $x if $x > $max_x;
}
# Update scroll region dynamically
$canvas->configure(-scrollregion => [0, 0, $max_x, 800]); # need this
}
sub create_thumbnail {
my ($file) = @_;
my $img = $mw->Photo(-file => $file);
my ($width, $height) = ($img->width, $img->height);
($ww,$wh)=($width,$height);
my $scale = 80 / $width;
my $thumb = $mw->Photo(-width => 80, -height => int($height * $scale));
$thumb->copy($img, -subsample => int($width / 80));
return $thumb;
}
sub start_drag {
my ($canvas, $id) = @_;
$dragging = $id;
my $e = $canvas->XEvent;
my ($img_x, $img_y) = $canvas->coords($id);
$drag_offset_x = $e->x - $img_x;
$drag_offset_y = $e->y - $img_y;
}
sub do_drag {
my ($canvas, $id) = @_;
return unless $dragging;
my $e = $canvas->XEvent;
my $new_x = $e->x - $drag_offset_x;
my $new_y = $e->y - $drag_offset_y;
$canvas->coords($id, $new_x, $new_y);
# Ensure items can move across the separation line
$image_data{$id}{x} = $new_x;
$image_data{$id}{y} = $new_y;
}
sub stop_drag {
$dragging = undef;
}
sub rename_images {
$chk++;
if($window2){$window2->destroy;}
my $dir = "re-ordered"; #added
my @sorted_images = sort {
my $a_x = $image_data{$a}{x} // 0;
my $b_x = $image_data{$b}{x} // 0;
$a_x <=> $b_x
}
grep {
my $y = $image_data{$_}{y} // 0;
$y > $separation_y
} keys %image_data;
return unless @sorted_images;
$counter =0;
for my $id (@sorted_images) {
my ($old_path, $ext) = ($image_data{$id}{file}, '.png');
#say $old_path;
$lists[$chk][$counter]{file}=$old_path;
#say Dumper(\@lists);
my $new_path = sprintf("re-ordered/image_%04d"."$ext",$counter);
copy($old_path, $new_path);
# print "Renamed: $old_path -> $new_path\n";
$counter++;
}
}
sub play_gif{
my ($ww, $wh) = ($ww + 60, $wh + 60);
$window2 = $mw->Toplevel;
$window2->geometry("${ww}x${wh}+1500+500");
$canvas2 = $window2->Canvas(-width => $ww, -height => $wh);
$canvas2->pack;
my $myfile = 'output.gif';
$gif = $mw->Photo(-file => $myfile, -format => 'gif');
# Auto-detect number of frames
my $frames = 0;
while (eval { $gif->configure(-format => "gif -index $frames"); 1 }) {
$frames++;
}
if ($frames == 0) {
print "Error: No frames found in GIF!\n";
return;
}
$frame = 0;
$max_frames = $frames; # Use detected frame count
$image_item = $canvas2->createImage(0, 0, -anchor => 'nw', -image => $gif);
sub update_frame {
$gif->configure(-format => "gif -index $frame");
$canvas2->itemconfigure($image_item, -image => $gif);
$frame = ($frame + 1) % $max_frames;
$window2->after(100, \&update_frame);
}
update_frame();
}
sub remove {
my %temp;
my $dir = "LISTS";
if (! -d $dir){mkdir "LISTS"}
my $file_name = sprintf("image_list_%04d",$chk);
open(my $fh, '>', "$dir/$file_name") or die "Cannot open filelist: $!";
for (my $i=0;$i<=$counter-1;$i++){
$temp{file} = $lists[$chk][$i]{file};
#say " temp = $temp";
print $fh "image,$temp{file}\n";
}
close $fh;
$dir = "re-ordered";
if (-d $dir) {
remove_tree($dir, { error => \my $err });
if (@$err) {
warn "Error removing directory: @$err\n";
} else {
#print "Removed directory: $dir\n";
}
}
mkdir $dir; # Recreate it for new images
}
sub numerically {
my ($a_num) = $a =~ /(\d+)/;
my ($b_num) = $b =~ /(\d+)/;
$a_num //= 0; # Set $a_num to 0 if it's uninitialized
$b_num //= 0; # Set $b_num to 0 if it's uninitialized
return $a_num <=> $b_num;
}
sub make_gif{
# add check for directories and files.
unless (-e "output.gif") {
open my $fh, '>', "output.gif" or die "Cannot create output.gif: $!";
close $fh;
}
system('ffmpeg -y -v quiet -i re-ordered/image_%04d.png -vf "palettegen" palette.png');
system('ffmpeg -y -v quiet -framerate 10 -i re-ordered/image_%04d.png -i palette.png -filter_complex "paletteuse" -gifflags -offsetting -loop 0 output.gif');
}
sub close{
$mw->destroy;
}