#!/usr/local/bin/perl
use warnings;
use strict;

use File::Basename;

#  Directories where images are located
my @location =
  @ARGV
  || map '/home/parv/graphic/mine/' . $_ , qw(xpm jpeg png gif) ;

#  Regular expressions to fill menu enteries by parsing file names
our $circle_re;
my $default_re = qr/(.+)/;

#  Collect files
my @collection = @{ get_files( [@location] ) };
my @uncircles = grep $_ !~ m/$circle_re/ , @collection;
my @circles   = grep $_ =~ m/$circle_re/ , @collection;

#  Order criterion
our (%brightness , %shape);

#  Print sorted menu enteries
print
  map scalar @{$_} ? @{$_} : ()
  , make_enteries
    ( order(\@uncircles , \%shape , $default_re ) , $default_re )
  , make_enteries
    (sort_brightness(\@circles , $circle_re) , $circle_re )
  ;


#  Emit statements for fvwm 2.5.x menu (where "more-bg-menu" is custom
#  menu name & "bg-image-sym" is a custom fvwm(1) function to set root
#  window w/ the given file)
sub make_enteries
{ my ($list , $regex) = @_;
  return [] unless defined $list && defined $regex;

  my @enteries;
  foreach my $path ( @{ $list } )
  { my ($file) = file_name($path);
    my @match = ($file =~ m/$regex/) or next;

    push @enteries
      , sprintf "AddToMenu more-bg-menu \"&%s\" bg-image-sym %s\n"
          , (join ' '
              , map defined $_ && $_ ne '' ? $_ : () , @match
            )
          , $path ;
  }
  return [ @enteries ];
}

BEGIN
{ our %shape;
  { my $i = 0;
    map $shape{$_} = $i++
      , qw(horizontal vertical diagonal wave wiggle ripple circle ELSE )
      ;
  }

  our %brightness;
  { my $i = 0;
    map $brightness{$_} = $i++
      , qw(lightest lighter light ELSE dark darker darkest)
      ;
  }

  #  File names are something like...
  #    circle-blue.xpm         circle-blue-dark.xpm
  #    circle-blue-darker.xpm  circle-blue-lighter.xpm
  #    circle-green-dark.xpm   circle-green-darker.xpm
  our $circle_re =
    qr{ circle -
        #  Color (red, green, etc.)
        ( [a-z]+ )
          #  Optional brightness
        (?: - ( (?: dark | light) (?: er | est)? ) )?
      }x;
}

#  Sorting sub by brightness info embeded in the given word
sub sort_brightness
{ my ($list , $regex) = @_;
  return
    [ map $_->[0]
      , sort { $a->[1] cmp $b->[1] || $a->[2] <=> $b->[2]; }
        map
        { m/$regex/;
          [ $_ , lc $1 , get_index($2 , \%brightness) ];
        } @{$list}
    ] ;
}

#  Order elements of given input array reference according to given order
#  array reference
sub order
{ my ($list , $order) = @_;
  return
    [ map $_->[0]
      , sort { $a->[1] <=> $b->[1] || $a->[2] cmp $b->[2] }
        map
        { my $n = file_name( $_ );
          [ $_ , get_index($n , $order) , $n ];
        } @{$list}
    ] ;
}

#  Return index of given element from given array reference; -1 is
#  returned if any of the array references are undefined
sub get_index
{ my ($in , $order) = @_;

  my $default =
    defined $order && exists $order->{'ELSE'}
    ? $order->{'ELSE'} : -1;

  return $default unless defined $in;

  foreach my $k ( keys %{$order} )
  { return $order->{$k} if $in =~ m/$k/i;
  }
  return $default;
}

#  fileparse() wrapper to avoid specifying the 2d argument more than once
sub file_name
{ my $path = $_[0];
  return fileparse( $path , qr!\.[^.]+! );
}

#  Collect file names from given directories
sub get_files
{ my $location = $_[0];
  my @images;
  foreach my $dir ( @{$location} )
  { #  Open/read $images directory
    unless ( opendir(DIR , $dir) )
    { warn "Cannot open '$dir' (skipped): $!";
      next;
    }
    #  Get file names which match the above pattern
    push @images
      , map { -f "$dir/$_" ? "$dir/$_" : ();  } readdir(DIR);

    closedir(DIR) || die "Cannot close $dir: $!";
  }
  return [ @images ];
}