Geoinformatica  0.90
Scale.pm
Go to the documentation of this file.
1 package Scale;
2 our @ISA = qw(Gtk2::Ex::Geo::Layer);
3 sub new {
4  my($package, %param) = @_;
5  my $self = Gtk2::Ex::Geo::Layer::new($package);
6  $self->{dx} = $param{dx};
7  $self->{dy} = $param{dy};
8  return $self;
9 }
10 sub name {
11  'scale';
12 }
13 sub world {
14  return (3470000, 6670000, 347000, 6670000);
15 }
16 sub render {
17  my($self, $pb, $cr, $overlay, $viewport) = @_;
18  my $px = $overlay->{pixel_size};
19  my $box = 20;
20  my $layout = Gtk2::Pango::Cairo::create_layout($cr);
21  my $font_desc = Gtk2::Pango::FontDescription->from_string("sans 10");
22  $layout->set_font_description($font_desc);
23  my $w = ($viewport->[2]-$viewport->[0])/$px;
24  my $h = ($viewport->[3]-$viewport->[1])/$px;
25  $w -= 0.5;
26  $h -= 0.5;
27  my $dx = $self->{dx} || 0;
28  my $dy = $self->{dy} || 0;
29 
30  my $x = 100*$px;
31  my $i = 0;
32  while ($x > 10) {
33  $i++;
34  $x /= 10;
35  }
36  if ($x < 1.5) {
37  $x = 1;
38  } elsif ($x < 3.5) {
39  $x = 2;
40  } elsif ($x < 7.5) {
41  $x = 5;
42  } else {
43  $x = 1;
44  $i++;
45  }
46  my $u;
47  my $s = $x;
48  $x = int($x*10**$i / $px);
49  if ($i < 3) {
50  $u = ' m';
51  } else {
52  $i -= 3;
53  $u = ' km';
54  }
55  $s .= ('0' x $i) . $u;
56 
57  $cr->set_line_width(1);
58  $cr->set_source_rgba(0, 0, 0, 1);
59  $cr->move_to($w-$dx-20, $h-$dy-6);
60  $cr->rel_line_to(0, -5);
61  $cr->rel_move_to(0, 5);
62  $cr->rel_line_to(-$x, 0);
63  $cr->rel_line_to(0, -5);
64  $cr->stroke();
65 
66  $layout->set_text($s);
67  my ($w2, $h2) = $layout->get_pixel_size;
68  $cr->move_to($w-$dx-20-$x/2-$w2/2, $h-$dy-8-$h2);
69 
70  Gtk2::Pango::Cairo::show_layout($cr, $layout);
71 
72 }
73 
74 1;
public method new(hash params)
A class method. Constructs a new layer object or blesses an object into a layer class. Calls defaults with the given parameters.