Geoinformatica  0.90
Overlay.pm
Go to the documentation of this file.
1 #** @file Overlay.pm
2 #*
3 package Gtk2::Ex::Geo::Overlay;
4 
5 use strict;
6 use POSIX;
7 use Scalar::Util qw(blessed);
8 use Carp;
9 use Glib qw/TRUE FALSE/;
11 
12 use vars qw / $EDIT_SNAP_DISTANCE /;
13 
14 our $VERSION = '0.62'; # same as Geo.pm
15 
16 $EDIT_SNAP_DISTANCE = 5;
17 
18 use Glib::Object::Subclass
19  Gtk2::ScrolledWindow::,
20  signals => {
21  update_layers => {}, # sent just before the layers are rendered
22  new_selection => {}, # sent after the user has changed the selection
23  drawing_changed => {},# sent after the user has changed the drawing
24  zoomed_in => {}, # deprecated
25  extent_changed => {}, # deprecated
26  motion_notify => {}, # the mouse has a new location on the map
27  map_updated => {}, # deprecated
28  pixmap_ready => {}, # sent just after pixmap is ready, but selection and drawing
29  # haven't been rendered, connect to this for annotations
30  },
31  properties =>
32  [
33  Glib::ParamSpec->double
34  (
35  'zoom_factor', 'Zoom factor',
36  'Zoom multiplier when user presses + or -',
37  0.1, 1000, 1.2, [qw/readable writable/]
38  ),
39  Glib::ParamSpec->double
40  (
41  'step', 'Step',
42  'One step when scrolling is window width/height divided by step',
43  1, 100, 8, [qw/readable writable/]
44  ),
45  ]
46  ;
47 
48 sub INIT_INSTANCE {
49  my $self = shift;
50 
51  $self->{image} = Gtk2::Image->new;
52  $self->{image}->set_size_request(0, 0);
53  $self->{image}->signal_connect(size_allocate => \&size_allocate, $self);
54 
55  $self->{event_box} = Gtk2::EventBox->new;
56 
57  $self->{event_box}->add($self->{image});
58 
59  $self->{event_box}->signal_connect(button_press_event => \&button_press_event, $self);
60  $self->{event_box}->signal_connect(button_release_event => \&button_release_event, $self);
61 
62  $self->{event_box}->add_events('pointer-motion-mask');
63  $self->{event_box}->signal_connect(motion_notify_event => \&motion_notify, $self);
64 
65  $self->signal_connect(key_press_event => \&key_press_event, $self);
66  $self->signal_connect(key_release_event => \&key_release_event, $self);
67 
68  $self->signal_connect(scroll_event => \&scroll_event, $self);
69 
70  $self->{selecting} = '';
71  $self->{rubberband_geometry} = '';
72  $self->{rubberband_mode} = '';
73 
74  # why do I need to set these two?
75  $self->{zoom_factor} = 1.2;
76  $self->{step} = 8;
77 
78  $self->{offset} = [0, 0];
79  $self->{bg_color} = [255, 255, 255, 255];
80  $self->{selection_color} = [255*257, 178*257, 0];
81  $self->{selection_style} = 'GDK_LINE_SOLID';
82  $self->{drawing_color} = [0, 65535, 0];
83  $self->{show_selection} = 1;
84 
85  $self->{layers} = [];
86 }
87 
88 ## @method
89 # @brief Attempt to delete all widgets within this widget.
90 sub close {
91  my $self = shift;
92  while (my($key, $widget) = each %$self) {
93  $widget->destroy if blessed($widget) and $widget->isa("Gtk2::Widget");
94  delete $self->{$key};
95  }
96 }
97 
98 sub size_allocate {
99  my($image, $allocation, $self) = @_;
100  my @old_v = (0, 0);
101  @old_v = @{$self->{viewport_size}} if $self->{viewport_size};
102  my @v = $allocation->values;
103  @{$self->{viewport_size}} = @v[2..3];
104  $self->render() if $v[2] != $old_v[0] or $v[3] != $old_v[1];
105  return 0;
106 }
107 
108 ## @method my_inits
109 # @brief call after new
110 # @todo merge into new
111 sub my_inits {
112  my($self, %params) = @_;
113  $self->{inited} = 1;
114 
115  $self->get_hscrollbar()->signal_connect(value_changed => \&value_changed, $self);
116  $self->get_vscrollbar()->signal_connect(value_changed => \&value_changed, $self);
117 
118  $self->add_with_viewport($self->{event_box});
119 
120  for (keys %params) {
121  if ($_ eq 'bg_color' or $_ eq 'offset') {
122  @{$self->{$_}} = @{$params{$_}};
123  next;
124  }
125  $self->{$_} = $params{$_};
126  }
127 }
128 
129 ## @method add_layer($layer, $do_not_zoom_to)
130 # @brief Add a layer to the list and by default zoom to it.
131 # Always zooms to the first layer added.
132 sub add_layer {
133  my($self, $layer, $do_not_zoom_to) = @_;
134  return unless blessed($layer) and $layer->isa('Gtk2::Ex::Geo::Layer');
135  push @{$self->{layers}}, $layer;
136  # MUST zoom to if this is the first layer
137  $do_not_zoom_to = 0 unless $self->{first_added};
138  $self->my_inits unless $self->{inited};
139  unless ($do_not_zoom_to) {
140  $self->zoom_to($layer) if $self->{viewport_size};
141  }
142  $self->{first_added} = 1;
143  return $#{$self->{layers}};
144 }
145 
146 ## @method layer_count()
147 # @brief Get the number of layers in the list.
148 sub layer_count {
149  my($self) = @_;
150  my $count = @{$self->{layers}};
151  return $count;
152 }
153 
154 ## @method layer_count($layer)
155 # @brief Return true if given layer object is in the list.
156 sub has_layer {
157  my($self, $layer) = @_;
158  for (@{$self->{layers}}) {
159  next unless ref($_) eq ref($layer);
160  return 1 if ref($_) eq ref($layer);
161  }
162  return 0;
163 }
164 
165 ## @method layer_count($name)
166 # @brief Get the index of the given layer in the list.
167 sub index_of_layer {
168  my($self, $name) = @_;
169  my $i = $#{$self->{layers}};
170  for my $layer (@{$self->{layers}}) {
171  return $i if $layer->name() eq $name;
172  $i--;
173  }
174  return undef;
175 }
176 
177 ## @method get_layer_by_index($index)
178 sub get_layer_by_index {
179  my($self, $index) = @_;
180  return unless $index >= 0 and $index <= $#{$self->{layers}};
181  return $self->{layers}->[$#{$self->{layers}} - $index];
182 }
183 
184 ## @method get_layer_by_name($name)
185 sub get_layer_by_name {
186  my($self, $name) = @_;
187  for my $layer (@{$self->{layers}}) {
188  return $layer if $layer->name() eq $name;
189  }
190 }
191 
192 ## @method remove_layer_by_index($index)
193 sub remove_layer_by_index {
194  my($self, $index) = @_;
195  my $n = $#{$self->{layers}};
196  return 0 unless $index >= 0 and $index <= $n;
197  splice(@{$self->{layers}}, $n-$index, 1);
198  return 1;
199 }
200 
201 ## @method remove_layer_by_name($index)
202 sub remove_layer_by_name {
203  my($self, $name) = @_;
204  for my $index (0..$#{$self->{layers}}) {
205  if ($self->{layers}->[$index]->name() eq $name) {
206  splice(@{$self->{layers}}, $index, 1);
207  return 1;
208  }
209  }
210  return 0;
211 }
212 
213 ## @method zoom_to($layer)
214 # @brief Tries to set the given bounding box as the world.
215 
216 ## @method zoom_to($minx, $miny, $maxx, $maxy)
217 # @brief Tries to set the given bounding box as the world.
218 sub zoom_to {
219  my $self = shift;
220 
221  # up left (minX, maxY) is fixed, adjust maxX or minY
222  delete $self->{zoom_stack};
223 
224  my @vp1 = $self->get_viewport;
225 
226  my @bounds; # minX, minY, maxX, maxY
227 
228  if (@_ == 1) {
229  my $layer = shift;
230  return unless $self->{layers} and @{$self->{layers}};
231  eval {
232  @bounds = $layer->world();
233  };
234  @bounds = (0,0,1,1) unless @bounds;
235  $self->{offset} = [0, 0];
236  } elsif (@_ == 5) {
237  my($minX, $maxY, $pixel_size, @offset) = @_;
238  $pixel_size = 1 if $pixel_size <= 0;
239  $self->{pixel_size} = $pixel_size;
240  @bounds = ($minX,
241  $maxY-$pixel_size*$self->{viewport_size}->[1],
242  $minX+$pixel_size*$self->{viewport_size}->[0],
243  $maxY);
244  $self->{offset} = [@offset];
245  } else {
246  @bounds = @_;
247  $self->{offset} = [0, 0];
248  }
249 
250  # sanity check
251  $bounds[2] = $bounds[0]+1 if $bounds[2] <= $bounds[0];
252  $bounds[3] = $bounds[1]+1 if $bounds[3] <= $bounds[1];
253 
254  my($w, $h) = @{$self->{viewport_size}};
255  @{$self->{canvas_size}} = @{$self->{viewport_size}};
256  $self->{pixel_size} = max(($bounds[2]-$bounds[0])/$w,($bounds[3]-$bounds[1])/$h);
257  push @{$self->{zoom_stack}}, [@{$self->{offset}}, $self->{pixel_size}];
258 
259  $self->{minX} = $bounds[0];
260  $self->{maxY} = $bounds[3];
261  $self->{maxX} = $bounds[0]+$self->{pixel_size}*$w;
262  $self->{minY} = $bounds[3]-$self->{pixel_size}*$h;
263 
264  $self->render() if $self->{first_added};
265 
266  my @vp2 = $self->get_viewport;
267  if (!@vp1 or ($vp2[0] >= $vp1[0] and $vp2[1] >= $vp1[1] and $vp2[2] <= $vp1[2] and $vp2[3] <= $vp1[3])) {
268  $self->signal_emit('zoomed-in');
269  } else {
270  $self->signal_emit('extent-changed');
271  }
272 }
273 
274 ## @method get_world()
275 # @brief Get the total area of the canvas.
276 # @return (min_x, min_y, max_x, max_y)
277 sub get_world {
278  my $self = shift;
279  return ($self->{minX}, $self->{minY}, $self->{maxX}, $self->{maxY});
280 }
281 
282 ## @method get_viewport()
283 # @brief Get the visible area of the canvas.
284 # @return (min_x, min_y, max_x, max_y)
285 sub get_viewport {
286  my $self = shift;
287  return () unless defined $self->{minX};
288  my $minX = $self->{minX}+$self->{offset}[0]*$self->{pixel_size};
289  my $maxY = $self->{maxY}-$self->{offset}[1]*$self->{pixel_size};
290  return ( $minX, $maxY-$self->{viewport_size}->[1]*$self->{pixel_size},
291  $minX+$self->{viewport_size}->[0]*$self->{pixel_size}, $maxY );
292 }
293 
294 ## @method get_viewport_of_selection()
295 # @brief Get the visible area of the canvas.
296 # @return (min_x, min_y, max_x, max_y)
297 sub get_viewport_of_selection {
298  my $self = shift;
299  return unless $self->{selection};
300  my $e = $self->{selection}->Envelope;
301  my $ll = $e->PointN(1);
302  my $ur = $e->PointN(3);
303  return ($ll->X, $ll->Y, $ur->X, $ur->Y);
304 }
305 
306 ## @method size()
307 # @brief The size of the viewport in pixels (height, width)
308 sub size {
309  my $self = shift;
310  return ($self->{viewport_size}->[1], $self->{viewport_size}->[0]);
311 }
312 
313 ## @method zoom_to_all()
314 # @brief Sets the world as the bounding box for all layers
315 sub zoom_to_all {
316  my($self) = @_;
317  return unless $self->{layers} and @{$self->{layers}};
318  my @size;
319  for my $layer (@{$self->{layers}}) {
320  my @s;
321  eval {
322  @s = $layer->world();
323  };
324  next unless @s;
325  if (@size) {
326  $size[0] = min($size[0], $s[0]);
327  $size[1] = min($size[1], $s[1]);
328  $size[2] = max($size[2], $s[2]);
329  $size[3] = max($size[3], $s[3]);
330  } else {
331  @size = @s;
332  }
333  }
334  $self->zoom_to(@size) if @size;
335 }
336 
337 sub value_changed {
338  my(undef, $self) = @_;
339  push @{$self->{zoom_stack}}, [@{$self->{offset}}, $self->{pixel_size}];
340  $self->{offset} = [$self->get_hadjustment()->value(), $self->get_vadjustment()->value()];
341  $self->signal_emit('extent-changed');
342  $self->render();
343  return 1;
344 }
345 
346 ## @method get_focus()
347 # @deprecated use get_viewport_of_selection or get_viewport
348 # @returns the visible area or the selection, if one exists, as ($minx, $miny, $maxx, $maxy).
349 sub get_focus {
350  my($self) = @_;
351  if ($self->{selection}) {
352  my $e = $self->{selection}->Envelope;
353  my $ll = $e->PointN(1);
354  my $ur = $e->PointN(3);
355  return ($ll->X, $ll->Y, $ur->X, $ur->Y);
356  } else {
357  my $minX = $self->{minX}+$self->{offset}[0]*$self->{pixel_size};
358  my $maxY = $self->{maxY}-$self->{offset}[1]*$self->{pixel_size};
359  return ($minX, $maxY-$self->{viewport_size}->[1]*$self->{pixel_size},
360  $minX+$self->{viewport_size}->[0]*$self->{pixel_size}, $maxY);
361  }
362 }
363 
364 {
365  package Gtk2::Ex::Geo::PseudoOverlay;
366  sub round {
367  return int($_[0] + .5 * ($_[0] <=> 0));
368  }
369  sub new {
370  my($class, $minX, $maxY, $pixel_size) = @_;
371  my $self = { minX => $minX,
372  maxY => $maxY,
373  pixel_size => $pixel_size
374  };
375  bless($self, $class);
376  }
377  sub point2pixmap_pixel {
378  my($self, @p) = @_;
379  return (round(($p[0] - $self->{minX})/$self->{pixel_size} - 0.5),
380  round(($self->{maxY} - $p[1])/$self->{pixel_size} - 0.5));
381  }
382  package Gtk2::Ex::Geo::Canvas;
383  use base qw(Gtk2::Gdk::Pixbuf);
384 
385  sub new {
386  my($class, $layers,
387  $minX, $maxY, $pixel_size, $w_offset, $h_offset,
388  $width, $height,
389  $bg_r, $bg_g, $bg_b, $bg_a, $overlay) = @_;
390 
391  return unless defined $minX;
392 
393  $overlay = Gtk2::Ex::Geo::PseudoOverlay->new($minX, $maxY, $pixel_size) unless $overlay;
394 
395  my @viewport = ($minX+$pixel_size*$w_offset, 0, 0, $maxY-$pixel_size*$h_offset);
396  $viewport[2] = $viewport[0]+$pixel_size*$width;
397  $viewport[1] = $viewport[3]-$pixel_size*$height;
398 
399  my $pb = Gtk2::Ex::Geo::Pixbuf::create($width, $height,
400  $viewport[0], $viewport[3],
401  $pixel_size,
402  $bg_r, $bg_g, $bg_b, $bg_a);
403 
404  my $surface = $pb->get_cairo_surface();
405  my $cr = Cairo::Context->create($surface);
406 
407  for my $layer (@$layers) {
408  $layer->render($pb, $cr, $overlay, \@viewport) if $layer->{VISIBLE};
409  }
410 
411  undef $cr;
412  undef $surface;
413  my $self = $pb->get_pixbuf();
414  $pb->destroy(); # does not delete the real pixbuf
415 
416  bless($self, $class);
417  }
418 }
419 
420 package Gtk2::Ex::Geo::Overlay;
421 
422 ## @method render(%params)
423 # @brief Render the layers on the canvas.
424 # Each layer's render method is called:
425 # @code
426 # $layer->render($pixbuf_struct, $cairo_context, $self, \@viewport);
427 # @endcode
428 # If named parameter filename is set, the generated pixbuf is saved to it:
429 # @code
430 # $pixbuf->save($params{filename}, $params{type});
431 # @endcode
432 # The generated pixmap that is shown is annotated with selection and
433 # user defined annotation function.
434 sub render {
435  my $self = shift;
436  my %opt = @_;
437 
438  my $size = $self->{viewport_size};
439  return unless $size->[0];
440 
441  $self->signal_emit('update-layers');
442 
443  my @tmp = ($self->{minX}, $self->{maxY}, $self->{pixel_size}, @{$self->{offset}});
444  $self->{pixbuf} = Gtk2::Ex::Geo::Canvas->new
445  ($self->{layers}, @tmp, @{$size}, @{$self->{bg_color}}[0..3], $self);
446 
447  return unless $self->{pixbuf};
448 
449  if ($opt{filename}) {
450  my $filename = $opt{filename};
451  delete $opt{filename};
452  my $type = $opt{type};
453  delete $opt{type};
454  # other options...
455  $self->{pixbuf}->save($filename, $type);
456  return;
457  }
458 
459  $self->update_image();
460 
461  $self->{old_hadj} = $self->get_hscrollbar->get_adjustment; # prevents a warning
462  $self->get_hscrollbar->set_adjustment
463  (Gtk2::Adjustment->new($self->{offset}[0], 0, $self->{canvas_size}[0], $size->[0]/20,
464  $size->[0], $size->[0]));
465 
466  $self->{old_vadj} = $self->get_vscrollbar->get_adjustment; # prevents a warning
467  $self->get_vscrollbar->set_adjustment
468  (Gtk2::Adjustment->new($self->{offset}[1], 0, $self->{canvas_size}[1], $size->[1]/20,
469  $size->[1], $size->[1]));
470 
471  $self->signal_emit ('map-updated');
472 
473 }
474 
475 ## @method render_geometry($gc, $geom)
476 # @brief Render a geometry on the overlay.
477 #
478 # @note this should be called annotate or made detect the context (gdk vs cairo)
479 # Call update_image after you are finished with drawing on the pixmap.
480 # @param gc A gdk graphics context (Gtk2::Gdk::GC object)
481 # @param geom A Geo::OGC::Geometry object.
482 sub render_geometry {
483  my($self, $gc, $geom, %param) = @_;
484  if ($geom->isa('Geo::OGC::GeometryCollection'))
485  {
486  for my $g ($geom->NumGeometries) {
487  $self->render_geometry($gc, $g, %param);
488  }
489  return;
490  }
491  elsif ($geom->isa('Geo::OGC::Point'))
492  {
493  my @p = $self->point2pixmap_pixel($geom->X, $geom->Y);
494  $self->{pixmap}->draw_line($gc, $p[0]-4, $p[1], $p[0]+4, $p[1]);
495  $self->{pixmap}->draw_line($gc, $p[0], $p[1]-4, $p[0], $p[1]+4);
496  }
497  elsif ($geom->isa('Geo::OGC::LineString'))
498  {
499  my @points;
500  for my $p ($geom->NumPoints) {
501  push @points, $self->point2pixmap_pixel($p->X, $p->Y);
502  }
503  $self->{pixmap}->draw_lines($gc, @points);
504  if ($param{enhance_vertices}) {
505  my $pm = $self->{pixmap};
506  for (my $i = 0; $i < $#points; $i+=2) {
507  my $x = $points[$i];
508  my $y = $points[$i+1];
509  $pm->draw_line($gc, $x-4, $y, $x+4, $y);
510  $pm->draw_line($gc, $x, $y-4, $x, $y+4);
511  }
512  }
513  }
514  elsif ($geom->isa('Geo::OGC::Polygon'))
515  {
516  $self->render_geometry($gc, $geom->ExteriorRing, %param);
517  for my $i (0..$geom->NumInteriorRing-1) {
518  $self->render_geometry($gc, $geom->InteriorRingN($i), %param);
519  }
520  }
521 }
522 
523 ## @method update_image($annotations, $user_param)
524 # @param annotations A subroutine for user annotations. Called like
525 # this: $annotations->($overlay, $pixmap, $gc, $user_param).
526 # @param user_param User parameter for the annotations.
527 # @brief Updates the image on the screen to show the changes in pixmap.
528 sub update_image {
529  my($self, $annotations, $user_param) = @_;
530  return unless $self->{pixbuf};
531  $self->{image}->set_from_pixbuf(undef);
532  $self->{pixmap} = $self->{pixbuf}->render_pixmap_and_mask(0);
533  my $gc = Gtk2::Gdk::GC->new($self->{pixmap});
534  $self->{pixmap}->draw_line($gc, 0, 0, 0, 0); # strange bug, the first line is not drawn
535  $self->signal_emit('pixmap_ready');
536  my $first = 1;
537  if ($self->{drawing}) {
538  $gc->set_rgb_fg_color(Gtk2::Gdk::Color->new(@{$self->{drawing_color}}));
539  my $style = 'GDK_LINE_SOLID';
540  $gc->set_line_attributes(2, $style, 'GDK_CAP_NOT_LAST', 'GDK_JOIN_MITER');
541  $self->render_geometry($gc, $self->{drawing}, enhance_vertices => 1);
542  }
543  if ($self->{selection} and $self->{show_selection}) {
544  $gc->set_rgb_fg_color(Gtk2::Gdk::Color->new(@{$self->{selection_color}}));
545  my $style = $self->{selection_style};
546  $style = 'GDK_LINE_SOLID';
547  $gc->set_line_attributes(2, $style, 'GDK_CAP_NOT_LAST', 'GDK_JOIN_MITER');
548  $self->render_geometry($gc, $self->{selection});
549  }
550  $annotations->($self, $self->{pixmap}, $gc, $user_param) if $annotations;
551  $self->{image}->set_from_pixmap($self->{pixmap}, undef);
552 }
553 
554 ## @method zoom($w_offset, $h_offset, $pixel_size)
555 # @brief Select a part of the world into the visible area.
556 sub zoom {
557  my($self, $w_offset, $h_offset, $pixel_size, $zoomed_in, $not_to_stack) = @_;
558 
559  push @{$self->{zoom_stack}}, [@{$self->{offset}}, $self->{pixel_size}] unless $not_to_stack;
560 
561  $self->{offset} = [$w_offset, $h_offset];
562 
563  # sanity check
564  $pixel_size = 1 if $pixel_size <= 0;
565  $self->{pixel_size} = $pixel_size;
566 
567  my $w = ($self->{maxX}-$self->{minX})/$self->{pixel_size};
568  my $h = ($self->{maxY}-$self->{minY})/$self->{pixel_size};
569 
570  $self->{canvas_size} = [$w, $h];
571 
572  $self->render();
573  if ($zoomed_in) {
574  $self->signal_emit('zoomed-in');
575  } else {
576  $self->signal_emit('extent-changed');
577  }
578 }
579 
580 sub _zoom {
581  my($self, $in, $event, $center_x, $center_y, $zoomed_in) = @_;
582 
583  return unless $self->{layers} and @{$self->{layers}};
584 
585  my @old_offset = @{$self->{offset}};
586 
587  # the center point should stay where it is unless center is defined
588  $center_x = $self->{minX} +
589  ($self->{offset}[0]+$self->{viewport_size}->[0]/2)*$self->{pixel_size} unless defined $center_x;
590  $center_y = $self->{maxY} -
591  ($self->{offset}[1]+$self->{viewport_size}->[1]/2)*$self->{pixel_size} unless defined $center_y;
592 
593  $self->{pixel_size} = $in ?
594  $self->{pixel_size} / $self->{zoom_factor} :
595  $self->{pixel_size} * $self->{zoom_factor};
596 
597  $self->{offset} =
598  [int(($center_x - $self->{minX})/$self->{pixel_size} - $self->{viewport_size}->[0]/2),
599  int(($self->{maxY} - $center_y)/$self->{pixel_size} - $self->{viewport_size}->[1]/2)];
600 
601  $self->zoom(@{$self->{offset}}, $self->{pixel_size}, $zoomed_in);
602 
603  for (0, 1) {
604  $self->{event_coordinates}->[$_] += $self->{offset}[$_] - $old_offset[$_];
605  }
606 }
607 
608 ## @method zoom_in($event, $center_x, $center_y)
609 # @brief Zooms in an amount determined by the zoom_factor.
610 sub zoom_in {
611  my($self, $event, $center_x, $center_y) = @_;
612  $self->_zoom(1, $event, $center_x, $center_y, 1);
613 }
614 
615 ## @method zoom_out($event, $center_x, $center_y)
616 # @brief Zooms out an amount determined by the zoom_factor.
617 # Note: : may enlarge the world.
618 sub zoom_out {
619  my($self, $event, $center_x, $center_y) = @_;
620  if ($self->{offset}[0] == 0 and $self->{offset}[1] == 0) {
621  my $dx = ($self->{maxX}-$self->{minX})*$self->{zoom_factor}/6.0;
622  my $dy = ($self->{maxY}-$self->{minY})*$self->{zoom_factor}/6.0;
623  $self->zoom_to($self->{minX}-$dx, $self->{minY}-$dy, $self->{maxX}+$dx, $self->{maxY}+$dy);
624  } else {
625  $self->_zoom(0, $event, $center_x, $center_y);
626  }
627 }
628 
629 ## @method pan($w_move, $h_move, $event)
630 # @brief Pans the viewport.
631 sub pan {
632  my($self, $w_move, $h_move, $event) = @_;
633 
634  $w_move = floor($w_move);
635  $h_move = floor($h_move);
636 
637  $self->{event_coordinates}[0] += $w_move;
638  $self->{event_coordinates}[1] += $h_move;
639 
640  push @{$self->{zoom_stack}}, [@{$self->{offset}}, $self->{pixel_size}];
641  $self->{offset} = [$self->{offset}[0] + $w_move, $self->{offset}[1] + $h_move];
642 
643  $self->render();
644 
645  $self->signal_emit('extent-changed');
646 }
647 
648 ## @method key_press_event($event)
649 # @brief Handling of key press events.
650 #
651 # Tied to key_press_event and key_release_event. Ties "+" to zoom_in,
652 # "-" to zoom_out,and arrow keysto pan. Also ties "Enter" to finishing
653 # making a selection. Records press and release of "Ctrl" to object
654 # attribute "_control_down".
655 sub key_press_event {
656  my($self, $event) = @_;
657 
658  return 0 unless $self->{layers} and @{$self->{layers}};
659 
660  my $key = $event->keyval;
661  #print STDERR "key=$key\n";
662  if ($key == $Gtk2::Gdk::Keysyms{plus}) {
663  $self->zoom_in($event); # , $self->event_pixel2point());
664  } elsif ($key == $Gtk2::Gdk::Keysyms{minus}) {
665  $self->zoom_out($event); # , $self->event_pixel2point());
666  } elsif ($key == $Gtk2::Gdk::Keysyms{Right}) {
667  $self->pan($self->{viewport_size}->[0]/$self->{step}, 0, $event);
668  } elsif ($key == $Gtk2::Gdk::Keysyms{Left}) {
669  $self->pan(-$self->{viewport_size}->[0]/$self->{step}, 0, $event);
670  } elsif ($key == $Gtk2::Gdk::Keysyms{Up}) {
671  $self->pan(0, -$self->{viewport_size}->[1]/$self->{step}, $event);
672  } elsif ($key == $Gtk2::Gdk::Keysyms{Down}) {
673  $self->pan(0, $self->{viewport_size}->[1]/$self->{step}, $event);
674  } elsif ($key == $Gtk2::Gdk::Keysyms{Escape}) {
675  $self->delete_rubberband;
676  } elsif ($key == $Gtk2::Gdk::Keysyms{Return}) {
677  if ($self->draw_mode and $self->{path}) {
678  if ($self->{rubberband_geometry} eq 'polygon') {
679  if (@{$self->{path}} > 2) {
680  my $geom = new Geo::OGC::Polygon;
681  my $r = new Geo::OGC::LinearRing;
682  # exterior is ccw
683  for my $p (@{$self->{path}}) {
684  $r->AddPoint(Geo::OGC::Point->new($self->event_pixel2point(@$p)));
685  }
686  $r->Close;
687  $geom->ExteriorRing($r);
688  $self->add_to_selection($geom);
689  }
690  } elsif ($self->{rubberband_geometry} eq 'path') {
691  if (@{$self->{path}} > 1) {
692  my $geom = new Geo::OGC::LineString;
693  for my $p (@{$self->{path}}) {
694  $geom->AddPoint(Geo::OGC::Point->new($self->event_pixel2point(@$p)));
695  }
696  $self->add_to_selection($geom);
697  }
698  }
699  }
700  $self->delete_rubberband;
701 
702  } elsif ($key == $Gtk2::Gdk::Keysyms{Insert}) {
703 
704  if ($self->{rubberband_mode} eq 'edit' and $self->{drawing}) {
705 
706  # find the closest point in drawing
707  my @p = $self->event_pixel2point(@{$self->{event_coordinates}});
708  my @r = $self->{drawing}->ClosestPoint(@p);
709  my $d = pop @r;
710  if (@r and $d/$self->{pixel_size} < $EDIT_SNAP_DISTANCE) {
711  $self->{drawing}->AddVertex(@r);
712  $self->signal_emit('drawing-changed');
713  $self->update_image;
714  }
715  }
716 
717  } elsif ($key == $Gtk2::Gdk::Keysyms{Delete}) {
718 
719  if ($self->{rubberband_mode} eq 'edit' and $self->{drawing}) {
720 
721  # find the closest vertex in drawing
722  my @p = $self->event_pixel2point(@{$self->{event_coordinates}});
723  my @r = $self->{drawing}->ClosestVertex(@p);
724  my $d = pop @r;
725  if (@r and $d/$self->{pixel_size} < $EDIT_SNAP_DISTANCE) {
726  $self->{drawing}->DeleteVertex(@r);
727  $self->signal_emit('drawing-changed');
728  $self->update_image;
729  }
730  }
731 
732  } elsif (($key == $Gtk2::Gdk::Keysyms{Control_L} or $key == $Gtk2::Gdk::Keysyms{Control_R}) and
733  $self->draw_mode) {
734  $self->{_control_down} = 1;
735  } elsif (($key == $Gtk2::Gdk::Keysyms{Shift_L} or $key == $Gtk2::Gdk::Keysyms{Shift_R}) and
736  $self->draw_mode and
737  ($self->{drawing} and $self->{drawing}->LastPolygon)) {
738  $self->{_shift_down} = 1;
739  }
740  return 0;
741 }
742 
743 sub scroll_event {
744  my($self, $event) = @_;
745  return 0 unless $self->{layers} and @{$self->{layers}};
746  my $dir = $event->direction;
747  #print STDERR "dir=$dir\n";
748  if ($dir eq 'up') {
749  $self->zoom_in($event);
750  } elsif ($dir eq 'down') {
751  $self->zoom_out($event);
752  }
753 }
754 
755 sub draw_mode {
756  my($self) = @_;
757  return ($self->{rubberband_mode} eq 'select' or $self->{rubberband_mode} eq 'draw');
758 }
759 
760 ## @method key_release_event($event)
761 # @brief Handling of key release events.
762 #
763 # Unsets object attribute "_control_down" if "Ctrl" released.
764 sub key_release_event {
765  my($self, $event) = @_;
766  my $key = $event->keyval;
767  if ($key == $Gtk2::Gdk::Keysyms{Control_L} or $key == $Gtk2::Gdk::Keysyms{Control_R}) {
768  $self->{_control_down} = 0;
769  } elsif ($key == $Gtk2::Gdk::Keysyms{Shift_L} or $key == $Gtk2::Gdk::Keysyms{Shift_R}) {
770  $self->{_shift_down} = 0;
771  }
772 }
773 
774 sub add_to_selection {
775  my($self, $geom) = @_;
776  my $store = ($self->{rubberband_mode} eq 'select') ? 'selection' : 'drawing';
777  if ($self->{_control_down}) {
778 
779  # create first a multi something, then fall back to collection if need be
780 
781  unless ($self->{$store} and $self->{$store}->isa('Geo::OGC::GeometryCollection')) {
782  my $coll = Geo::OGC::GeometryCollection->new;
783  $coll->AddGeometry($self->{$store}) if $self->{$store};
784  $self->{$store} = $coll;
785  }
786  $self->{$store}->AddGeometry($geom) if $geom;
787  } elsif ($self->{_shift_down}) {
788  my $polygon = $self->{$store}->LastPolygon;
789  if ($polygon and $geom->isa('Geo::OGC::Polygon')) {
790  $geom = $geom->ExteriorRing;
791  # exterior is ccw, interior is cw
792  $geom->Rotate;
793  $polygon->AddInteriorRing($geom);
794  }
795  } else {
796  $self->{$store} = $geom;
797  }
798  $self->signal_emit('new_selection') if $self->{rubberband_mode} eq 'select';
799  $self->signal_emit('drawing-changed') if $self->{rubberband_mode} eq 'draw';
800 }
801 
802 ## @method button_press_event()
803 # @brief Pops up a context menu or (optionally) does rubberbanding.
804 sub button_press_event {
805  my(undef, $event, $self) = @_;
806 
807  return 0 unless $self->{layers} and @{$self->{layers}};
808  $self->grab_focus;
809 
810  my $handled = 0;
811 
812  if ($event->button == 3 and $self->{menu}) {
813 
814  $self->delete_rubberband if $self->{path};
815  my $menu = Gtk2::Menu->new;
816  for (my $i =0; $i < @{$self->{menu}}; $i+=2) {
817  my $name = $self->{menu_item_setup}->($self->{menu}->[$i], $self);
818  my $item;
819  unless ($self->{menu}->[$i+1]) {
820  $item = Gtk2::SeparatorMenuItem->new();
821  } else {
822  $item = Gtk2::MenuItem->new($name);
823  $item->signal_connect(activate => $self->{menu}->[$i+1], $self);
824  }
825  $item->show;
826  $menu->append ($item);
827  }
828  $menu->popup(undef, undef, undef, undef, $event->button, $event->time);
829  $handled = 1;
830 
831  } elsif ($event->button == 1) {
832 
833  push @{$self->{path}}, [$event->x, $event->y];
834 
835  unless ($self->{rubberband_mode} eq 'edit') {
836  $self->{rubberband_gc} = Gtk2::Gdk::GC->new($self->{pixmap});
837  $self->{rubberband_gc}->copy($self->style->fg_gc($self->state));
838  $self->{rubberband_gc}->set_function('invert');
839  }
840 
841  if ($self->{rubberband_mode} eq 'edit' and $self->{drawing}) {
842  # find the closest point in drawing
843  my @p = $self->event_pixel2point($event->x, $event->y);
844  my @q = $self->{drawing}->ClosestVertex(@p);
845  my $d = pop @q;
846  $self->{drawing_edit} = \@q if $d/$self->{pixel_size} < $EDIT_SNAP_DISTANCE;
847  } elsif ($self->draw_mode and !($self->{_control_down} or $self->{_shift_down}) and
848  !($self->{rubberband_geometry} eq 'polygon' or $self->{rubberband_geometry} eq 'path')
849  )
850  {
851  if ($self->{rubberband_mode} eq 'select') {
852  delete $self->{selection};
853  #$self->signal_emit('new_selection');
854  } elsif ($self->{rubberband_mode} eq 'draw') {
855  delete $self->{drawing};
856  #$self->signal_emit('drawing-changed');
857  }
858  }
859 
860  $handled = 1;
861 
862  }
863 
864  return $handled;
865 }
866 
867 ## @method motion_notify()
868 # @brief Updates the rubberband if rubberbanding.
869 # @todo Use more visible rubberband, there's no need to use XOR.
870 sub motion_notify {
871  my(undef, $event, $self) = @_;
872 
873  return 0 unless $self->{layers} and @{$self->{layers}};
874 
875  @{$self->{event_coordinates}} = ($event->x, $event->y);
876 
877  unless ($self->{path}) {
878  $self->signal_emit('motion-notify');
879  return 0; # not handled
880  }
881 
882  my $pm = $self->{pixmap};
883  my $rgc = $self->{rubberband_gc};
884  my @begin = @{$self->{path}[0]};
885  my @end = @{$self->{event_coordinates}};
886  my $w = $end[0] - $begin[0];
887  my $h = $end[1] - $begin[1];
888  my @rb = @{$self->{rubberband}} if $self->{rubberband};
889 
890  if ($self->{drawing_edit}) {
891 
892  $pm = $self->{pixmap} = $self->{pixbuf}->render_pixmap_and_mask(0);
893  my @wend = $self->event_pixel2point(@end);
894  my @p = @{$self->{drawing_edit}};
895  my @q = $self->{drawing}->VertexAt(@p);
896  for my $q (@q) {
897  $q->{X} = $wend[0];
898  $q->{Y} = $wend[1];
899  }
900  my $gc = Gtk2::Gdk::GC->new($self->{pixmap});
901  $gc->set_rgb_fg_color(Gtk2::Gdk::Color->new(@{$self->{drawing_color}}));
902  my $style = 'GDK_LINE_SOLID';
903  $gc->set_line_attributes(2, $style, 'GDK_CAP_NOT_LAST', 'GDK_JOIN_MITER');
904  $self->render_geometry($gc, $self->{drawing}, enhance_vertices => 1);
905 
906  } else {
907 
908  for ($self->{rubberband_mode}.' '.$self->{rubberband_geometry}) {
909  /edit/ && do {
910  last;
911  };
912  /pan/ && do {
913  my $gc = Gtk2::Gdk::GC->new($pm);
914  $pm->draw_rectangle($gc, 1, 0, 0, @{$self->{viewport_size}});
915  $pm->draw_pixbuf($gc, $self->{pixbuf}, 0, 0, $w, $h, -1, -1, 'GDK_RGB_DITHER_NONE', 0, 0);
916  last;
917  };
918  /line/ && do {
919  $pm->draw_line($rgc, @rb) if @rb;
920  @rb = (@begin, @end);
921  $pm->draw_line($rgc, @rb);
922  };
923  /path/ && do {
924  my @p = @{$self->{path}};
925  for my $p (0..$#p-1) {
926  $pm->draw_line($rgc, @{$p[$p]}, @{$p[$p+1]});
927  }
928  $pm->draw_line($rgc, @rb) if @rb;
929  @rb = (@{$p[$#p]}, @end);
930  for my $p (0..$#p-1) {
931  $pm->draw_line($rgc, @{$p[$p]}, @{$p[$p+1]});
932  }
933  $pm->draw_line($rgc, @rb);
934  };
935  /rect/ && do {
936  $pm->draw_rectangle($rgc, FALSE, @rb) if @rb;
937  @rb = (min($begin[0], $end[0]), min($begin[1], $end[1]), abs($w), abs($h));
938  $pm->draw_rectangle($rgc, FALSE, @rb);
939  };
940  /ellipse/ && do {
941  $pm->draw_arc($rgc, FALSE, @rb, 0, 64*360) if @rb;
942  my $a = abs(floor($w * sqrt(2)));
943  my $b = abs(floor($h * sqrt(2)));
944  @rb = ($begin[0] - $a, $begin[1] - $b, 2*$a, 2*$b);
945  $pm->draw_arc($rgc, FALSE, @rb, 0, 64*360);
946  };
947  /polygon/ && do {
948  my @p = @{$self->{path}};
949  if (@p == 1) {
950  $pm->draw_line($rgc, @rb) if @rb;
951  @rb = (@begin, @end);
952  $pm->draw_line($rgc, @rb);
953  } else {
954  $pm->draw_line($rgc, @rb) if @rb and @rb == 4 and @p == 2;
955  my @points;
956  for my $p (@p) {
957  push @points, @$p;
958  }
959  push @points, @rb if @rb;
960  $pm->draw_polygon($rgc, 1, @points);
961  @rb = @end;
962  pop @points;
963  pop @points;
964  push @points, @rb;
965  $pm->draw_polygon($rgc, 1, @points);
966  }
967  }
968  }
969  }
970 
971  @{$self->{rubberband}} = @rb;
972 
973  $self->{image}->set_from_pixbuf(undef);
974  $self->{image}->set_from_pixmap($pm, undef);
975 
976  $self->signal_emit('motion-notify');
977  return 1; # handled
978 }
979 
980 sub rubberband_mode {
981  my($self) = @_;
982  my $mode = $self->{rubberband_mode};
983  $mode .= ", add to collection" if $self->{_control_down};
984  $mode .= ", add a hole" if $self->{_shift_down};
985  return $mode;
986 }
987 
988 ## @method @rubberband_value()
989 # @brief Computes a value relevant to current rubberband (length or area) in world coordinates.
990 # @return ($dimension, $value) $dimension is either 1 or 2
991 sub rubberband_value {
992  my($self) = @_;
993 
994  if ($self->{path}) {
995 
996  my @p0 = $self->event_pixel2point(@{$self->{path}[0]}) if $self->{path}[0];
997  my @p1 = $self->event_pixel2point(@{$self->{event_coordinates}});
998 
999  for ($self->{rubberband_geometry}) {
1000  (/line/ || /path/) && do {
1001  my $ogc = new Geo::OGC::LinearRing(points => $self->{path});
1002  $ogc->AddPoint(Geo::OGC::Point->new(@{$self->{event_coordinates}}));
1003  $ogc->ApplyTransformation( sub { return $self->event_pixel2point(@_); } );
1004  return (1, $ogc->Length);
1005  };
1006  /rect/ && do {
1007  return (2, abs(($p1[0]-$p0[0])*($p1[1]-$p0[1])));
1008  };
1009  /ellipse/ && do {
1010  my $a = ($p1[0]-$p0[0]) * sqrt(2);
1011  my $b = ($p1[1]-$p0[1]) * sqrt(2);
1012  return (2, abs(3.14159266*$a*$b));
1013  };
1014  /polygon/ && do {
1015  my $ogc = new Geo::OGC::LinearRing(points => $self->{path});
1016  $ogc->AddPoint(Geo::OGC::Point->new(@{$self->{event_coordinates}}));
1017  $ogc->ApplyTransformation( sub { return $self->event_pixel2point(@_); } );
1018  $ogc->Close;
1019  return (2, undef) unless $ogc->IsSimple;
1020  return (2, abs($ogc->Area));
1021  };
1022  }
1023  }
1024 }
1025 
1026 ## @method delete_rubberband()
1027 # @brief Escapes from rubberbanding.
1028 sub delete_rubberband {
1029  my $self = shift;
1030  delete $self->{path};
1031  delete $self->{rubberband};
1032  $self->update_image;
1033 }
1034 
1035 ## @method button_release_event()
1036 # @brief Finishes rubberbanding.
1037 sub button_release_event {
1038  my(undef, $event, $self) = @_;
1039 
1040  return 0 unless $self->{layers} and @{$self->{layers}};
1041 
1042  my $handled = 0;
1043  if ($self->{path}) {
1044 
1045  my $pm = $self->{pixmap};
1046  my @rb = @{$self->{rubberband}} if $self->{rubberband};
1047  my $rgc = $self->{rubberband_gc};
1048  my @begin = @{$self->{path}[0]};
1049  my @end = ($event->x, $event->y);
1050 
1051  my $click = ($begin[0] == $end[0] and $begin[1] == $end[1]);
1052 
1053  my @wbegin = $self->event_pixel2point(@begin);
1054  my @wend = $self->event_pixel2point(@end);
1055 
1056  for ($self->{rubberband_mode}) {
1057 
1058  /pan/ && do {
1059  $self->delete_rubberband;
1060  $self->pan($begin[0] - $end[0], $begin[1] - $end[1]);
1061  };
1062  /zoom/ && do {
1063  $self->delete_rubberband;
1064  unless ($click) {
1065  my $w_offset = min($begin[0], $end[0]);
1066  my $h_offset = min($begin[1], $end[1]);
1067 
1068  my $pixel_size = max(abs($wbegin[0]-$wend[0])/$self->{viewport_size}->[0],
1069  abs($wbegin[1]-$wend[1])/$self->{viewport_size}->[1]);
1070 
1071  $w_offset = int((min($wbegin[0], $wend[0])-$self->{minX})/$pixel_size);
1072  $h_offset = int(($self->{maxY}-max($wbegin[1], $wend[1]))/$pixel_size);
1073 
1074  $self->zoom($w_offset, $h_offset, $pixel_size, 1);
1075  }
1076  };
1077  (/select/ or /draw/) && do {
1078  if ($self->{rubberband_geometry} eq 'line') {
1079  my $geom;
1080  if ($click) {
1081  $geom = Geo::OGC::Point->new($wbegin[0], $wbegin[1]);
1082  } else {
1083  $geom = new Geo::OGC::LineString;
1084  $geom->AddPoint(Geo::OGC::Point->new($wbegin[0], $wbegin[1]));
1085  $geom->AddPoint(Geo::OGC::Point->new($wend[0], $wend[1]));
1086  }
1087  $self->add_to_selection($geom);
1088  $self->delete_rubberband;
1089  } elsif ($self->{rubberband_geometry} =~ /rect/) {
1090  my $geom;
1091  if ($click) {
1092  $geom = Geo::OGC::Point->new($wbegin[0], $wbegin[1]);
1093  } else {
1094  my @rect = (min($wbegin[0], $wend[0]), min($wbegin[1], $wend[1]),
1095  max($wbegin[0], $wend[0]), max($wbegin[1], $wend[1]));
1096  $geom = new Geo::OGC::Polygon;
1097  my $r = new Geo::OGC::LinearRing;
1098  # exterior is ccw
1099  $r->AddPoint(Geo::OGC::Point->new($rect[0], $rect[1]));
1100  $r->AddPoint(Geo::OGC::Point->new($rect[2], $rect[1]));
1101  $r->AddPoint(Geo::OGC::Point->new($rect[2], $rect[3]));
1102  $r->AddPoint(Geo::OGC::Point->new($rect[0], $rect[3]));
1103  $r->Close;
1104  $geom->ExteriorRing($r);
1105  }
1106  $self->add_to_selection($geom);
1107  $self->delete_rubberband;
1108  } elsif ($self->{rubberband_geometry} eq 'ellipse') {
1109  $self->delete_rubberband;
1110  } elsif ($self->{rubberband_geometry} eq 'path') {
1111  delete $self->{rubberband};
1112  }
1113  };
1114  (/measure/ or /edit/) && do {
1115  if ($self->{drawing_edit}) {
1116  my @p = @{$self->{drawing_edit}};
1117  my @q = $self->{drawing}->VertexAt(@p);
1118  for my $q (@q) {
1119  $q->{X} = $wend[0];
1120  $q->{Y} = $wend[1];
1121  }
1122  delete $self->{drawing_edit};
1123  $self->delete_rubberband;
1124  } elsif ($self->{rubberband_geometry} eq 'line') {
1125  $self->delete_rubberband;
1126  } elsif ($self->{rubberband_geometry} eq 'rectangle') {
1127  $self->delete_rubberband;
1128  } elsif ($self->{rubberband_geometry} eq 'ellipse') {
1129  $self->delete_rubberband;
1130  } elsif ($self->{rubberband_geometry} eq 'path') {
1131  delete $self->{rubberband};
1132  }
1133  }
1134  }
1135  }
1136  return $handled;
1137 }
1138 
1139 ## @method @pixel2point(@pixel)
1140 # @brief Conversion from pixmap (event) coordinates to world
1141 # coordinates. Alternative name: event_pixel2point:
1142 sub event_pixel2point {
1143  my($self, @pixel) = @_;
1144  return unless $self->{layers} and @{$self->{layers}};
1145  @pixel = @{$self->{event_coordinates}} unless @pixel;
1146  return ($self->{minX} + $self->{pixel_size} * ($self->{offset}[0] + $pixel[0] + 0.5),
1147  $self->{maxY} - $self->{pixel_size} * ($self->{offset}[1] + $pixel[1] + 0.5));
1148 }
1149 *pixel2point = *event_pixel2point;
1150 
1151 ## @method @point2pixel(@point)
1152 # @brief Conversion from world coordinates to pixmap
1153 # coordinates. Alternative name: point2pixmap_pixel.
1154 sub point2pixmap_pixel {
1155  my($self, @p) = @_;
1156  return (round(($p[0] - $self->{minX})/$self->{pixel_size} - 0.5 - $self->{offset}[0]),
1157  round(($self->{maxY} - $p[1])/$self->{pixel_size} - 0.5 - $self->{offset}[1]));
1158 }
1159 *point2pixel = *point2pixmap_pixel;
1160 
1161 ## @method @point2surface(@point)
1162 # @brief Conversion from world coordinates to surface coordinates (as used in Cairo).
1163 sub point2surface {
1164  my($self, @p) = @_;
1165  return ((($p[0] - $self->{minX})/$self->{pixel_size} - $self->{offset}[0]),
1166  (($self->{maxY} - $p[1])/$self->{pixel_size} - $self->{offset}[1]));
1167 }
1168 
1169 sub min {
1170  $_[0] > $_[1] ? $_[1] : $_[0];
1171 }
1172 
1173 sub max {
1174  $_[0] > $_[1] ? $_[0] : $_[1];
1175 }
1176 
1177 sub round {
1178  return int($_[0] + .5 * ($_[0] <=> 0));
1179 }
1180 
1181 =head1 NAME
1182 
1184 
1186 
1187 =head1 DESCRIPTION
1188 
1189 An overlay is a widget, subclassed from Gtk2::ScrolledWindow. An
1190 overlay contains a list of layers, which it renders on a canvas, which
1191 it puts into its window.
1192 
1193 Rubberbanding and keyboard zoom-in (with + key), zoom-out (with -
1194 key), and panning (with arrow keys) is built-in.
1195 
1196 =cut
1197 
1198 1;
A class for layer schemas.
Definition: Layer.pm:1640
public method new(hash params)
Construct a new point.
public method new()
public method new()
A root class for geospatial features.
Definition: Geometry.pm:69