Geoinformatica  0.90
Layer.pm
Go to the documentation of this file.
1 #** @file Layer.pm
2 #*
3 package Gtk2::Ex::Geo::Layer;
4 
5 use strict;
6 use warnings;
7 use Scalar::Util qw(blessed);
8 use Carp;
9 use Glib qw /TRUE FALSE/;
15 
16 use vars qw/%PALETTE_TYPE %GRAYSCALE_SUBTYPE %SYMBOL_TYPE %LABEL_PLACEMENT $SINGLE_COLOR/;
17 
18 BEGIN {
19  use Exporter 'import';
20  our %EXPORT_TAGS = ( 'all' => [ qw(%PALETTE_TYPE %GRAYSCALE_SUBTYPE %SYMBOL_TYPE %LABEL_PLACEMENT) ] );
21  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
22 }
23 
24 # default values for new objects
25 
26 $SINGLE_COLOR = [0, 0, 0, 255];
27 
28 # the integer values are the same as in libral visualization code:
29 
30 %PALETTE_TYPE = ( 'Single color' => 0,
31  Grayscale => 1,
32  Rainbow => 2,
33  'Color table' => 3,
34  'Color bins' => 4,
35  'Red channel' => 5,
36  'Green channel' => 6,
37  'Blue channel' => 7,
38  );
39 
40 %GRAYSCALE_SUBTYPE = ( Gray => 0,
41  Hue => 1,
42  Saturation => 2,
43  Value => 3,
44  Opacity => 4,
45  );
46 
47 %SYMBOL_TYPE = ( 'No symbol' => 0,
48  'Flow_direction' => 1,
49  Square => 2,
50  Dot => 3,
51  Cross => 4,
52  'Wind rose' => 6,
53  );
54 
55 %LABEL_PLACEMENT = ( 'Center' => 0,
56  'Center left' => 1,
57  'Center right' => 2,
58  'Top left' => 3,
59  'Top center' => 4,
60  'Top right' => 5,
61  'Bottom left' => 6,
62  'Bottom center' => 7,
63  'Bottom right' => 8,
64  );
65 
66 #** @method registration()
67 # @brief A class method. Returns the dialogs and commands implemented by this layer
68 # class.
69 #
70 # The dialogs is an object of a subclass of
71 # Gtk2::Ex::Geo::DialogMaster. The commands is a reference to a
72 # command hash. The keys of the command hash are top-level commands
73 # for the GUI. The value of the command is a reference to a hash,
74 # which has keys: nr, text, tip, pos, and sub. The 'sub' is a
75 # reference to a subroutine, which is executed when the user executes
76 # the command. The commands are currently implemented as buttons in
77 # Gtk2::Ex::Geo::Glue.
78 #
79 # @return an anonymous hash containing the dialogs (key: 'dialogs')
80 # and commands (key: 'commands')
81 sub registration {
82  my($glue) = @_;
83  if ($glue->{resources}{icons}{dir}) {
84  #print STDERR "reg: @{$glue->{resources}{icons}{dir}}\n";
85  }
86  my $dialogs = Gtk2::Ex::Geo::Dialogs->new();
87  return { dialogs => $dialogs };
88 }
89 
90 ## @method @palette_types()
91 #
92 # @brief A class method. Returns a list of valid palette types (strings).
93 # @return a list of valid palette types (strings).
94 sub palette_types {
95  return sort {$PALETTE_TYPE{$a} <=> $PALETTE_TYPE{$b}} keys %PALETTE_TYPE;
96 }
97 
98 ## @method @symbol_types()
99 #
100 # @brief A class method. Returns a list of valid symbol types (strings).
101 # @return a list of valid symbol types (strings).
102 sub symbol_types {
103  return sort {$SYMBOL_TYPE{$a} <=> $SYMBOL_TYPE{$b}} keys %SYMBOL_TYPE;
104 }
105 
106 ## @method @label_placements()
107 #
108 # @brief Returns a list of valid label_placements (strings).
109 # @return a list of valid label_placements (strings).
110 sub label_placements {
111  return sort {$LABEL_PLACEMENT{$a} <=> $LABEL_PLACEMENT{$b}} keys %LABEL_PLACEMENT;
112 }
113 
114 ## @method $upgrade($object)
115 #
116 # @brief A class method. Upgrade a known data object to a layer object.
117 #
118 # @return true (either 1 or a new object) if object is known (no need
119 # to look further) and false otherwise.
120 sub upgrade {
121  my($object) = @_;
122  return 0;
123 }
124 
125 ## @method new(%params)
126 # @brief A class method. Constructs a new layer object or blesses an object into a layer class.
127 # Calls defaults with the given parameters.
128 sub new {
129  my($class, %params) = @_;
130  my $self = $params{self} ? $params{self} : {};
131  bless $self => (ref($class) or $class);
132  $self->defaults(%params);
133  return $self;
134 }
135 
136 ## @method defaults(%params)
137 # @brief assigns default values to attributes
138 # The default values are hard-coded, but they can be overridden with
139 # given values. The given values are lower case.
140 # @todo: document the attributes
141 sub defaults {
142  my($self, %params) = @_;
143 
144  # set defaults for all
145 
146  $self->{NAME} = '' unless exists $self->{NAME};
147  $self->{ALPHA} = 255 unless exists $self->{ALPHA};
148  $self->{VISIBLE} = 1 unless exists $self->{VISIBLE};
149  $self->{PALETTE_TYPE} = 'Single color' unless exists $self->{PALETTE_TYPE};
150 
151  $self->{SYMBOL_TYPE} = 'No symbol' unless exists $self->{SYMBOL_TYPE};
152  # symbol size is also the max size of the symbol, if symbol_scale is used
153  $self->{SYMBOL_SIZE} = 5 unless exists $self->{SYMBOL_SIZE};
154  # symbol scale is similar to grayscale scale
155  $self->{SYMBOL_SCALE_MIN} = 0 unless exists $self->{SYMBOL_SCALE_MIN};
156  $self->{SYMBOL_SCALE_MAX} = 0 unless exists $self->{SYMBOL_SCALE_MAX};
157 
158  $self->{HUE_AT_MIN} = 235 unless exists $self->{HUE_AT_MIN}; # as in libral visual.h
159  $self->{HUE_AT_MAX} = 0 unless exists $self->{HUE_AT_MAX}; # as in libral visual.h
160  $self->{INVERT} = 0 unless exists $self->{HUE_DIR}; # inverted scale or not; RGB is not inverted
161  $self->{GRAYSCALE_SUBTYPE} = 'Gray' unless exists $self->{GRAYSCALE_SUBTYPE}; # grayscale is gray scale
162 
163  @{$self->{GRAYSCALE_COLOR}} = @$SINGLE_COLOR unless exists $self->{GRAYSCALE_COLOR};
164 
165  @{$self->{SINGLE_COLOR}} = @$SINGLE_COLOR unless exists $self->{SINGLE_COLOR};
166 
167  $self->{COLOR_TABLE} = [] unless exists $self->{COLOR_TABLE};
168  $self->{COLOR_BINS} = [] unless exists $self->{COLOR_BINS};
169 
170  # scales are used in rendering in some palette types
171  $self->{COLOR_SCALE_MIN} = 0 unless exists $self->{COLOR_SCALE_MIN};
172  $self->{COLOR_SCALE_MAX} = 0 unless exists $self->{COLOR_SCALE_MAX};
173 
174  # focus field is used in rendering and rasterization
175  # this is the name of the field
176  $self->{COLOR_FIELD} = '' unless exists $self->{COLOR_FIELD};
177  $self->{SYMBOL_FIELD} = 'Fixed size' unless exists $self->{SYMBOL_FIELD};
178  $self->{LABEL_FIELD} = 'No Labels' unless exists $self->{LABEL_FIELD};
179 
180  $self->{LABEL_PLACEMENT} = 'Center' unless exists $self->{LABEL_PLACEMENT};
181  $self->{LABEL_FONT} = 'sans 12' unless exists $self->{LABEL_FONT};
182  $self->{LABEL_COLOR} = [0, 0, 0, 255] unless exists $self->{LABEL_COLOR};
183  $self->{LABEL_MIN_SIZE} = 0 unless exists $self->{LABEL_MIN_SIZE};
184  $self->{INCREMENTAL_LABELS} = 0 unless exists $self->{INCREMENTAL_LABELS};
185  $self->{LABEL_VERT_NUDGE} = 0.3 unless exists $self->{LABEL_VERT_NUDGE};
186  $self->{LABEL_HORIZ_NUDGE_LEFT} = 6 unless exists $self->{LABEL_HORIZ_NUDGE_LEFT};
187  $self->{LABEL_HORIZ_NUDGE_RIGHT} = 10 unless exists $self->{LABEL_HORIZ_NUDGE_RIGHT};
188 
189  $self->{BORDER_COLOR} = [] unless exists $self->{BORDER_COLOR};
190 
191  $self->{SELECTED_FEATURES} = [];
192 
193  $self->{RENDERER} = 0; # the default, later 'Cairo' will be implemented fully
194 
195  # set from input
196 
197  $self->{NAME} = $params{name} if exists $params{name};
198  $self->{ALPHA} = $params{alpha} if exists $params{alpha};
199  $self->{VISIBLE} = $params{visible} if exists $params{visible};
200  $self->{PALETTE_TYPE} = $params{palette_type} if exists $params{palette_type};
201  $self->{SYMBOL_TYPE} = $params{symbol_type} if exists $params{symbol_type};
202  $self->{SYMBOL_SIZE} = $params{symbol_size} if exists $params{symbol_size};
203  $self->{SYMBOL_SCALE_MIN} = $params{scale_min} if exists $params{scale_min};
204  $self->{SYMBOL_SCALE_MAX} = $params{scale_max} if exists $params{scale_max};
205  $self->{HUE_AT_MIN} = $params{hue_at_min} if exists $params{hue_at_min};
206  $self->{HUE_AT_MAX} = $params{hue_at_max} if exists $params{hue_at_max};
207  $self->{INVERT} = $params{invert} if exists $params{invert};
208  $self->{SCALE} = $params{scale} if exists $params{scale};
209  @{$self->{GRAYSCALE_COLOR}} = @{$params{grayscale_color}} if exists $params{grayscale_color};
210  @{$self->{SINGLE_COLOR}} = @{$params{single_color}} if exists $params{single_color};
211  $self->{COLOR_TABLE} = $params{color_table} if exists $params{color_table};
212  $self->{COLOR_BINS} = $params{color_bins} if exists $params{color_bins};
213  $self->{COLOR_SCALE_MIN} = $params{color_scale_min} if exists $params{color_scale_min};
214  $self->{COLOR_SCALE_MAX} = $params{color_scale_max} if exists $params{color_scale_max};
215  $self->{COLOR_FIELD} = $params{color_field} if exists $params{color_field};
216  $self->{SYMBOL_FIELD} = $params{symbol_field} if exists $params{symbol_field};
217  $self->{LABEL_FIELD} = $params{label_field} if exists $params{label_field};
218  $self->{LABEL_PLACEMENT} = $params{label_placement} if exists $params{label_placement};
219  $self->{LABEL_FONT} = $params{label_font} if exists $params{label_font};
220  @{$self->{LABEL_COLOR}} = @{$params{label_color}} if exists $params{label_color};
221  $self->{LABEL_MIN_SIZE} = $params{label_min_size} if exists $params{label_min_size};
222  @{$self->{BORDER_COLOR}} = @{$params{border_color}} if exists $params{border_color};
223 
224 }
225 
226 sub DESTROY {
227  my $self = shift;
228  while (my($key, $widget) = each %$self) {
229  $widget->destroy if blessed($widget) and $widget->isa("Gtk2::Widget");
230  delete $self->{$key};
231  }
232 }
233 
234 ## @method close($gui)
235 # @brief Close and destroy all resources of this layer, as it has been
236 # removed from the GUI.
237 #
238 # If you override this, remember to call the super method:
239 # @code
240 # $self->SUPER::close(@_);
241 # @endcode
242 sub close {
243  my($self, $gui) = @_;
244  for (keys %$self) {
245  if (blessed($self->{$_}) and $self->{$_}->isa("Gtk2::GladeXML")) {
246  $self->{$_}->get_widget($_)->destroy;
247  }
248  delete $self->{$_};
249  }
250 }
251 
252 ## @method $type($format)
253 #
254 # @brief Reports the type of the layer class for the GUI (short but human readable code).
255 # @param format (optional) If 'tooltip' returns a string suitable for tooltip.
256 # @return a string.
257 sub type {
258  my $self = shift;
259  return '?';
260 }
261 
262 ## @method $name($name)
263 #
264 # @brief Get or set the name of the layer. Also a callback function.
265 # @param[in] name (optional) Layers name.
266 # @return Name of layer, if no name is given to the method.
267 sub name {
268  my($self, $name) = @_;
269  defined $name ? $self->{NAME} = $name : $self->{NAME};
270 }
271 
272 ## @method $alpha($alpha)
273 #
274 # @brief Get or set the alpha (transparency) of the layer.
275 # @param[in] alpha (optional) Layers alpha channels value (0 ... 255).
276 # @return Current alpha value, if no parameter is given.
277 sub alpha {
278  my($self, $alpha) = @_;
279  if (defined $alpha) {
280  $alpha = 0 if $alpha < 0;
281  $alpha = 255 if $alpha > 255;
282  $self->{ALPHA} = $alpha;
283  }
284  $self->{ALPHA};
285 }
286 
287 ## @method visible($visible)
288 #
289 # @brief Show or hide the layer.
290 # @param visible If true then the layer is made visible, else hidden.
291 sub visible {
292  my($self, $visible) = @_;
293  defined $visible ? $self->{VISIBLE} = $visible : $self->{VISIBLE};
294 }
295 
296 ## @method got_focus($gui)
297 #
298 # @brief Called by the GUI when this layer has received the focus.
299 sub got_focus {
300  my($self, $gui) = @_;
301 }
302 
303 ## @method lost_focus($gui)
304 #
305 # @brief Called by the GUI when this layer has lost the focus.
306 sub lost_focus {
307  my($self, $gui) = @_;
308 }
309 
310 ## @method border_color($red, $green, $blue)
311 # @brief Set or get the border color of the features.
312 # @code
313 # $self->border_color($red, $green, $blue); # set
314 # $self->border_color(); # clear, no border
315 # @color = $self->border_color(); # get
316 # @endcode
317 sub border_color {
318  my($self, @color) = @_;
319  @{$self->{BORDER_COLOR}} = @color if @color;
320  return @{$self->{BORDER_COLOR}} if defined wantarray;
321  @{$self->{BORDER_COLOR}} = () unless @color;
322 }
323 
324 ## @method inspect_data
325 # @brief Return data for the inspect window.
326 sub inspect_data {
327  my $self = shift;
328  return $self;
329 }
330 
331 ## @method void properties_dialog(Gtk2::Ex::Glue gui)
332 #
333 # @brief A request to invoke the properties dialog for this layer object.
334 # @param gui A Gtk2::Ex::Glue object (contains predefined dialogs).
335 sub open_properties_dialog {
336  my($self, $gui) = @_;
337 }
338 
339 ## @method void open_features_dialog($gui, $soft_open)
340 #
341 # @brief A request to invoke a features dialog for this layer object.
342 # @param gui A Gtk2::Ex::Glue object (contains predefined dialogs).
343 # @param soft_open Whether to "soft open", i.e., reset an already open dialog.
344 sub open_features_dialog {
345  my($self, $gui, $soft_open) = @_;
346 }
347 
348 ## @method arrayref menu_items()
349 #
350 # @brief Return menu items for the layer menu.
351 #
352 # A menu item consists of an entry and action. The action may be an
353 # anonymous subroutine or FALSE, in which case a separator item is
354 # added. A '_' in front of a letter makes that letter a shortcut key
355 # for the item. The final layer menu is composed of entries added by
356 # Glue.pm, and all classes in the layers lineage. The subroutine is
357 # called with [$self, $gui] as user data.
358 #
359 # @todo add machinery for multiselection.
360 #
361 # @return a reference to the items array.
362 sub menu_items {
363  my($self) = @_;
364  my @items;
365  push @items, (
366  '_Unselect all' => sub {
367  my($self, $gui) = @{$_[1]};
368  $self->select;
369  $gui->{overlay}->update_image;
370  $self->open_features_dialog($gui, 1);
371  },
372  '_Rules...' => sub {
373  my($self, $gui) = @{$_[1]};
374  $self->open_rules_dialog($gui);
375  },
376  '_Symbol...' => sub {
377  my($self, $gui) = @{$_[1]};
378  $self->open_symbols_dialog($gui);
379  },
380  '_Colors...' => sub {
381  my($self, $gui) = @{$_[1]};
382  $self->open_colors_dialog($gui);
383  },
384  '_Labeling...' => sub {
385  my($self, $gui) = @{$_[1]};
386  $self->open_labeling_dialog($gui);
387  },
388  '_Inspect...' => sub {
389  my($self, $gui) = @{$_[1]};
390  $gui->inspect($self->inspect_data, $self->name);
391  },
392  '_Properties...' => sub {
393  my($self, $gui) = @{$_[1]};
394  $self->open_properties_dialog($gui);
395  }
396  );
397  return @items;
398 }
399 
400 sub open_rules_dialog {
402 }
403 sub open_symbols_dialog {
405 }
406 sub open_colors_dialog {
408 }
409 sub open_labeling_dialog {
411 }
412 
413 ## @method $palette_type($palette_type)
414 #
415 # @brief Get or set the palette type.
416 # @param[in] palette_type (optional) New palette type to set to the layer.
417 # @return The current palette type of the layer.
418 sub palette_type {
419  my($self, $palette_type) = @_;
420  if (defined $palette_type) {
421  croak "Unknown palette type: $palette_type" unless defined $PALETTE_TYPE{$palette_type};
422  $self->{PALETTE_TYPE} = $palette_type;
423  } else {
424  return $self->{PALETTE_TYPE};
425  }
426 }
427 
428 ## @method @supported_palette_types()
429 #
430 # The palette type is set by the user and the layer class is expected
431 # to understand its own types in its render method.
432 #
433 # @brief Return a list of all by this class supported palette types.
434 # @return A list of all by this class supported palette types.
435 sub supported_palette_types {
436  my($class) = @_;
437  my @ret;
438  for my $t (sort {$PALETTE_TYPE{$a} <=> $PALETTE_TYPE{$b}} keys %PALETTE_TYPE) {
439  push @ret, $t;
440  }
441  return @ret;
442 }
443 
444 ## @method $symbol_type($type)
445 #
446 # @brief Get or set the symbol type.
447 # @param[in] type (optional) New symbol type to set to the layer.
448 # @return The current symbol type of the layer.
449 sub symbol_type {
450  my($self, $symbol_type) = @_;
451  if (defined $symbol_type) {
452  croak "Unknown symbol type: $symbol_type" unless defined $SYMBOL_TYPE{$symbol_type};
453  $self->{SYMBOL_TYPE} = $symbol_type;
454  } else {
455  return $self->{SYMBOL_TYPE};
456  }
457 }
458 
459 ## @method @supported_symbol_types()
460 #
461 # @brief Return a list of all symbol types that this class supports.
462 # @return A list of all by this class supported symbol types.
463 sub supported_symbol_types {
464  my($self) = @_;
465  my @ret;
466  for my $t (sort {$SYMBOL_TYPE{$a} <=> $SYMBOL_TYPE{$b}} keys %SYMBOL_TYPE) {
467  push @ret, $t;
468  }
469  return @ret;
470 }
471 
472 ## @method $symbol_size($size)
473 #
474 # @brief Get or set the symbol size.
475 # @param[in] size (optional) The layers symbols new size.
476 # @return The current size of the layers symbol.
477 # @note Even if the layer has at the moment no symbol, the symbol size can be
478 # defined.
479 sub symbol_size {
480  my($self, $size) = @_;
481  defined $size ?
482  $self->{SYMBOL_SIZE} = $size+0 :
483  $self->{SYMBOL_SIZE};
484 }
485 
486 ## @method @symbol_scale($scale_min, $scale_max)
487 #
488 # @brief Get or set the symbol scale.
489 # @param[in] scale_min (optional) The layers symbols new minimum scale. Scale under
490 # which the symbol is hidden even if the layer is visible.
491 # @param[in] scale_max (optional) The layers symbols new maximum scale. Scale over
492 # which the symbol is hidden even if the layer is visible.
493 # @return The current scale minimum and maximum of the layers symbol.
494 # @note Even if the layer has at the moment no symbol, the symbol scales can be
495 # defined.
496 sub symbol_scale {
497  my($self, $min, $max) = @_;
498  if (defined $min) {
499  $self->{SYMBOL_SCALE_MIN} = $min+0;
500  $self->{SYMBOL_SCALE_MAX} = $max+0;
501  }
502  return ($self->{SYMBOL_SCALE_MIN}, $self->{SYMBOL_SCALE_MAX});
503 }
504 
505 ## @method @hue_range($min, $max, $dir)
506 #
507 # @brief Determines the hue range
508 # @param min The minimum hue value.
509 # @param max The maximum hue value.
510 # @param dir (1 or -1) Determines whether the rainbow is from min to
511 # max (hue increases, red->green->blue), or from max to min (hue
512 # decreases, red->blue->green). Default is increase.
513 sub hue_range {
514  my($self, $min, $max, $dir) = @_;
515  if (defined $min) {
516  $self->{HUE_AT_MIN} = $min+0;
517  $self->{HUE_AT_MAX} = $max+0;
518  $self->{INVERT} = (!(defined $dir) or $dir == 1) ? 0 : 1;
519  }
520  return ($self->{HUE_AT_MIN}, $self->{HUE_AT_MAX}, $self->{INVERT} ? -1 : 1);
521 }
522 
523 ## @method $grayscale_subtype($subtype)
524 #
525 # @brief Get or set the subtype of grayscale palette.
526 # @param subtype (optional) The subtype (one of %GRAYSCALE_SUBTYPE).
527 # @return Returns the subtype.
528 sub grayscale_subtype {
529  my($self, $scale) = @_;
530  if (defined $scale) {
531  croak "unknown grayscale subtype: $scale" unless exists $GRAYSCALE_SUBTYPE{$scale};
532  $self->{GRAYSCALE_SUBTYPE} = $scale;
533  } else {
534  $self->{GRAYSCALE_SUBTYPE};
535  }
536 }
537 
538 ## @method $invert_scale($invert)
539 #
540 # @brief Get or set the invertedness attribute of grayscale palette.
541 # @param invert (optional) True or false.
542 # @return Returns the invertedness.
543 sub invert_scale {
544  my($self, $invert) = @_;
545  if (defined $invert) {
546  $self->{INVERT} = $invert and 1;
547  } else {
548  $self->{INVERT};
549  }
550 }
551 
552 ## @method @grayscale_color(@rgba)
553 #
554 # @brief Get or set the color, which is used as the base color for grayscale palette.
555 # @param[in] rgba (optional) A list of channels defining the RGBA color.
556 # @return The current color.
557 # @exception Croaks unless exactly all four channels are specified.
558 sub grayscale_color {
559  my $self = shift;
560  croak "@_ is not a RGBA color" if @_ and @_ != 4;
561  $self->{GRAYSCALE_COLOR} = [@_] if @_;
562  return @{$self->{GRAYSCALE_COLOR}};
563 }
564 
565 ## @method $symbol_field($field_name)
566 #
567 # @brief Get or set the field, which is used for determining the size of the
568 # symbol.
569 # @param[in] field_name (optional) Name of the field determining symbol size.
570 # @return Name of the field determining symbol size.
571 # @exception If field name is given as a parameter, but the field does not
572 # exist in the layer.
573 sub symbol_field {
574  my($self, $field_name) = @_;
575  if (defined $field_name) {
576  if ($field_name eq 'Fixed size' or $self->schema->field($field_name)) {
577  $self->{SYMBOL_FIELD} = $field_name;
578  } else {
579  croak "Layer ".$self->name()." does not have field with name: $field_name";
580  }
581  }
582  return $self->{SYMBOL_FIELD};
583 }
584 
585 ## @method @single_color(@rgba)
586 #
587 # @brief Get or set the color, which is used if palette is 'single color'
588 # @param[in] rgba (optional) A list of channels defining the RGBA color.
589 # @return The current color.
590 # @exception Croaks unless exactly all four channels are specified.
591 sub single_color {
592  my $self = shift;
593  croak "@_ is not a RGBA color" if @_ and @_ != 4;
594  $self->{SINGLE_COLOR} = [@_] if @_;
595  return @{$self->{SINGLE_COLOR}};
596 }
597 
598 ## @method @color_scale($scale_min, $scale_max)
599 #
600 # @brief Get or set the range, which is used for coloring in continuous palette
601 # types.
602 # @param[in] scale_min (optional) The layers colors new minimum scale. Scale under
603 # which the color is not shown even if the layer is visible.
604 # @param[in] scale_max (optional) The layers colors new maximum scale. Scale over
605 # which the color is not shown even if the layer is visible.
606 # @return The current scale minimum and maximum of the layers color.
607 sub color_scale {
608  my($self, $min, $max) = @_;
609  if (defined $min) {
610  $min = 0 unless $min;
611  $max = 0 unless $max;
612  $self->{COLOR_SCALE_MIN} = $min;
613  $self->{COLOR_SCALE_MAX} = $max;
614  }
615  return ($self->{COLOR_SCALE_MIN}, $self->{COLOR_SCALE_MAX});
616 }
617 
618 ## @method $color_field($field_name)
619 #
620 # @brief Get or set the field, which is used for determining the color.
621 # @param[in] field_name (optional) Name of the field determining color.
622 # @return Name of the field determining color.
623 # @exception If field name is given as a parameter, but the field does not
624 # exist in the layer.
625 sub color_field {
626  my($self, $field_name) = @_;
627  if (defined $field_name) {
628  if ($self->schema->field($field_name)) {
629  $self->{COLOR_FIELD} = $field_name;
630  } else {
631  croak "Layer ", $self->name, " does not have field: $field_name";
632  }
633  }
634  return $self->{COLOR_FIELD};
635 }
636 
637 ## @method @color_table($color_table)
638 #
639 # @brief Get or set the color table.
640 # @param[in] color_table (optional) Name of file from where the color table can be
641 # read.
642 # @return Current color table, if no parameter is given.
643 # @exception A filename is given, which can't be opened/read or does not have a
644 # color table.
645 
646 ## @method @color_table(Geo::GDAL::ColorTable color_table)
647 #
648 # @brief Get or set the color table.
649 # @param[in] color_table (optional) Geo::GDAL::ColorTable.
650 # @return Current color table, if no parameter is given.
651 
652 ## @method @color_table(listref color_table)
653 #
654 # @brief Get or set the color table.
655 # @param[in] color_table (optional) Reference to an array having the color table.
656 # @return Current color table, if no parameter is given.
657 sub color_table {
658  my($self, $color_table) = @_;
659  unless (defined $color_table)
660  {
661  $self->{COLOR_TABLE} = [] unless $self->{COLOR_TABLE};
662  return $self->{COLOR_TABLE};
663  }
664  if (ref($color_table) eq 'ARRAY')
665  {
666  $self->{COLOR_TABLE} = [];
667  for (@$color_table) {
668  push @{$self->{COLOR_TABLE}}, [@$_];
669  }
670  } elsif (ref($color_table))
671  {
672  $self->{COLOR_TABLE} = [];
673  for my $i (0..$color_table->GetCount-1) {
674  my @color = $color_table->GetColorEntryAsRGB($i);
675  push @{$self->{COLOR_TABLE}}, [$i, @color];
676  }
677  } else
678  {
679  open(my $fh, '<', $color_table) or croak "can't read from $color_table: $!";
680  $self->{COLOR_TABLE} = [];
681  while (<$fh>) {
682  next if /^#/;
683  my @tokens = split /\s+/;
684  next unless @tokens > 3;
685  $tokens[4] = 255 unless defined $tokens[4];
686  #print STDERR "@tokens\n";
687  for (@tokens[1..4]) {
688  $_ =~ s/\D//g;
689  }
690  #print STDERR "@tokens\n";
691  for (@tokens[1..4]) {
692  $_ = 0 if $_ < 0;
693  $_ = 255 if $_ > 255;
694  }
695  #print STDERR "@tokens\n";
696  push @{$self->{COLOR_TABLE}}, \@tokens;
697  }
698  CORE::close($fh);
699  }
700 }
701 
702 ## @method color($index, @XRGBA)
703 #
704 # @brief Get or set the single color or a color in a color table or
705 # bins. The index is an index to the table and not a color table index
706 # or upper limit of a bin (the X is) and is not to be given to set the
707 # single color.
708 sub color {
709  my $self = shift;
710  my $index = shift unless $self->{PALETTE_TYPE} eq 'Single color';
711  my @color = @_ if @_;
712  if (@color) {
713  if ($self->{PALETTE_TYPE} eq 'Color table') {
714  $self->{COLOR_TABLE}[$index] = \@color;
715  } elsif ($self->{PALETTE_TYPE} eq 'Color bins') {
716  $self->{COLOR_BINS}[$index] = \@color;
717  } else {
718  $self->{SINGLE_COLOR} = \@color;
719  }
720  } else {
721  if ($self->{PALETTE_TYPE} eq 'Color table') {
722  @color = @{$self->{COLOR_TABLE}[$index]};
723  } elsif ($self->{PALETTE_TYPE} eq 'Color bins') {
724  @color = @{$self->{COLOR_BINS}[$index]};
725  } else {
726  @color = @{$self->{SINGLE_COLOR}};
727  }
728  }
729  return @color;
730 }
731 
732 ## @method add_color($index, @XRGBA)
733 # @brief Add color to color table or color bins at given index.
734 sub add_color {
735  my($self, $index, @XRGBA) = @_;
736  if ($self->{PALETTE_TYPE} eq 'Color table') {
737  splice @{$self->{COLOR_TABLE}}, $index, 0, [@XRGBA];
738  } else {
739  splice @{$self->{COLOR_BINS}}, $index, 0, [@XRGBA];
740  }
741 }
742 
743 ## @method remove_color($index)
744 # @brief Remove color from color table or color bins at given index.
745 sub remove_color {
746  my($self, $index) = @_;
747  if ($self->{PALETTE_TYPE} eq 'Color table') {
748  splice @{$self->{COLOR_TABLE}}, $index, 1;
749  } else {
750  splice @{$self->{COLOR_BINS}}, $index, 1;
751  }
752 }
753 
754 
755 ## @method save_color_table($filename)
756 #
757 # @brief Saves the layers color table into the file, which name is given as
758 # parameter.
759 # @param[in] filename Name of file where the color table is saved.
760 # @exception A filename is given, which can't be written to.
761 sub save_color_table {
762  my($self, $filename) = @_;
763  open(my $fh, '>', $filename) or croak "can't write to $filename: $!";
764  for my $color (@{$self->{COLOR_TABLE}}) {
765  print $fh "@$color\n";
766  }
767  CORE::close($fh);
768 }
769 
770 ## @method @color_bins($color_bins)
771 #
772 # @brief Get or set the color bins.
773 # @param[in] color_bins (optional) Name of file from where the color bins can be
774 # read.
775 # @return The current color bins if no parameter is given.
776 # @exception A filename is given, which can't be opened/read or does not have
777 # the color bins.
778 
779 ## @method @color_bins(listref color_bins)
780 #
781 # @brief Get or set the color bins.
782 # @param[in] color_bins (optional) Array including the color bins.
783 # @return The current color bins if no parameter is given.
784 sub color_bins {
785  my($self, $color_bins) = @_;
786  unless (defined $color_bins) {
787  $self->{COLOR_BINS} = [] unless $self->{COLOR_BINS};
788  return $self->{COLOR_BINS};
789  }
790  if (ref($color_bins) eq 'ARRAY') {
791  $self->{COLOR_BINS} = [];
792  for (@$color_bins) {
793  push @{$self->{COLOR_BINS}}, [@$_];
794  }
795  } else {
796  open(my $fh, '<', $color_bins) or croak "can't read from $color_bins: $!";
797  $self->{COLOR_BINS} = [];
798  while (<$fh>) {
799  next if /^#/;
800  my @tokens = split /\s+/;
801  next unless @tokens > 3;
802  $tokens[4] = 255 unless defined $tokens[4];
803  for (@tokens[1..4]) {
804  $_ =~ s/\D//g;
805  $_ = 0 if $_ < 0;
806  $_ = 255 if $_ > 255;
807  }
808  push @{$self->{COLOR_BINS}}, \@tokens;
809  }
810  CORE::close($fh);
811  }
812 }
813 
814 ## @method save_color_bins($filename)
815 #
816 # @brief Saves the layers color bins into the file, which name is given as
817 # parameter.
818 # @param[in] filename Name of file where the color bins are saved.
819 # @exception A filename is given, which can't be written to.
820 sub save_color_bins {
821  my($self, $filename) = @_;
822  open(my $fh, '>', $filename) or croak "can't write to $filename: $!";
823  for my $color (@{$self->{COLOR_BINS}}) {
824  print $fh "@$color\n";
825  }
826  CORE::close($fh);
827 }
828 
829 ## @method hashref labeling($labeling)
830 #
831 # @brief Sets the labeling for the layer.
832 # @param[in] labeling An anonymous hash containing the labeling:
833 # { field => , font => , color => [r, g, b, a], min_size => }
834 # @return labeling in an anonymous hash
835 sub labeling {
836  my($self, $labeling) = @_;
837  if ($labeling) {
838  $self->{LABEL_FIELD} = $labeling->{field};
839  $self->{LABEL_PLACEMENT} = $labeling->{placement};
840  $self->{LABEL_FONT} = $labeling->{font};
841  @{$self->{LABEL_COLOR}} =@{$labeling->{color}};
842  $self->{LABEL_MIN_SIZE} = $labeling->{min_size};
843  $self->{INCREMENTAL_LABELS} = $labeling->{incremental};
844  } else {
845  $labeling = {};
846  $labeling->{field} = $self->{LABEL_FIELD};
847  $labeling->{placement} = $self->{LABEL_PLACEMENT};
848  $labeling->{font} = $self->{LABEL_FONT};
849  @{$labeling->{color}} = @{$self->{LABEL_COLOR}};
850  $labeling->{min_size} = $self->{LABEL_MIN_SIZE};
851  $labeling->{incremental} = $self->{INCREMENTAL_LABELS};
852  }
853  return $labeling;
854 }
855 
856 ## @method select(%params)
857 #
858 # @brief Select features based on user input.
859 # @param params named params, the key is something that is recognized by the features method
860 # and the value is a geometry the user has defined
861 # - <I>key</I> A Geo::OGR::Geometry object representing the point or area the user has selected
862 # The key, value pair is fed as such to features subroutine.
863 # A call without parameters deselects all features.
864 sub select {
865  my($self, %params) = @_;
866  if (@_ > 1) {
867  for my $key (keys %params) {
868  my $features = $self->features($key => $params{$key});
869  $self->selected_features($features);
870  }
871  } else {
872  $self->{SELECTED_FEATURES} = [];
873  }
874 }
875 
876 ## @method $select($selected)
877 # @brief Get or set the selected features.
878 #
879 # @param selected Reference to an array of features that will be the
880 # array of selected features.
881 # @return Reference to the array of selected features.
882 sub selected_features {
883  my($self, $selected) = @_;
884  if (@_ > 1) {
885  $self->{SELECTED_FEATURES} = $selected;
886  }
887  return $self->{SELECTED_FEATURES};
888 }
889 
890 ## @method $features(%params)
891 # @brief Virtual method called from select.
892 #
893 # @param params As in select.
894 # @return A reference to an array of matching features.
895 sub features {
896 }
897 
898 sub has_features_with_borders {
899  return 0;
900 }
901 
902 ## @method schema()
903 #
904 # @brief Return the schema of the layer as an anonymous hash.
905 #
906 # For the structure of the schema hash see Geo::Vector::schema
907 sub schema {
908  my $schema = Gtk2::Ex::Geo::Schema->new;
909  return $schema;
910 }
911 
912 ## @class Gtk2::Ex::Geo::Schema
913 # @brief A class for layer schemas.
914 package Gtk2::Ex::Geo::Schema;
915 
916 sub new {
917  my $package = shift;
918  my $self = { GeometryType => 'Unknown',
919  Fields => [], };
920  bless $self => (ref($package) or $package);
921 }
922 
923 sub fields {
924  my $schema = shift;
925  my @fields = (
926  { Name => '.FID', Type => 'Integer' },
927  { Name => '.GeometryType', Type => $schema->{GeometryType} }
928  );
929  push @fields, { Name => '.Z', Type => 'Real' } if $schema->{GeometryType} =~ /25/;
930  push @fields, @{$schema->{Fields}};
931  return @fields;
932 }
933 
934 sub field_names {
935  my $schema = shift;
936  my @names = ('.FID', '.GeometryType');
937  push @names, '.Z' if $schema->{GeometryType} =~ /25/;
938  for my $f (@{$schema->{Fields}}) {
939  push @names, $f->{Name};
940  }
941  return @names;
942 }
943 
944 sub field {
945  my($schema, $field_name) = @_;
946  if ($field_name eq '.FID') {
947  return { Name => '.FID', Type => 'Integer' };
948  }
949  if ($field_name eq '.GeometryType') {
950  return { Name => '.GeometryType', Type => 'String' };
951  }
952  if ($field_name eq '.Z') {
953  return { Name => '.Z', Type => 'Real' };
954  }
955  my $i = 0;
956  for my $f (@{$schema->{Fields}}) {
957  return $f if $field_name eq $f->{Name};
958  $i++;
959  }
960 }
961 
962 sub field_index {
963  my($schema, $field_name) = @_;
964  my $i = 0;
965  for my $f (@{$schema->{Fields}}) {
966  if ($field_name eq $f->{Name}) {
967  return $i;
968  }
969  $i++;
970  }
971 }
972 
973 package Gtk2::Ex::Geo::Layer;
974 
975 sub value_range {
976  return (0, 0);
977 }
978 
979 ## @method @world()
980 #
981 # @brief A callback function. Return the bounding box.
982 # @return (minx, miny, maxx, maxy)
983 
984 ## @method render($pb, $cr, $overlay, $viewport)
985 #
986 # @brief A callback function. Render the layer.
987 # @param pb Gtk2::Gdk::Pixbuf object
988 # @param cr Cairo context
989 # @param overlay Gtk2::Ex::Geo::Overlay object
990 # @param viewport The pixbuf / cairo surface area in map coordinates
991 # [minx, miny, maxx, maxy]
992 
993 ## @method render_selection($gc)
994 #
995 # @brief Render the selection using the given graphics context
996 # @param $gc Gtk2::Gdk::GC
997 sub render_selection {
998 }
999 
1000 ## @method void render($pb, $cr, $overlay, $viewport)
1001 #
1002 # @brief A request to render the data of the layer onto a surface.
1003 #
1004 # @param[in,out] pb A (XS wrapped) pointer to a gtk2_ex_geo_pixbuf.
1005 # @param[in,out] cr A Cairo::Context object for the surface to draw on.
1006 # @param[in] overlay A Gtk2::Ex::Geo::Overlay object which manages the surface.
1007 # @param[in] viewport A reference to the bounding box [min_x, min_y,
1008 # max_x, max_y] of the surface in world coordinates.
1009 sub render {
1010  my($self, $pb, $cr, $overlay, $viewport) = @_;
1011 }
1012 
1013 ## @method $string statusbar_info()
1014 #
1015 # @brief A request for an information string for the statusbar.
1016 #
1017 # @param[in] x The x location of the mouse.
1018 # @param[in] y The y location of the mouse.
1019 #
1020 # @return A short information string for the statusbar.
1021 sub statusbar_info {
1022  my($self, $x, $y) = @_;
1023  return '';
1024 }
1025 
1026 ## @method $bootstrap_dialog($gui, $dialog, $title, $connects)
1027 #
1028 # @brief Bootstrap the requested dialog.
1029 #
1030 # The requested dialog is asked from a Glue object, stored into the
1031 # layer, and presented.
1032 #
1033 # @param gui A Gtk2::Ex::Geo::Glue object
1034 # @param dialog A name by which the GladeXML object is stored into the
1035 # layer. Also the name of the dialog widget in one of the glade
1036 # resources given to Glue object as Gtk2::Ex::Geo::DialogMaster
1037 # objects. Note that the name must be globally unique.
1038 # @param title Title for the dialog.
1039 # @param connects A hash of widget names linked to an array of signal
1040 # name, subroutine, and user data.
1041 # @param combos A list of simple combos that need a model and a text
1042 # renderer in boot up.
1043 #
1044 # @return the GladeXML object of the dialog or the object and a
1045 # boolean telling whether the dialog was just booted, and may need
1046 # further boot up.
1047 sub bootstrap_dialog {
1048  my($self, $gui, $dialog, $title, $connects, $combos) = @_;
1049  $self = {} unless $self;
1050  my $boot = 0;
1051  my $widget;
1052  unless ($self->{$dialog}) {
1053  $self->{$dialog} = $gui->get_dialog($dialog);
1054  croak "$dialog does not exist" unless $self->{$dialog};
1055  $widget = $self->{$dialog}->get_widget($dialog);
1056  if ($connects) {
1057  for my $n (keys %$connects) {
1058  my $w = $self->{$dialog}->get_widget($n);
1059  #print STDERR "connect: '$n'\n";
1060  $w->signal_connect(@{$connects->{$n}});
1061  }
1062  }
1063  if ($combos) {
1064  for my $n (@$combos) {
1065  my $combo = $self->{$dialog}->get_widget($n);
1066  unless ($combo->isa('Gtk2::ComboBoxEntry')) {
1067  my $renderer = Gtk2::CellRendererText->new;
1068  $combo->pack_start($renderer, TRUE);
1069  $combo->add_attribute($renderer, text => 0);
1070  }
1071  my $model = Gtk2::ListStore->new('Glib::String');
1072  $combo->set_model($model);
1073  $combo->set_text_column(0) if $combo->isa('Gtk2::ComboBoxEntry');
1074  }
1075  }
1076  $boot = 1;
1077  $widget->set_position('center');
1078  } else {
1079  $widget = $self->{$dialog}->get_widget($dialog);
1080  $widget->move(@{$self->{$dialog.'_position'}}) unless $widget->get('visible');
1081  }
1082  $widget->set_title($title);
1083  $widget->show_all;
1084  $widget->present;
1085  return wantarray ? ($self->{$dialog}, $boot) : $self->{$dialog};
1086 }
1087 
1088 ## @method hide_dialog($dialog)
1089 # @brief Hide the given (name of a) dialog.
1090 sub hide_dialog {
1091  my($self, $dialog) = @_;
1092  $self->{$dialog.'_position'} = [$self->{$dialog}->get_widget($dialog)->get_position];
1093  $self->{$dialog}->get_widget($dialog)->hide();
1094 }
1095 
1096 ## @method $dialog_visible($dialog)
1097 #
1098 # @brief Return true is the given (name of a) dialog is visible.
1099 sub dialog_visible {
1100  my($self, $dialog) = @_;
1101  my $d = $self->{$dialog};
1102  return 0 unless $d;
1103  return $d->get_widget($dialog)->get('visible');
1104 }
1105 
1106 =head1 NAME
1107 
1109 
1111 
1112 =head1 DESCRIPTION
1113 
1114 The root class of all layer classes.
1115 
1116 Layer classes should be registered with the glue object. The
1117 registration information comprises a dialogs object (an instance of
1118 DialogMaster or its subclass), and class methods it offers (typically
1119 a subset of 'new', 'open', 'save', etc.).
1120 
1121 =cut
1122 
1123 1;
A class for layer schemas.
Definition: Layer.pm:1640
public method new()
public method new(hash params)