#############################################################################
## Name:        make_ovl_list.pl
## Purpose:     builds overload constants
## Author:      Mattia Barbon
## Modified by:
## Created:     17/ 8/2001
## RCS-ID:      
## Copyright:   (c) 2001 Mattia Barbon
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

use strict;

my $ovl = shift @ARGV;

my %name2type =
  (
   wimg => 'Wx::Image',
   wbmp => 'Wx::Bitmap',
   wico => 'Wx::Icon',
   wmen => 'Wx::Menu',
   wmit => 'Wx::MenuItem',
   wrec => 'Wx::Rect',
   wreg => 'Wx::Region',
   wszr => 'Wx::Sizer',
   wtip => 'Wx::ToolTip',
   wwin => 'Wx::Window',
   wcol => 'Wx::Colour',
   wlci => 'Wx::ListItem',
   wsiz => 'Wx::Size',
   wpoi => 'Wx::Point',
   wgco => 'Wx::GridCellCoords',
   wdat => 'Wx::DataObject',
   wcur => 'Wx::Cursor',
   wehd => 'Wx::EvtHandler',
   wist => 1,
   wost => 1,
   num  => 1,
   str  => 1,
   bool => 1,
   arr  => 1,
  );

my %constants;

foreach my $i ( @ARGV ) {
  open IN, '< ' . $i or die "unable to open '$i'";

  while( <IN> ) {
    if( m/Wx::_match\(\s*\@_\s*,\s*\$Wx::_(\w+)\s*\,/ ) {
      my $const = $1;
      my @const = split /_/, $const;
      foreach my $j ( @const ) {
        $j = 'num' if $j eq 'n';
        $j = 'str' if $j eq 's';
        $j = 'bool' if $j eq 'b';

        die "unrecognized type '$j' in file '$i'"
          unless $name2type{$j};
        $constants{$const} = \@const;
      }
    }
  }
}

my @keys = ( ( sort grep { $name2type{$_} != 1 } keys %name2type ),
             ( sort grep { $name2type{$_} == 1 } keys %name2type ) );

open OUT, '> '. $ovl || die "unable to open file '$ovl'";

binmode OUT; # Perl 5.004 on Unix complains for CR

print OUT <<EOT;
#############################################################################
## Name:        _Ovl.pm
## Purpose:     overload constants (AUTOGENERATED, DO NOT EDIT)
## Author:      Mattia Barbon
## Modified by:
## Created:     17/ 8/2001
## RCS-ID:      
## Copyright:   (c) 2001 Mattia Barbon
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

package Wx;

EOT

my $vars_comma = join ", ", map { "\$$_" } @keys;
my $vars = $vars_comma; $vars =~ s/,//g;
my $types = join ", ", map { "'$name2type{$_}'" }
  grep { $name2type{$_} != 1 } @keys;

print OUT "use vars qw(\@tnames ${vars});\n";
print OUT "( ${vars_comma} ) = ( 1 .. 100 );\n\n";
print OUT "\@tnames = ( undef, ${types} );\n\n";

foreach my $i ( sort keys %constants ) {
  print OUT "\$Wx::_$i = [ ";
  print OUT join ", ", map { "\$$_" } @{$constants{$i}};
  print OUT " ];\n";
}

print OUT <<EOT;

1;

# Local variables: #
# mode: cperl #
# End: #
EOT

exit 0;

# Local variables: #
# mode: cperl #
# End: #


