/[maps]/stich.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /stich.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations)
Mon Oct 15 21:15:26 2007 UTC (16 years, 5 months ago) by dpavlin
File MIME type: text/plain
File size: 2638 byte(s)
inteligently stich bunch of pictures into one map
1 dpavlin 2 #!/usr/bin/perl -w
2    
3     # stich.pl
4     #
5     # 10/15/07 22:02:18 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6    
7     use strict;
8    
9     use File::Find;
10     use Data::Dump qw/dump/;
11     use Imager;
12    
13     my $path = shift @ARGV || die "usage: $0 path_to_dump_dir\n";
14    
15     my ( $range, $usage );
16    
17     my @files;
18     my $file_pos;
19    
20     find( sub {
21     return unless -f $_;
22    
23     if ( $_ =~ m/(\d+)-(\d+)/ ) {
24    
25     push @files, $_;
26    
27     my ( $x, $y ) = ( $1, $2 );
28    
29     $range->{min}->{x} = $x if not defined $range->{min}->{x} or $x < $range->{min}->{x};
30     $range->{max}->{x} = $x if not defined $range->{max}->{x} or $x > $range->{max}->{x};
31    
32     $range->{min}->{y} = $y if not defined $range->{min}->{y} or $y < $range->{min}->{y};
33     $range->{max}->{y} = $y if not defined $range->{max}->{y} or $y > $range->{max}->{y};
34    
35     $usage->{x}->{$x}++;
36     $usage->{y}->{$y}++;
37    
38     $file_pos->{$_} = { x => $x, y => $y };
39    
40     warn "## $_\n";
41    
42     } else {
43    
44     warn "SKIPPED: $_\n";
45     }
46    
47    
48    
49     }, $path );
50    
51     print "range = ",dump( $range ), "\n";
52     print "usage = ",dump( $usage ). "\n";
53    
54     my $step_size;
55    
56     foreach my $axis ( 'x', 'y' ) {
57    
58     my $last = $range->{min}->{$axis};
59    
60     foreach my $v ( sort keys %{$usage->{$axis}} ) {
61    
62     next if $v == $last;
63    
64     $step_size->{$axis}->{ $v - $last }++;
65     $last = $v;
66    
67     }
68     undef $last;
69     }
70    
71     print "step_size = ",dump( $step_size ),"\n";
72    
73     my $step = {
74     x => ( sort { $step_size->{x}->{$b} <=> $step_size->{x}->{$a} } keys %{ $step_size->{x} } )[0],
75     y => ( sort { $step_size->{y}->{$b} <=> $step_size->{y}->{$a} } keys %{ $step_size->{y} } )[0],
76     };
77    
78     print "selected step = ",dump( $step ),"\n";
79    
80    
81     my $img = Imager->new();
82     $img->read( file => $path . '/' . $files[0] ) or die $img->errstr();
83     my $tile_size = {
84     x => $img->getwidth,
85     y => $img->getheight,
86     };
87    
88     print "tile_size = ",dump( $tile_size ),"\n";
89    
90     my $x_tiles = ( $range->{max}->{x} - $range->{min}->{x} ) / $step->{x};
91     my $y_tiles = ( $range->{max}->{y} - $range->{min}->{y} ) / $step->{y};
92    
93     my $x_size = $x_tiles * $tile_size->{x};
94     my $y_size = $y_tiles * $tile_size->{y};
95    
96     print "final map size: $x_size x $y_size from $x_tiles x $y_tiles tiles\n";
97    
98     my $map = Imager->new( xsize => $x_size, ysize => $y_size );
99    
100     foreach my $tile_file ( @files ) {
101     $img->read( file => "$path/$tile_file" ) or die $img->errstr();
102    
103     # this is specific to globe position, I guess ... this is europe
104     my $x = ( $file_pos->{$tile_file}->{x} - $range->{min}->{x} ) / $step->{x};
105     my $y = ( $range->{max}->{y} - $file_pos->{$tile_file}->{y} ) / $step->{y};
106    
107     printf("%3dx%-3d %s\n", $x, $y, $tile_file);
108    
109     $map->paste(
110     src => $img,
111     left => $x * $tile_size->{x},
112     top => $y * $tile_size->{y},
113     );
114     }
115    
116     $map->write( file => 'dump.png' ) or die $img->errstr();

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26