Deliantra/Deliantra/MapWidget.pm

=head1 NAME

Crossfire::MapWidget - Gtk2 widget displaying cf maps

=head1 SYNOPSIS

  use Crossfire::MapWidget;

=head1 DESCRIPTION

=head2 METHODS

=over 4

=cut

package Crossfire::MapWidget;

use strict;

use Gtk2;

use Crossfire;
use Crossfire::Tilecache;

use Glib::Object::Subclass
   'Gtk2::DrawingArea';

use List::Util qw(min max);

#my ($TILE_MINX, $TILE_MINY, $TILE_MAXX, $TILE_MAXY);
#
#for (values %TILE) {
#   $TILE_MAXX = max $TILE_MAXX, $_->{w} - 1;
#   $TILE_MAXY = max $TILE_MAXY, $_->{h} - 1;
#}
#
#for (values %ARCH) {
#   for (; $_; $_ = $_->{more}) {
#      $TILE_MINX = min $TILE_MINX, $_->{x};
#      $TILE_MINY = min $TILE_MINY, $_->{y};
#      $TILE_MAXX = max $TILE_MAXX, $_->{x};
#      $TILE_MAXY = max $TILE_MAXY, $_->{y};
#   }
#}

sub INIT_INSTANCE {
   my ($self) = @_;

   $self->signal_connect (destroy => sub {
      my ($self) = @_;

      $self->{tip}->destroy if $self->{tip};

      %$self = ();

      0
   });
   $self->signal_connect (realize => sub {
      my ($self) = @_;

      $self->{window} = $self->window;

      1
   });

   $self->set_redraw_on_allocate (0);
   $self->double_buffered (0);

   $self->{tooltip} = -1; # need focus in first

   # reduces unnecessary redraws
   $self->signal_connect (focus_in_event  => sub { $self->enable_tooltip;  1 });
   $self->signal_connect (focus_out_event => sub { $self->disable_tooltip; 1 });

   $self->signal_connect_after (enter_notify_event => sub { $self->update_tooltip; 0 });
   $self->signal_connect_after (leave_notify_event => sub { $self->update_tooltip; 0 });

   $self->signal_connect (size_request => sub {
      $_[1]->width  (TILESIZE);
      $_[1]->height (TILESIZE);

      1
   });

   $self->signal_connect (expose_event => sub { $self->expose ($_[1]); 1 });

   $self->signal_connect_after (configure_event => sub {
      $self->set_viewport ($self->{x}, $self->{y});

      0
   });

   $self->signal_connect (button_press_event => sub {
      my ($self, $event) = @_;

      my ($x, $y) = ($event->x, $event->y);

      if ($_[1]->button == 2 && !$self->{in_drag}) {
         $self->disable_tooltip;

         $_[0]->grab_focus;
         $self->{in_drag} = [$self->{x}, $self->{y}, $x, $y];
         return 1;
      }

      0
   });

   $self->signal_connect (motion_notify_event => sub {
      my ($self) = @_;

      $self->update_tooltip;

      if (my $di = $self->{in_drag}) {
         my ($x, $y) = $self->get_pointer;

         $self->set_viewport (
            $di->[0] + $di->[2] - $x,
            $di->[1] + $di->[3] - $y,
         );

         return 1;
      }

      0
   });

   $self->signal_connect (button_release_event => sub {
      my ($self) = @_;

      $self->enable_tooltip 
         if delete $self->{in_drag};

      0
   });

   # gtk+ supports no motion compression, a major lacking feature. we have to pay for the
   # workaround with incorrect behaviour and extra server-turnarounds.
   $self->add_events ([qw(button_press_mask button_release_mask button-motion-mask
                          pointer-motion-mask pointer-motion-hint-mask
                          enter-notify-mask leave-notify-mask)]);
   $self->can_focus (1);

#   $self->signal_connect (key_press_event => sub { $self->handle_key ($_[1]->keyval, $_[1]->state) });
}

sub enable_tooltip {
   my ($self) = @_;

   $self->{tooltip}++;
   $self->update_tooltip;
}

sub disable_tooltip {
   my ($self) = @_;

   $self->{tooltip}--;
   $self->update_tooltip;
}

sub overlay {
   my ($self, $name, $x, $y, $w, $h, $cb) = @_;

   if (my $ov = delete $self->{overlay}{$name}) {
      my ($x, $y, $w, $h) = @$ov;

      $self->queue_draw_area ($x - $self->{x}, $y - $self->{y}, $w, $h);
   }

   if ($h) {
      $self->{overlay}{$name} = [$x, $y, $w, $h, $cb];

      $self->queue_draw_area ($x - $self->{x}, $y - $self->{y}, $w, $h);
   }
}

