ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/Deliantra/MapWidget.pm
Revision: 1.23
Committed: Mon Feb 20 23:20:47 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.22: +9 -9 lines
Log Message:
*** empty log message ***

File Contents

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