sub update_tooltip {
   my ($self) = @_;

   if ($self->{tooltip} >= 0
       && $self->mapped
       && $self->get_toplevel->has_toplevel_focus) {
      my $screen = $self->{window}->get_screen;

      if ($self->{window} == ($screen->get_display->get_window_at_pointer)[0]) {
         my ($pscreen, $x, $y) = $screen->get_display->get_pointer;

         if ($pscreen == $screen) {
            if (!$self->{tip}) {
               $self->{tip} = new Gtk2::Window "popup";
               $self->{tip}->can_focus (0);
               $self->{tip}->set_name ("gtk-tooltips");
               $self->{tip}->set_decorated (0);
               $self->{tip}->set_border_width (4);
               $self->{tip}->set_has_frame (0);
               $self->{tip}->set_resizable (0);
               $self->{tip}->set_transient_for ($self->get_toplevel);
            }

            my ($mx, $my) = $self->coord ($self->get_pointer);

            if ($self->{tipinfo}[0] != $mx || $self->{tipinfo}[1] != $my) {
               $self->fill_tooltip ($mx, $my);

               $self->{tipinfo} = [$mx, $my];

               $self->overlay (_tooltip => $mx * TILESIZE, $my * TILESIZE, TILESIZE, TILESIZE, sub {
                  my ($self, $x, $y) = @_;

                  $self->{window}->draw_rectangle ($_ & 1 ? $self->style->black_gc : $self->style->white_gc, 0,
                                                   $x + $_, $y + $_,
                                                   TILESIZE - 1 - $_ * 2, TILESIZE - 1 - $_ * 2)
                     for 0..3;
               });

               my $req = $self->{tip}->size_request;
               $self->{tip}->resize ($req->width, $req->height);
            }

            $self->{tip}->move ($x + TILESIZE, $y);
            $self->{tip}->show_all;

            return;
         }
      }
   }

   $self->overlay ("_tooltip");
   delete $self->{tipinfo};
   (delete $self->{tip})->destroy if $self->{tip};
}

sub fill_tooltip {
   my ($self, $x, $y) = @_;

   $self->{tip}->remove ($self->{tip}->get_children)
      if $self->{tip}->get_children;

   $self->{tip}->add (my $frame = new Gtk2::Frame "($x|$y)");

   if ($x < 0 || $x >= $self->{map}{width}
       || $y < 0 || $y >= $self->{map}{height}) {
     $frame->add (new Gtk2::Label "<off-map>");
   } else {
      $frame->add (my $vbox = new Gtk2::VBox 1, 1);

      #TODO: fill tooltip via signal, defaulting to this:

      # fill tooltip with info about $x, $y
      my $as = $self->{map}{map}[$x][$y] || [];
      for my $a (reverse @$as) {
         $vbox->add (my $hbox = new Gtk2::HBox 0, 2);

         my $tile = $FACE{ $a->{face} || $ARCH{$a->{_name}}{face} };

         # this is awful, is this really the best way?
         my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
         $pb->fill (0x00000000);
         
         $TILE->composite ($pb,
            0, 0,
            TILESIZE, TILESIZE,
            - ($tile->{idx} % 64) * TILESIZE, - TILESIZE * int $tile->{idx} / 64,
            1, 1, 'nearest', 255
         );

         $hbox->add (my $img = new_from_pixbuf Gtk2::Image $pb);
         $img->set_alignment (0, 0.5);

         $hbox->add (my $label = new Gtk2::Label $a->{_name});
         $label->set_alignment (0, 0.5);
      }
   }
}

sub set_viewport {
   my ($self, $x, $y) = @_;

   my $area = $self->allocation;

   $x = max 0, min $self->{width}  - $area->width , $x;
   $y = max 0, min $self->{height} - $area->height, $y;

   $self->window->scroll ($self->{x} - $x, $self->{y} - $y);

   ($self->{x}, $self->{y}) = ($x, $y);
}

sub set_map {
   my ($self, $map) = @_;

   $self->{map} = $map;

   $self->{width}  = $map->{width}  * TILESIZE;
   $self->{height} = $map->{height} * TILESIZE;
   
   $self->{x} =
   $self->{y} = 0;

   delete $self->{face};
   delete $self->{face_extents};
   $self->update_map (0, 0, $map->{width} - 1, $map->{height} - 1);
   delete $self->{tipinfo}; $self->update_tooltip;
   $self->invalidate_all;
}

sub coord {
   my ($self, $x, $y) = @_;

   (
      int +($self->{x} + $x) / TILESIZE,
      int +($self->{y} + $y) / TILESIZE,
   )
}

#sub handle_key {
#   my ($self, $key, $state) = @_;
#
#   $self->prefetch_cancel;
#
#   if ($state * "control-mask") {
#      if ($key == $Gtk2::Gdk::Keysyms{g}) {
#         my @sel = keys %{$self->{sel}};
#         $self->generate_thumbnails (@sel ? @sel : 0 .. $#{$self->{entry}});
#   }
#
#   1
#}

sub invalidate {
   my ($self, $x, $y, $w, $h) = @_;

   return unless $self->{window};

   $self->queue_draw_area (
      map $_ * TILESIZE, $x - 1 , $y - 1, $w + 2, $h + 2
   );
}

sub invalidate_all {
   my ($self) = @_;

   $self->queue_draw;
}

sub expose {
   my ($self, $event) = @_;

   no integer;

   my $ox = $self->{x}; my $ix = int $ox / TILESIZE;
   my $oy = $self->{y}; my $iy = int $oy / TILESIZE;

   # get_rectangles is buggy in older versions
   my @rectangles = $Gtk2::VERSION > 1.115
                    ? $event->region->get_rectangles : $event->area;

   for my $area (@rectangles) {
      my ($x, $y, $w, $h) = $area->values; # x y w h

      my @x = ((int ($ox + $x) / TILESIZE) .. int +($ox + $x + $w + TILESIZE - 1) / TILESIZE);
      my @y = ((int ($oy + $y) / TILESIZE) .. int +($oy + $y + $h + TILESIZE - 1) / TILESIZE);

      my $window = $self->{window};

      my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 0, 8, TILESIZE * (@x + 1), TILESIZE * (@y + 1);
      $pb->fill (0xff69b400);

      for my $x (@x) {
         my $dx = ($x - $x[0]) * TILESIZE;
         my $oss = $self->{face}[$x];

         for my $y (@y) {
            my $dy = ($y - $y[0]) * TILESIZE;

            for my $idx (@{$oss->[$y]}) {
               $TILE->composite ($pb,
                  $dx, $dy,
                  TILESIZE, TILESIZE,
                  $dx - ($idx % 64) * TILESIZE, $dy - TILESIZE * int $idx / 64,
                  1, 1, 'nearest', 255
               );
            }
         }
      }

      $pb->render_to_drawable ($window, $self->style->black_gc,
               0, 0,
               $x[0] * TILESIZE - $ox, $y[0] * TILESIZE - $oy,
               TILESIZE * @x, TILESIZE * @y,
               'max', 0, 0);
   }

   $_->[4]->($self, $_->[0] - $self->{x}, $_->[1] - $self->{y})
      for values %{ $self->{overlay} || {} };
}

sub update_map {
   my ($self, $x1, $y1, $x2, $y2) = @_;

   delete $self->{tipinfo}; $self->update_tooltip;

#   push @{ $self->{queue_draw_areay} }, [$x * TILESIZE - $self->{x},
#                                         $y * TILESIZE - $self->{y},
#                                         $w * TILESIZE, $h * TILESIZE];

   # we store precomputed tile info into $self->{face}
   # and the minimum/maximum extents into $self->{face_extents}
   my $map = $self->{map}{map};
   my $ov  = $self->{face} ||= [];
   my $ext = $self->{face_extents} ||= [];

   $x1 = max 0, min $self->{map}{width}  - 1, $x1;
   $y1 = max 0, min $self->{map}{height} - 1, $y1;
   $x2 = max 0, min $self->{map}{width}  - 1, $x2;
   $y2 = max 0, min $self->{map}{height} - 1, $y2;

   # extend update area as neccessary to include all bigfaces
   # that overlap the update area
   for (;;) {
      my $redo;
      for my $x ($x1 .. $x2) {
         my $col = $ext->[$x] ||= [];
         for my $y ($y1 .. $y2) {
            if (my $ext = $col->[$y]) {
               ($redo = 1), ($x1 = $ext->[0]) if $ext->[0] < $x1;
               ($redo = 1), ($y1 = $ext->[1]) if $ext->[1] < $y1;
               ($redo = 1), ($x2 = $ext->[2]) if $ext->[2] > $x2;
               ($redo = 1), ($y2 = $ext->[3]) if $ext->[3] > $y2;
            }
            
            # reset extents
            $col->[$y] = [$x, $y, $x, $y];
         }
      }
      $redo or last;
   }

   $x1 = max 0, min $self->{map}{width}  - 1, $x1;
   $y1 = max 0, min $self->{map}{height} - 1, $y1;
   $x2 = max 0, min $self->{map}{width}  - 1, $x2;
   $y2 = max 0, min $self->{map}{height} - 1, $y2;

   $self->queue_draw_area (
      $x1 * TILESIZE - $self->{x}, $y1 * TILESIZE - $self->{y},
      ($x2 - $x1 + 1) * TILESIZE , ($y2 - $y1 + 1) * TILESIZE ,
   );

   my @ov;

   # update overlay map with bigfaces and chained faces
   my $a;
   for my $x ($x1 .. $x2) {
      my $ass = $map->[$x];
      my $oss = $ov->[$x] ||= [];
      for my $y ($y1 .. $y2) {
         my $os = $oss->[$y] = [];
         for my $a (@{ $ass->[$y] || [] }) {
            my $o = $ARCH{$a->{_name}}
               or (warn "arch '$a->{_name}' not found at ($x|$y)\n"), next;

            my $tile = $FACE{$a->{face} || $o->{face}}
               or (warn "no gfx found for arch '$a->{_name}' at ($x|$y)\n"), next;

            if ($tile->{w} > 1 || $tile->{h} > 1) {
               # bigfaces
               my $maxx = $x + $tile->{w} - 1;
               my $maxy = $y + $tile->{h} - 1;

               for my $ox (0 .. $tile->{w} - 1) {
                  for my $oy (0 .. $tile->{h} - 1) {
                     my $ext = $ext->[$x + $ox][$y + $oy];

                     $ext->[0] = min $ext->[0], $x;
                     $ext->[1] = min $ext->[1], $y;
                     $ext->[2] = max $ext->[2], $maxx;
                     $ext->[3] = max $ext->[3], $maxy;

                     push @ov, [$x + $ox, $y + $oy,
                                $tile->{idx} + $ox + $oy * $tile->{w}];
                  }
               }

            } elsif ($o->{more}) {
               # linked faces, slowest and most annoying

               my ($minx, $miny, $maxx, $maxy);

               for (my $o = $o; $o; $o = $o->{more}) {
                  $minx = min $minx, $o->{x};
                  $miny = min $miny, $o->{y};
                  $maxx = max $maxx, $o->{x};
                  $maxy = max $maxy, $o->{y};
               }

               $minx += $x; $miny += $y;
               $maxx += $x; $maxy += $y;

               for (my $o = $o; $o; $o = $o->{more}) {
                  my $tile = $FACE{$o->{face}}
                     or (warn "no gfx found for arch '$a->{_name}' at ($x*|$y*)\n"), next;

                  my $ext = $ext->[$x + $o->{x}][$y + $o->{y}];

                  $ext->[0] = min $ext->[0], $minx;
                  $ext->[1] = min $ext->[1], $miny;
                  $ext->[2] = max $ext->[2], $maxx;
                  $ext->[3] = max $ext->[3], $maxy;

                  push @ov, [$x + $o->{x}, $y + $o->{y}, $tile->{idx}];
               }

            } else {
               # single face
               push @$os, $tile->{idx};

            }
         }
      }
   }

   # bigger faces always on top, I don't give a shit to those who think otherwise
   for (@ov) {
      my ($x, $y, $idx) = @$_;

      next if $x < 0 || $self->{map}{width}  <= $x 
           || $y < 0 || $self->{map}{height} <= $y;

      push @{ $ov->[$x][$y] }, $idx;
   }

   # dump extent info
#   for my $x ($x1 .. $x2) {
#      for my $y ($y1 .. $y2) {
#         my $ext = $ext->[$x][$y];
#         if ($ext->[0] != $x || $ext->[1] != $y || $ext->[2] != $x || $ext->[3] != $y) {
#            warn "EXT $x $y (@$ext)\n";#d#
#         }
#      }
#   }
}

sub change_begin {
   my ($self, $title) = @_;

   $self->{change} ||= {
      title => $title,
   };
   $self->{change}{nest}++;
}

sub get {
   my ($self, $x, $y) = @_;

   $self->{map}{map}[$x][$y] || []
}

sub set {
   my ($self, $x, $y, $as) = @_;

   $self->{map}{map}[$x][$y] = $as;

   $self->{update} ||= [$x, $y, $x, $y];

   for (@$as) {
      my ($x1, $y1, $x2, $y2) = arch_extents $_;

      $self->{update}[0] = min $self->{update}[0], $x + $x1;
      $self->{update}[1] = min $self->{update}[1], $y + $y1;
      $self->{update}[2] = max $self->{update}[2], $x + $x2;
      $self->{update}[3] = max $self->{update}[3], $y + $y2;
   }

   $self->{update_idle} ||= add Glib::Idle sub {
      delete $self->{update_idle};
      my $coord = delete $self->{update};

      $self->update_map (@$coord);

      0
   }, undef, 10;
}

sub change_stack {
   my ($self, $x, $y, $as) = @_;

   $self->{change}{map}[$x][$y] ||= [$x, $y, $self->{map}{map}[$x][$y]];

   $self->set ($x, $y, $as);
}

sub change_end {
   my ($self) = @_;

   --$self->{change}{nest} and return;

   my $change = delete $self->{change};

   delete $change->{nest};

   $change->{set} = [
      grep $_,
         map @$_,
            grep $_,
               @{ delete $change->{map} || [] }
   ];

   @{ $change->{set} } or return;

   $change
}

sub change_swap {
   my ($self, $change) = @_;

   for (@{ $change->{set} }) {
      my $stack = \$self->{map}{map}[$_->[0]][$_->[1]];

      ($$stack, $_->[2]) = ($_->[2], $$stack);
   }
}

=back

=head1 AUTHOR

Marc Lehmann <schmorp@schmorp.de>

=cut

1

Revision:	1.18
Committed:	Sun Feb 12 04:50:24 2006 UTC (18 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.17:	+171 -70 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Crossfire::MapWidget - Gtk2 widget displaying cf maps
4
5			=head1 SYNOPSIS
6
7			use Crossfire::MapWidget;
8
9			=head1 DESCRIPTION
10
11			=head2 METHODS
12
13			=over 4
14
15			=cut
16
17			package Crossfire::MapWidget;
18
19			use strict;
20
21			use Gtk2;
22
23			use Crossfire;
24			use Crossfire::Tilecache;
25
26			use Glib::Object::Subclass
27			'Gtk2::DrawingArea';
28
29			use List::Util qw(min max);
30
31	root	1.18	#my ($TILE_MINX, $TILE_MINY, $TILE_MAXX, $TILE_MAXY);
32			#
33			#for (values %TILE) {
34			# $TILE_MAXX = max $TILE_MAXX, $_->{w} - 1;
35			# $TILE_MAXY = max $TILE_MAXY, $_->{h} - 1;
36			#}
37			#
38			#for (values %ARCH) {
39			# for (; $_; $_ = $_->{more}) {
40			# $TILE_MINX = min $TILE_MINX, $_->{x};
41			# $TILE_MINY = min $TILE_MINY, $_->{y};
42			# $TILE_MAXX = max $TILE_MAXX, $_->{x};
43			# $TILE_MAXY = max $TILE_MAXY, $_->{y};
44			# }
45			#}
46
47	root	1.1	sub INIT_INSTANCE {
48			my ($self) = @_;
49
50	root	1.7	$self->signal_connect (destroy => sub {
51			my ($self) = @_;
52	root	1.8
53	root	1.7	$self->{tip}->destroy if $self->{tip};
54	root	1.8
55	root	1.7	%$self = ();
56	root	1.8
57	root	1.7	0
58			});
59	root	1.1	$self->signal_connect (realize => sub {
60			my ($self) = @_;
61
62			$self->{window} = $self->window;
63
64			1
65			});
66
67	root	1.7	$self->set_redraw_on_allocate (0);
68	root	1.1	$self->double_buffered (0);
69
70	root	1.9	$self->{tooltip} = -1; # need focus in first
71
72	root	1.7	# reduces unnecessary redraws
73	root	1.9	$self->signal_connect (focus_in_event => sub { $self->enable_tooltip; 1 });
74			$self->signal_connect (focus_out_event => sub { $self->disable_tooltip; 1 });
75
76			$self->signal_connect_after (enter_notify_event => sub { $self->update_tooltip; 0 });
77			$self->signal_connect_after (leave_notify_event => sub { $self->update_tooltip; 0 });
78	root	1.7
79	root	1.1	$self->signal_connect (size_request => sub {
80	root	1.10	$_[1]->width (TILESIZE);
81			$_[1]->height (TILESIZE);
82	root	1.1
83			1
84			});
85
86	root	1.2	$self->signal_connect (expose_event => sub { $self->expose ($_[1]); 1 });
87	root	1.1
88			$self->signal_connect_after (configure_event => sub {
89			$self->set_viewport ($self->{x}, $self->{y});
90	root	1.2
91			0
92	root	1.1	});
93
94			$self->signal_connect (button_press_event => sub {
95			my ($self, $event) = @_;
96
97	root	1.5	my ($x, $y) = ($event->x, $event->y);
98	root	1.2
99	root	1.5	if ($_[1]->button == 2 && !$self->{in_drag}) {
100			$self->disable_tooltip;
101	root	1.1
102			$_[0]->grab_focus;
103			$self->{in_drag} = [$self->{x}, $self->{y}, $x, $y];
104	root	1.2	return 1;
105	root	1.1	}
106
107	root	1.2	0
108	root	1.1	});
109
110			$self->signal_connect (motion_notify_event => sub {
111			my ($self) = @_;
112
113	root	1.2	$self->update_tooltip;
114	root	1.1
115			if (my $di = $self->{in_drag}) {
116	root	1.2	my ($x, $y) = $self->get_pointer;
117
118	root	1.1	$self->set_viewport (
119			$di->[0] + $di->[2] - $x,
120			$di->[1] + $di->[3] - $y,
121			);
122
123	root	1.2	return 1;
124	root	1.1	}
125
126	root	1.2	0
127	root	1.1	});
128
129			$self->signal_connect (button_release_event => sub {
130			my ($self) = @_;
131
132	root	1.5	$self->enable_tooltip
133			if delete $self->{in_drag};
134	root	1.2
135	root	1.5	0
136	root	1.1	});
137
138			# gtk+ supports no motion compression, a major lacking feature. we have to pay for the
139			# workaround with incorrect behaviour and extra server-turnarounds.
140	root	1.8	$self->add_events ([qw(button_press_mask button_release_mask button-motion-mask
141	root	1.2	pointer-motion-mask pointer-motion-hint-mask
142			enter-notify-mask leave-notify-mask)]);
143	root	1.1	$self->can_focus (1);
144
145			# $self->signal_connect (key_press_event => sub { $self->handle_key ($_[1]->keyval, $_[1]->state) });
146			}
147
148	root	1.2	sub enable_tooltip {
149			my ($self) = @_;
150
151			$self->{tooltip}++;
152			$self->update_tooltip;
153			}
154
155			sub disable_tooltip {
156			my ($self) = @_;
157
158			$self->{tooltip}--;
159			$self->update_tooltip;
160			}
161
162	root	1.3	sub overlay {
163			my ($self, $name, $x, $y, $w, $h, $cb) = @_;
164
165			if (my $ov = delete $self->{overlay}{$name}) {
166			my ($x, $y, $w, $h) = @$ov;
167
168			$self->queue_draw_area ($x - $self->{x}, $y - $self->{y}, $w, $h);
169			}
170
171			if ($h) {
172			$self->{overlay}{$name} = [$x, $y, $w, $h, $cb];
173
174			$self->queue_draw_area ($x - $self->{x}, $y - $self->{y}, $w, $h);
175			}
176			}
177
178	root	1.2	sub update_tooltip {
179			my ($self) = @_;
180
181	root	1.9	if ($self->{tooltip} >= 0
182			&& $self->mapped
183			&& $self->get_toplevel->has_toplevel_focus) {
184	root	1.2	my $screen = $self->{window}->get_screen;
185
186	root	1.9	if ($self->{window} == ($screen->get_display->get_window_at_pointer)[0]) {
187			my ($pscreen, $x, $y) = $screen->get_display->get_pointer;
188
189			if ($pscreen == $screen) {
190			if (!$self->{tip}) {
191			$self->{tip} = new Gtk2::Window "popup";
192			$self->{tip}->can_focus (0);
193			$self->{tip}->set_name ("gtk-tooltips");
194			$self->{tip}->set_decorated (0);
195			$self->{tip}->set_border_width (4);
196			$self->{tip}->set_has_frame (0);
197			$self->{tip}->set_resizable (0);
198			$self->{tip}->set_transient_for ($self->get_toplevel);
199			}
200	root	1.2
201	root	1.9	my ($mx, $my) = $self->coord ($self->get_pointer);
202	root	1.2
203	root	1.9	if ($self->{tipinfo}[0] != $mx \|\| $self->{tipinfo}[1] != $my) {
204			$self->fill_tooltip ($mx, $my);
205	root	1.2
206	root	1.9	$self->{tipinfo} = [$mx, $my];
207	root	1.3
208	root	1.9	$self->overlay (_tooltip => $mx * TILESIZE, $my * TILESIZE, TILESIZE, TILESIZE, sub {
209			my ($self, $x, $y) = @_;
210	root	1.3
211	root	1.9	$self->{window}->draw_rectangle ($_ & 1 ? $self->style->black_gc : $self->style->white_gc, 0,
212			$x + $_, $y + $_,
213			TILESIZE - 1 - $_ * 2, TILESIZE - 1 - $_ * 2)
214			for 0..3;
215	root	1.18	});
216	root	1.3
217	root	1.18	my $req = $self->{tip}->size_request;
218			$self->{tip}->resize ($req->width, $req->height);
219	root	1.9	}
220	root	1.3
221	root	1.9	$self->{tip}->move ($x + TILESIZE, $y);
222	root	1.3	$self->{tip}->show_all;
223	root	1.9
224			return;
225	root	1.2	}
226			}
227			}
228
229	root	1.3	$self->overlay ("_tooltip");
230	root	1.2	delete $self->{tipinfo};
231			(delete $self->{tip})->destroy if $self->{tip};
232			}
233
234			sub fill_tooltip {
235			my ($self, $x, $y) = @_;
236
237			$self->{tip}->remove ($self->{tip}->get_children)
238			if $self->{tip}->get_children;
239
240			$self->{tip}->add (my $frame = new Gtk2::Frame "($x\|$y)");
241
242			if ($x < 0 \|\| $x >= $self->{map}{width}
243			\|\| $y < 0 \|\| $y >= $self->{map}{height}) {
244			$frame->add (new Gtk2::Label "<off-map>");
245			} else {
246	root	1.6	$frame->add (my $vbox = new Gtk2::VBox 1, 1);
247	root	1.2
248			#TODO: fill tooltip via signal, defaulting to this:
249
250			# fill tooltip with info about $x, $y
251			my $as = $self->{map}{map}[$x][$y] \|\| [];
252	root	1.9	for my $a (reverse @$as) {
253	root	1.6	$vbox->add (my $hbox = new Gtk2::HBox 0, 2);
254
255	root	1.18	my $tile = $FACE{ $a->{face} \|\| $ARCH{$a->{_name}}{face} };
256	root	1.6
257			# this is awful, is this really the best way?
258			my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 1, 8, TILESIZE, TILESIZE;
259			$pb->fill (0x00000000);
260
261	root	1.18	$TILE->composite ($pb,
262	root	1.6	0, 0,
263			TILESIZE, TILESIZE,
264			- ($tile->{idx} % 64) * TILESIZE, - TILESIZE * int $tile->{idx} / 64,
265			1, 1, 'nearest', 255
266			);
267
268			$hbox->add (my $img = new_from_pixbuf Gtk2::Image $pb);
269			$img->set_alignment (0, 0.5);
270
271			$hbox->add (my $label = new Gtk2::Label $a->{_name});
272	root	1.5	$label->set_alignment (0, 0.5);
273	root	1.2	}
274			}
275			}
276
277	root	1.1	sub set_viewport {
278			my ($self, $x, $y) = @_;
279
280			my $area = $self->allocation;
281
282			$x = max 0, min $self->{width} - $area->width , $x;
283			$y = max 0, min $self->{height} - $area->height, $y;
284
285			$self->window->scroll ($self->{x} - $x, $self->{y} - $y);
286
287			($self->{x}, $self->{y}) = ($x, $y);
288			}
289
290			sub set_map {
291			my ($self, $map) = @_;
292
293			$self->{map} = $map;
294
295			$self->{width} = $map->{width} * TILESIZE;
296			$self->{height} = $map->{height} * TILESIZE;
297
298			$self->{x} =
299			$self->{y} = 0;
300
301			delete $self->{face};
302	root	1.16	delete $self->{face_extents};
303	root	1.18	$self->update_map (0, 0, $map->{width} - 1, $map->{height} - 1);
304	root	1.11	delete $self->{tipinfo}; $self->update_tooltip;
305	root	1.1	$self->invalidate_all;
306			}
307
308			sub coord {
309			my ($self, $x, $y) = @_;
310
311			(
312	root	1.4	int +($self->{x} + $x) / TILESIZE,
313			int +($self->{y} + $y) / TILESIZE,
314	root	1.1	)
315			}
316
317			#sub handle_key {
318			# my ($self, $key, $state) = @_;
319			#
320			# $self->prefetch_cancel;
321			#
322			# if ($state * "control-mask") {
323			# if ($key == $Gtk2::Gdk::Keysyms{g}) {
324			# my @sel = keys %{$self->{sel}};
325			# $self->generate_thumbnails (@sel ? @sel : 0 .. $#{$self->{entry}});
326			# }
327			#
328			# 1
329			#}
330
331			sub invalidate {
332			my ($self, $x, $y, $w, $h) = @_;
333
334			return unless $self->{window};
335
336			$self->queue_draw_area (
337			map $_ * TILESIZE, $x - 1 , $y - 1, $w + 2, $h + 2
338			);
339			}
340
341			sub invalidate_all {
342			my ($self) = @_;
343
344			$self->queue_draw;
345			}
346
347	root	1.18	sub expose {
348			my ($self, $event) = @_;
349
350			no integer;
351
352			my $ox = $self->{x}; my $ix = int $ox / TILESIZE;
353			my $oy = $self->{y}; my $iy = int $oy / TILESIZE;
354
355			# get_rectangles is buggy in older versions
356			my @rectangles = $Gtk2::VERSION > 1.115
357			? $event->region->get_rectangles : $event->area;
358
359			for my $area (@rectangles) {
360			my ($x, $y, $w, $h) = $area->values; # x y w h
361
362			my @x = ((int ($ox + $x) / TILESIZE) .. int +($ox + $x + $w + TILESIZE - 1) / TILESIZE);
363			my @y = ((int ($oy + $y) / TILESIZE) .. int +($oy + $y + $h + TILESIZE - 1) / TILESIZE);
364
365			my $window = $self->{window};
366
367			my $pb = new Gtk2::Gdk::Pixbuf 'rgb', 0, 8, TILESIZE * (@x + 1), TILESIZE * (@y + 1);
368			$pb->fill (0xff69b400);
369
370			for my $x (@x) {
371			my $dx = ($x - $x[0]) * TILESIZE;
372			my $oss = $self->{face}[$x];
373
374			for my $y (@y) {
375			my $dy = ($y - $y[0]) * TILESIZE;
376
377			for my $idx (@{$oss->[$y]}) {
378			$TILE->composite ($pb,
379			$dx, $dy,
380			TILESIZE, TILESIZE,
381			$dx - ($idx % 64) * TILESIZE, $dy - TILESIZE * int $idx / 64,
382			1, 1, 'nearest', 255
383			);
384			}
385			}
386			}
387
388			$pb->render_to_drawable ($window, $self->style->black_gc,
389			0, 0,
390			$x[0] * TILESIZE - $ox, $y[0] * TILESIZE - $oy,
391			TILESIZE * @x, TILESIZE * @y,
392			'max', 0, 0);
393			}
394
395			$_->[4]->($self, $_->[0] - $self->{x}, $_->[1] - $self->{y})
396			for values %{ $self->{overlay} \|\| {} };
397			}
398
399	root	1.1	sub update_map {
400	root	1.18	my ($self, $x1, $y1, $x2, $y2) = @_;
401	root	1.1
402	root	1.13	delete $self->{tipinfo}; $self->update_tooltip;
403
404	root	1.15	# push @{ $self->{queue_draw_areay} }, [$x * TILESIZE - $self->{x},
405			# $y * TILESIZE - $self->{y},
406			# $w * TILESIZE, $h * TILESIZE];
407	root	1.13
408	root	1.16	# we store precomputed tile info into $self->{face}
409			# and the minimum/maximum extents into $self->{face_extents}
410			my $map = $self->{map}{map};
411			my $ov = $self->{face} \|\|= [];
412			my $ext = $self->{face_extents} \|\|= [];
413
414	root	1.18	$x1 = max 0, min $self->{map}{width} - 1, $x1;
415			$y1 = max 0, min $self->{map}{height} - 1, $y1;
416			$x2 = max 0, min $self->{map}{width} - 1, $x2;
417			$y2 = max 0, min $self->{map}{height} - 1, $y2;
418
419	root	1.16	# extend update area as neccessary to include all bigfaces
420			# that overlap the update area
421	root	1.17	for (;;) {
422			my $redo;
423			for my $x ($x1 .. $x2) {
424			my $col = $ext->[$x] \|\|= [];
425			for my $y ($y1 .. $y2) {
426			if (my $ext = $col->[$y]) {
427			($redo = 1), ($x1 = $ext->[0]) if $ext->[0] < $x1;
428			($redo = 1), ($y1 = $ext->[1]) if $ext->[1] < $y1;
429			($redo = 1), ($x2 = $ext->[2]) if $ext->[2] > $x2;
430			($redo = 1), ($y2 = $ext->[3]) if $ext->[3] > $y2;
431			}
432
433			# reset extents
434			$col->[$y] = [$x, $y, $x, $y];
435	root	1.16	}
436			}
437	root	1.17	$redo or last;
438	root	1.16	}
439	root	1.13
440	root	1.18	$x1 = max 0, min $self->{map}{width} - 1, $x1;
441			$y1 = max 0, min $self->{map}{height} - 1, $y1;
442			$x2 = max 0, min $self->{map}{width} - 1, $x2;
443			$y2 = max 0, min $self->{map}{height} - 1, $y2;
444	root	1.13
445	root	1.16	$self->queue_draw_area (
446			$x1 * TILESIZE - $self->{x}, $y1 * TILESIZE - $self->{y},
447			($x2 - $x1 + 1) * TILESIZE , ($y2 - $y1 + 1) * TILESIZE ,
448			);
449	root	1.13
450	root	1.16	my @ov;
451	root	1.13
452	root	1.16	# update overlay map with bigfaces and chained faces
453			my $a;
454			for my $x ($x1 .. $x2) {
455	root	1.18	my $ass = $map->[$x];
456	root	1.16	my $oss = $ov->[$x] \|\|= [];
457			for my $y ($y1 .. $y2) {
458			my $os = $oss->[$y] = [];
459			for my $a (@{ $ass->[$y] \|\| [] }) {
460	root	1.18	my $o = $ARCH{$a->{_name}}
461	root	1.16	or (warn "arch '$a->{_name}' not found at ($x\|$y)\n"), next;
462
463	root	1.18	my $tile = $FACE{$a->{face} \|\| $o->{face}}
464	root	1.16	or (warn "no gfx found for arch '$a->{_name}' at ($x\|$y)\n"), next;
465
466			if ($tile->{w} > 1 \|\| $tile->{h} > 1) {
467			# bigfaces
468			my $maxx = $x + $tile->{w} - 1;
469			my $maxy = $y + $tile->{h} - 1;
470
471			for my $ox (0 .. $tile->{w} - 1) {
472			for my $oy (0 .. $tile->{h} - 1) {
473			my $ext = $ext->[$x + $ox][$y + $oy];
474
475	root	1.18	$ext->[0] = min $ext->[0], $x;
476			$ext->[1] = min $ext->[1], $y;
477			$ext->[2] = max $ext->[2], $maxx;
478			$ext->[3] = max $ext->[3], $maxy;
479	root	1.13
480	root	1.16	push @ov, [$x + $ox, $y + $oy,
481			$tile->{idx} + $ox + $oy * $tile->{w}];
482	root	1.1	}
483	root	1.16	}
484
485			} elsif ($o->{more}) {
486	root	1.18	# linked faces, slowest and most annoying
487	root	1.1
488	root	1.16	my ($minx, $miny, $maxx, $maxy);
489	root	1.1
490	root	1.16	for (my $o = $o; $o; $o = $o->{more}) {
491	root	1.18	$minx = min $minx, $o->{x};
492			$miny = min $miny, $o->{y};
493			$maxx = max $maxx, $o->{x};
494			$maxy = max $maxy, $o->{y};
495	root	1.13	}
496	root	1.16
497	root	1.18	$minx += $x; $miny += $y;
498			$maxx += $x; $maxy += $y;
499	root	1.16
500			for (my $o = $o; $o; $o = $o->{more}) {
501	root	1.18	my $tile = $FACE{$o->{face}}
502	root	1.16	or (warn "no gfx found for arch '$a->{_name}' at ($x\|$y)\n"), next;
503
504			my $ext = $ext->[$x + $o->{x}][$y + $o->{y}];
505
506	root	1.18	$ext->[0] = min $ext->[0], $minx;
507			$ext->[1] = min $ext->[1], $miny;
508			$ext->[2] = max $ext->[2], $maxx;
509			$ext->[3] = max $ext->[3], $maxy;
510	root	1.16
511			push @ov, [$x + $o->{x}, $y + $o->{y}, $tile->{idx}];
512			}
513
514			} else {
515			# single face
516			push @$os, $tile->{idx};
517
518	root	1.1	}
519			}
520			}
521	root	1.16	}
522	root	1.1
523	root	1.16	# bigger faces always on top, I don't give a shit to those who think otherwise
524			for (@ov) {
525			my ($x, $y, $idx) = @$_;
526	root	1.1
527	root	1.18	next if $x < 0 \|\| $self->{map}{width} <= $x
528			\|\| $y < 0 \|\| $self->{map}{height} <= $y;
529
530	root	1.16	push @{ $ov->[$x][$y] }, $idx;
531			}
532	root	1.9
533	root	1.16	# dump extent info
534			# for my $x ($x1 .. $x2) {
535			# for my $y ($y1 .. $y2) {
536			# my $ext = $ext->[$x][$y];
537			# if ($ext->[0] != $x \|\| $ext->[1] != $y \|\| $ext->[2] != $x \|\| $ext->[3] != $y) {
538			# warn "EXT $x $y (@$ext)\n";#d#
539			# }
540			# }
541			# }
542	root	1.1	}
543
544	root	1.18	sub change_begin {
545			my ($self, $title) = @_;
546
547			$self->{change} \|\|= {
548			title => $title,
549			};
550			$self->{change}{nest}++;
551			}
552
553			sub get {
554			my ($self, $x, $y) = @_;
555
556			$self->{map}{map}[$x][$y] \|\| []
557			}
558
559			sub set {
560			my ($self, $x, $y, $as) = @_;
561
562			$self->{map}{map}[$x][$y] = $as;
563
564			$self->{update} \|\|= [$x, $y, $x, $y];
565
566			for (@$as) {
567			my ($x1, $y1, $x2, $y2) = arch_extents $_;
568
569			$self->{update}[0] = min $self->{update}[0], $x + $x1;
570			$self->{update}[1] = min $self->{update}[1], $y + $y1;
571			$self->{update}[2] = max $self->{update}[2], $x + $x2;
572			$self->{update}[3] = max $self->{update}[3], $y + $y2;
573			}
574
575			$self->{update_idle} \|\|= add Glib::Idle sub {
576			delete $self->{update_idle};
577			my $coord = delete $self->{update};
578
579			$self->update_map (@$coord);
580
581			0
582			}, undef, 10;
583			}
584
585			sub change_stack {
586			my ($self, $x, $y, $as) = @_;
587	root	1.1
588	root	1.18	$self->{change}{map}[$x][$y] \|\|= [$x, $y, $self->{map}{map}[$x][$y]];
589	root	1.1
590	root	1.18	$self->set ($x, $y, $as);
591			}
592	root	1.1
593	root	1.18	sub change_end {
594			my ($self) = @_;
595	root	1.11
596	root	1.18	--$self->{change}{nest} and return;
597	root	1.1
598	root	1.18	my $change = delete $self->{change};
599	root	1.1
600	root	1.18	delete $change->{nest};
601	root	1.1
602	root	1.18	$change->{set} = [
603			grep $_,
604			map @$_,
605			grep $_,
606			@{ delete $change->{map} \|\| [] }
607			];
608	root	1.1
609	root	1.18	@{ $change->{set} } or return;
610	root	1.1
611	root	1.18	$change
612			}
613	root	1.1
614	root	1.18	sub change_swap {
615			my ($self, $change) = @_;
616	root	1.1
617	root	1.18	for (@{ $change->{set} }) {
618			my $stack = \$self->{map}{map}[$_->[0]][$_->[1]];
619	root	1.1
620	root	1.18	($$stack, $_->[2]) = ($_->[2], $$stack);
621	root	1.1	}
622			}
623
624			=back
625
626			=head1 AUTHOR
627
628			Marc Lehmann <schmorp@schmorp.de>
629
630			=cut
631
632			1
633