ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.3 by elmex, Fri Apr 7 18:16:51 2006 UTC vs.
Revision 1.41 by root, Sun Apr 9 21:50:21 2006 UTC

1package Client::Widget; 1package Crossfire::Client::Widget;
2
2use strict; 3use strict;
3 4
5use Scalar::Util;
6
7use SDL::OpenGL;
8use SDL::OpenGL::Constants;
9
10use Crossfire::Client;
11
4our $FOCUS; # the widget with current focus 12our $FOCUS; # the widget with current focus
5our %ACTIVE_WIDGETS;
6 13
7# class methods for events 14# class methods for events
8sub feed_sdl_key_down_event { $FOCUS->key_down ($_[0]) if $FOCUS } 15sub feed_sdl_key_down_event { $FOCUS->key_down ($_[0]) if $FOCUS }
9sub feed_sdl_key_up_event { $FOCUS->key_up ($_[0]) if $FOCUS } 16sub feed_sdl_key_up_event { $FOCUS->key_up ($_[0]) if $FOCUS }
10sub feed_sdl_button_down_event { $FOCUS->button_down ($_[0]) if $FOCUS } 17sub feed_sdl_button_down_event { }
11sub feed_sdl_button_up_event { $FOCUS->button_up ($_[0]) if $FOCUS } 18sub feed_sdl_button_up_event { }
12 19
13sub new { 20sub new {
14 my $class = shift; 21 my $class = shift;
15 my $self = { @_ };
16 bless $self, $class;
17 return $self;
18}
19 22
20sub activate { 23 bless { @_ }, $class
21 $ACTIVE_WIDGETS{$_[0]} = $_[0];
22} 24}
23sub deactivate { 25
24 delete $ACTIVE_WIDGETS{$_[0]}; 26sub move {
27 my ($self, $x, $y, $z) = @_;
28 $self->{x} = $x;
29 $self->{y} = $y;
30 $self->{z} = $z if defined $z;
31}
32
33sub needs_redraw {
34 0
35}
36
37sub size_request {
38 require Carp;
39 Carp::confess "size_request is abtract";
40}
41
42sub size_allocate {
43 my ($self, $w, $h) = @_;
44
45 $self->{w} = $w;
46 $self->{h} = $h;
25} 47}
26 48
27sub focus_in { 49sub focus_in {
28 my ($widget) = @_; 50 my ($widget) = @_;
29 $FOCUS = $widget; 51 $FOCUS = $widget;
30} 52}
53
31sub focus_out { 54sub focus_out {
32 my ($widget) = @_; 55 my ($widget) = @_;
33} 56}
57
34sub key_down { 58sub key_down {
35 my ($widget, $sdlev) = @_; 59 my ($widget, $sdlev) = @_;
36} 60}
61
37sub key_up { 62sub key_up {
38 my ($widget, $sdlev) = @_; 63 my ($widget, $sdlev) = @_;
39} 64}
65
40sub button_down { 66sub button_down {
41 my ($widget, $sdlev) = @_; 67 my ($widget, $sdlev) = @_;
42} 68}
69
43sub button_up { 70sub button_up {
44 my ($widget, $sdlev) = @_; 71 my ($widget, $sdlev) = @_;
45} 72}
73
74sub w { $_[0]->{w} = $_[1] if $_[1]; $_[0]->{w} }
75sub h { $_[0]->{h} = $_[1] if $_[1]; $_[0]->{h} }
76sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }
77sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }
78sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }
79
46sub draw { 80sub draw {
47 my ($widget) = @_; 81 my ($self) = @_;
82
83 glPushMatrix;
84 glTranslate $self->{x}, $self->{y}, 0;
85 $self->_draw;
86 glPopMatrix;
48} 87}
88
89sub _draw {
90 my ($self) = @_;
91
92 warn "no draw defined for $self\n";
93}
94
49sub bbox { 95sub bbox {
96 my ($self) = @_;
97 my ($w, $h) = $self->size_request;
98 (
99 $self->{x},
100 $self->{y},
101 $self->{x} = $w,
102 $self->{y} = $h
103 )
104}
105
106sub find_widget {
107 my ($self, $x, $y) = @_;
108
109 return $self
110 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
111 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
112
113 ()
114}
115
116sub del_parent { $_[0]->{parent} = undef }
117
118sub set_parent {
119 my ($self, $par) = @_;
120
121 $self->{parent} = $par;
122 Scalar::Util::weaken $self->{parent};
123}
124
125sub get_parent {
126 $_[0]->{parent}
127}
128
129sub update {
130 my ($self) = @_;
131
132 $self->{parent}->update
133 if $self->{parent};
134}
135
136sub DESTROY {
137 my ($self) = @_;
138
139 #$self->deactivate;
140}
141
142#############################################################################
143
144package Crossfire::Client::Widget::Container;
145
146our @ISA = Crossfire::Client::Widget::;
147
148sub new {
149 my ($class, @widgets) = @_;
150
151 my $self = $class->SUPER::new (children => []);
152 $self->add ($_) for @widgets;
153
154 $self
155}
156
157sub add {
158 my ($self, $chld, $expand) = @_;
159
160 $chld->{expand} = $expand;
161 $chld->set_parent ($self);
162
163 @{$self->{children}} =
164 sort { $a->{z} <=> $b->{z} }
165 @{$self->{children}}, $chld;
166
167 $self->size_allocate ($self->{w}, $self->{h});
168}
169
170sub remove {
50 my ($widget) = @_; 171 my ($self, $widget) = @_;
51}
52 172
53package Client::TextView; 173 $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
174
175 $self->size_allocate ($self->{w}, $self->{h});
176}
177
178sub find_widget {
179 my ($self, $x, $y) = @_;
180
181 my $res;
182
183 for (@{ $self->{children} }) {
184 $res = $_->find_widget ($x, $y)
185 and return $res;
186 }
187
188 ()
189}
190
191sub size_request {
192 my ($self) = @_;
193
194 my ($hs, $ws) = (0, 0);
195 for (@{$self->{children} || []}) {
196 my ($w, $h) = $_->size_request;
197 $hs += $h;
198 if ($ws < $w) { $ws = $w }
199 }
200
201 return ($ws, $hs);
202}
203
204sub _draw {
205 my ($self) = @_;
206
207 $_->draw for @{$self->{children}};
208}
209
210#############################################################################
211
212package Crossfire::Client::Widget::Bin;
213
214our @ISA = Crossfire::Client::Widget::Container::;
215
216sub child { $_[0]->{children}[0] }
217
218sub size_request {
219 $_[0]{children}[0]->size_request if $_[0]{children}[0];
220}
221
222sub size_allocate {
223 my ($self, $w, $h) = @_;
224 $self->SUPER::size_allocate ($w, $h);
225 $self->{children}[0]->size_allocate ($w, $h)
226 if $self->{children}[0]
227}
228
229#############################################################################
230
231package Crossfire::Client::Widget::Toplevel;
232
233our @ISA = Crossfire::Client::Widget::Container::;
234
235sub update {
236 my ($self) = @_;
237
238 ::refresh ();
239}
240
241#############################################################################
242
243package Crossfire::Client::Widget::Window;
244
245our @ISA = Crossfire::Client::Widget::Bin::;
246
247use SDL::OpenGL;
248
249sub add {
250 my ($self, $chld) = @_;
251 warn "ADD $chld\n";
252 $self->SUPER::add ($chld);
253 $chld->set_parent ($self);
254}
255
256sub remove {
257 my ($self) = @_;
258 # TODO FIXME: removing a child from a window will crash, see render_chld
259 # $self->update;
260}
261
262sub update {
263 my ($self) = @_;
264 $self->render_chld;
265}
266
267sub render_chld {
268 my ($self) = @_;
269 my $chld = $self->get;
270 my ($w, $h) = $self->size_request;
271
272 require Carp;
273 Carp::cluck "RENDERCHI $w $h";
274 warn "RENDERCHI $w $h\n";
275 $self->{texture} =
276 Crossfire::Client::Texture->new_from_opengl (
277 $w, $h, sub { $chld->draw }
278 );
279 $self->{texture}->upload;
280}
281
282sub size_request {
283 my ($self) = @_;
284 ($self->w, $self->h)
285}
286
287sub size_allocate {
288 my ($self, $w, $h) = @_;
289
290 $self->w ($w);
291 $self->h ($h);
292 $self->get->size_allocate ($w, $h);
293
294 $self->update; #TODO: Move this to the size_request event propably?
295}
296
297sub _draw {
298 my ($self) = @_;
299
300 my ($w, $h) = ($self->w, $self->h);
301
302 my $tex = $self->{texture}
303 or return;
304
305 glEnable GL_BLEND;
306 glEnable GL_TEXTURE_2D;
307 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
308 glBindTexture GL_TEXTURE_2D, $tex->{name};
309
310 glBegin GL_QUADS;
311 glTexCoord 0, 0; glVertex 0, 0;
312 glTexCoord 0, 1; glVertex 0, $h;
313 glTexCoord 1, 1; glVertex $w, $h;
314 glTexCoord 1, 0; glVertex $w, 0;
315 glEnd;
316
317 glDisable GL_BLEND;
318 glDisable GL_TEXTURE_2D;
319}
320
321#############################################################################
322
323package Crossfire::Client::Widget::Frame;
324
325our @ISA = Crossfire::Client::Widget::Bin::;
326
327use SDL::OpenGL;
328
329sub size_request {
330 my ($self) = @_;
331 my $chld = $self->child
332 or return (0, 0);
333
334 $chld->move (2, 2);
335
336 map { $_ + 4 } $chld->size_request;
337}
338
339sub size_allocate {
340 my ($self, $w, $h) = @_;
341
342 $self->SUPER::size_allocate ($w, $h);
343
344 $self->child->size_allocate ($w - 4, $h - 4);
345 $self->child->move (2, 2);
346}
347
348sub _draw {
349 my ($self) = @_;
350
351 my $chld = $self->child;
352
353 my ($w, $h) = $chld->size_request;
354
355 glBegin GL_QUADS;
356 glColor 0, 0, 0;
357 glTexCoord 0, 0; glVertex 0 , 0;
358 glTexCoord 0, 1; glVertex 0 , $h + 4;
359 glTexCoord 1, 1; glVertex $w + 4 , $h + 4;
360 glTexCoord 1, 0; glVertex $w + 4 , 0;
361 glEnd;
362
363 $chld->draw;
364}
365
366#############################################################################
367
368package Crossfire::Client::Widget::FancyFrame;
369
370our @ISA = Crossfire::Client::Widget::Bin::;
371
372use SDL::OpenGL;
373
374my @tex =
375 map { new_from_file Crossfire::Client::Texture Crossfire::Client::find_rcfile $_ }
376 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
377
378sub size_request {
379 my ($self) = @_;
380
381 my ($w, $h) = $self->SUPER::size_request;
382
383 $h += $tex[1]->{height};
384 $h += $tex[4]->{height};
385 $w += $tex[2]->{width};
386 $w += $tex[3]->{width};
387
388 ($w, $h)
389}
390
391sub size_allocate {
392 my ($self, $w, $h) = @_;
393
394 $self->SUPER::size_allocate ($w, $h);
395
396 $h -= $tex[1]->{height};
397 $h -= $tex[4]->{height};
398 $w -= $tex[2]->{width};
399 $w -= $tex[3]->{width};
400
401 $h = $h < 0 ? 0 : $h;
402 $w = $w < 0 ? 0 : $w;
403 warn "CHILD:$w $h\n";
404 $self->child->size_allocate ($w, $h);
405 $self->child->move ($self->{txts}->[3]->{width}, $self->{txts}->[1]->{height});
406}
407
408sub _draw {
409 my ($self) = @_;
410
411 my ($w, $h) = ($self->w, $self->h);
412 my ($cw, $ch) = ($self->child->w, $self->child->h);
413
414 glEnable GL_BLEND;
415 glEnable GL_TEXTURE_2D;
416 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
417 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
418
419 my $top = $tex[1];
420 glBindTexture GL_TEXTURE_2D, $top->{name};
421
422 glBegin GL_QUADS;
423 glTexCoord 0, 0; glVertex 0 , 0;
424 glTexCoord 0, 1; glVertex 0 , $top->{height};
425 glTexCoord 1, 1; glVertex $w , $top->{height};
426 glTexCoord 1, 0; glVertex $w , 0;
427 glEnd;
428
429 my $left = $tex[3];
430 glBindTexture GL_TEXTURE_2D, $left->{name};
431
432 glBegin GL_QUADS;
433 glTexCoord 0, 0; glVertex 0 , $top->{height};
434 glTexCoord 0, 1; glVertex 0 , $top->{height} + $ch;
435 glTexCoord 1, 1; glVertex $left->{width}, $top->{height} + $ch;
436 glTexCoord 1, 0; glVertex $left->{width}, $top->{height};
437 glEnd;
438
439 my $right = $tex[2];
440 glBindTexture GL_TEXTURE_2D, $right->{name};
441
442 glBegin GL_QUADS;
443 glTexCoord 0, 0; glVertex $w - $right->{width}, $top->{height};
444 glTexCoord 0, 1; glVertex $w - $right->{width}, $top->{height} + $ch;
445 glTexCoord 1, 1; glVertex $w , $top->{height} + $ch;
446 glTexCoord 1, 0; glVertex $w , $top->{height};
447 glEnd;
448
449 my $bottom = $tex[4];
450 glBindTexture GL_TEXTURE_2D, $bottom->{name};
451
452 glBegin GL_QUADS;
453 glTexCoord 0, 0; glVertex 0 , $h - $bottom->{height};
454 glTexCoord 0, 1; glVertex 0 , $h;
455 glTexCoord 1, 1; glVertex $w , $h;
456 glTexCoord 1, 0; glVertex $w , $h - $bottom->{height};
457 glEnd;
458
459 my $bg = $tex[0];
460 glBindTexture GL_TEXTURE_2D, $bg->{name};
461 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
462 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
463 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
464
465 my $rep_x = $cw / $bg->{width};
466 my $rep_y = $ch / $bg->{height};
467
468 glBegin GL_QUADS;
469 glTexCoord 0, 0; glVertex $left->{width}, $top->{height};
470 glTexCoord 0, $rep_y; glVertex $left->{width}, $top->{height} + $ch;
471 glTexCoord $rep_x, $rep_y; glVertex $left->{width} + $cw , $top->{height} + $ch;
472 glTexCoord $rep_x, 0; glVertex $left->{width} + $cw , $top->{height};
473 glEnd;
474
475 glDisable GL_BLEND;
476 glDisable GL_TEXTURE_2D;
477
478 $self->child->draw;
479
480}
481
482#############################################################################
483
484package Crossfire::Client::Widget::Table;
485
486our @ISA = Crossfire::Client::Widget::Bin::;
487
488use SDL::OpenGL;
489
490sub add {
491 my ($self, $x, $y, $chld) = @_;
492 my $old_chld = $self->{children}[$y][$x];
493
494 $self->{children}[$y][$x] = $chld;
495 $chld->set_parent ($self);
496 $self->update;
497}
498
499sub max_row_height {
500 my ($self, $row) = @_;
501
502 my $hs = 0;
503 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
504 my $c = $self->{children}->[$row]->[$xi];
505 if ($c) {
506 my ($w, $h) = $c->size_request;
507 if ($hs < $h) { $hs = $h }
508 }
509 }
510 return $hs;
511}
512
513sub max_col_width {
514 my ($self, $col) = @_;
515
516 my $ws = 0;
517 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
518 my $c = ($self->{children}->[$yi] || [])->[$col];
519 if ($c) {
520 my ($w, $h) = $c->size_request;
521 if ($ws < $w) { $ws = $w }
522 }
523 }
524 return $ws;
525}
526
527sub size_request {
528 my ($self) = @_;
529
530 my ($hs, $ws) = (0, 0);
531
532 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
533 $hs += $self->max_row_height ($yi);
534 }
535
536 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
537 my $wm = 0;
538 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
539 $wm += $self->max_col_width ($xi)
540 }
541 if ($ws < $wm) { $ws = $wm }
542 }
543
544 return ($ws, $hs);
545}
546
547sub _draw {
548 my ($self) = @_;
549
550 my $y = 0;
551 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
552 my $x = 0;
553
554 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
555
556 my $c = $self->{children}->[$yi]->[$xi];
557 if ($c) {
558 $c->move ($x, $y, 0); #TODO: Move to size_request
559 $c->draw if $c;
560 }
561
562 $x += $self->max_col_width ($xi);
563 }
564
565 $y += $self->max_row_height ($yi);
566 }
567}
568
569#############################################################################
570
571package Crossfire::Client::Widget::VBox;
572
573our @ISA = Crossfire::Client::Widget::Container::;
574
575use SDL::OpenGL;
576
577sub size_allocate {
578 my ($self, $w, $h) = @_;
579
580 $self->w ($w);
581 $self->h ($h);
582
583 my $exp;
584 my @oth;
585 # find expand widget
586 for (@{$self->{children}}) {
587 if ($_->{expand}) {
588 $exp = $_;
589 last;
590 }
591 push @oth, $_;
592 }
593
594 my ($ow, $oh);
595
596 # get sizes of other widgets
597 for (@oth) {
598 my ($w, $h) = $_->size_request;
599 $oh += $h;
600 if ($ow < $w) { $ow = $w }
601 }
602
603 my $y = 0;
604 for (@{$self->{children}}) {
605 $_->move (0, $y);
606
607 if ($_ == $exp) {
608 $_->size_allocate ($w, $h - $oh);
609 $y += $h - $oh;
610 } else {
611 my ($cw, $h) = $_->size_request;
612 $_->size_allocate ($w, $h);
613 $y += $h;
614 }
615 }
616}
617
618sub _draw {
619 my ($self) = @_;
620
621 my ($x, $y);
622 for (@{$self->{children} || []}) {
623 $_->draw;
624 $y += $_->h;
625 }
626}
627
628#############################################################################
629
630package Crossfire::Client::Widget::Label;
631
632our @ISA = Crossfire::Client::Widget::;
633
634use SDL::OpenGL;
635
636sub new {
637 my ($class, $x, $y, $z, $height, $text) = @_;
638
639 # TODO: color, and make height, xyz etc. optional
640 my $self = $class->SUPER::new (x => $x, y => $y, z => $z, height => $height);
641
642 $self->set_text ($text);
643
644 $self
645}
646
647sub set_text {
648 my ($self, $text) = @_;
649
650 $self->{text} = $text;
651 $self->{texture} = new_from_text Crossfire::Client::Texture $text, $self->{height};
652
653 $self->update;
654}
655
656sub get_text {
657 my ($self, $text) = @_;
658
659 $self->{text}
660}
661
662sub size_request {
663 my ($self) = @_;
664
665 (
666 $self->{texture}{width},
667 $self->{texture}{height},
668 )
669}
670
671sub _draw {
672 my ($self) = @_;
673
674 my $tex = $self->{texture};
675
676 glEnable GL_BLEND;
677 glEnable GL_TEXTURE_2D;
678 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
679 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
680 glBindTexture GL_TEXTURE_2D, $tex->{name};
681
682 glColor 1, 0, 0, 1; # TODO color
683
684 glBegin GL_QUADS;
685 glTexCoord 0, 0; glVertex 0 , 0;
686 glTexCoord 0, 1; glVertex 0 , $tex->{height};
687 glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
688 glTexCoord 1, 0; glVertex $tex->{width}, 0;
689 glEnd;
690
691 glDisable GL_BLEND;
692 glDisable GL_TEXTURE_2D;
693}
694
695#############################################################################
696
697package Crossfire::Client::Widget::TextEntry;
698
699our @ISA = Crossfire::Client::Widget::Label::;
700
701use SDL;
702use SDL::OpenGL;
703
704sub key_down {
705 my ($self, $ev) = @_;
706
707 my $mod = $ev->key_mod;
708 my $sym = $ev->key_sym;
709
710 $ev->set_unicode (1);
711 my $uni = $ev->key_unicode;
712
713 my $text = $self->get_text;
714
715 if ($sym == SDLK_BACKSPACE) {
716 substr $text, -1, 1, '';
717
718 } elsif ($uni) {
719 $text .= chr $uni;
720 }
721 $self->set_text ($text);
722}
723
724#############################################################################
725
726package Crossfire::Client::Widget::MapWidget;
727
54use strict; 728use strict;
55our @ISA = qw/Client::Widget/;
56 729
730use List::Util qw(min max);
731
732use SDL;
57use SDL::OpenGL; 733use SDL::OpenGL;
58use SDL::OpenGL::Constants; 734use SDL::OpenGL::Constants;
59 735
60sub add_line {
61 my ($self, $line) = @_;
62 push @{$self->{lines}}, $line;
63}
64
65sub draw {
66 my ($self) = @_;
67
68}
69
70package Client::MapWidget;
71use strict;
72our @ISA = qw/Client::Widget/; 736our @ISA = Crossfire::Client::Widget::;
73
74use SDL::OpenGL;
75use SDL::OpenGL::Constants;
76 737
77sub key_down { 738sub key_down {
78 print "MAPKEYDOWN\n"; 739 print "MAPKEYDOWN\n";
79} 740}
80 741
81sub key_up { 742sub key_up {
82} 743}
83 744
745sub size_request {
746
747}
748
749sub size_allocate {
750}
751
84sub draw { 752sub _draw {
753 my ($self) = @_;
754
755 my $mx = $::CONN->{mapx};
756 my $my = $::CONN->{mapy};
757
758 my $map = $::CONN->{map};
759
760 my ($xofs, $yofs);
761
762 my $sw = 1 + int $::WIDTH / 32;
763 my $sh = 1 + int $::HEIGHT / 32;
764
765 if ($::CONN->{mapw} > $sw) {
766 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
767 } else {
768 $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
769 }
770
771 if ($::CONN->{maph} > $sh) {
772 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
773 } else {
774 $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
775 }
776
85 glEnable GL_TEXTURE_2D; 777 glEnable GL_TEXTURE_2D;
86 glEnable GL_BLEND; 778 glEnable GL_BLEND;
779 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
87 780
88 my $map = $::CONN->{map}; 781 my $sw4 = ($sw + 3) & ~3;
782 my $lighting = "\x00" x ($sw4 * $sh);
89 783
90 for my $x (0 .. $::CONN->{mapw} - 1) { 784 for my $x (0 .. $sw - 1) {
91 for my $y (0 .. $::CONN->{maph} - 1) { 785 for my $y (0 .. $sh - 1) {
92 786
93 my $cell = $map->[$x][$y] 787 my $cell = $map->[$x + $xofs][$y + $yofs]
94 or next; 788 or next;
95 789
96 my $darkness = $cell->[3] * (1 / 255); 790 my $darkness = $cell->[0] * (1 / 255);
97 glColor $darkness, $darkness, $darkness; 791 if ($darkness < 0) {
792 $darkness = 0.15;
793 }
794 substr $lighting, $y * $sw4 + $x, 1, chr 255 - $darkness * 255;
98 795
99 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) { 796 for my $num (grep $_, @$cell[1,2,3]) {
100 my $tex = $::CONN->{face}[$num]{texture} || 0; 797 my $tex = $::CONN->{face}[$num]{texture} || next;
101 798
102 glBindTexture GL_TEXTURE_2D, $tex; 799 glBindTexture GL_TEXTURE_2D, $tex->{name};
800
801 my $w = $tex->{width};
802 my $h = $tex->{height};
803
804 my $px = ($x + 1) * 32 - $w;
805 my $py = ($y + 1) * 32 - $h;
103 806
104 glBegin GL_QUADS; 807 glBegin GL_QUADS;
105 glTexCoord 0, 0; glVertex $x, $y; 808 glTexCoord 0, 0; glVertex $px , $py;
106 glTexCoord 0, 1; glVertex $x, $y + 1; 809 glTexCoord 0, 1; glVertex $px , $py + $h;
107 glTexCoord 1, 1; glVertex $x + 1, $y + 1; 810 glTexCoord 1, 1; glVertex $px + $w, $py + $h;
108 glTexCoord 1, 0; glVertex $x + 1, $y; 811 glTexCoord 1, 0; glVertex $px + $w, $py;
109 glEnd; 812 glEnd;
110 } 813 }
111 } 814 }
112 } 815 }
113 816
817# if (1) { # higher quality darkness
818# $lighting =~ s/(.)/$1$1$1/gs;
819# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
820#
821# $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
822#
823# $lighting = $pb->get_pixels;
824# $lighting =~ s/(.)../$1/gs;
825# }
826
827 $lighting = new Crossfire::Client::Texture
828 width => $sw4,
829 height => $sh,
830 data => $lighting,
831 internalformat => GL_ALPHA4,
832 format => GL_ALPHA;
833
834 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
835 glColor 0, 0, 0, 0.75;
836 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
837 glBindTexture GL_TEXTURE_2D, $lighting->{name};
838 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
839 glBegin GL_QUADS;
840 glTexCoord 0, 0; glVertex 0 , 0;
841 glTexCoord 0, 1; glVertex 0 , $sh * 32;
842 glTexCoord 1, 1; glVertex $sw4 * 32, $sh * 32;
843 glTexCoord 1, 0; glVertex $sw4 * 32, 0;
844 glEnd;
845
114 glDisable GL_TEXTURE_2D; 846 glDisable GL_TEXTURE_2D;
115 glDisable GL_BLEND; 847 glDisable GL_BLEND;
116} 848}
117 849
850my %DIR = (
851 SDLK_KP8, [1, "north"],
852 SDLK_KP9, [2, "northeast"],
853 SDLK_KP6, [3, "east"],
854 SDLK_KP3, [4, "southeast"],
855 SDLK_KP2, [5, "south"],
856 SDLK_KP1, [6, "southwest"],
857 SDLK_KP4, [7, "west"],
858 SDLK_KP7, [8, "northwest"],
859
860 SDLK_UP, [1, "north"],
861 SDLK_RIGHT, [3, "east"],
862 SDLK_DOWN, [5, "south"],
863 SDLK_LEFT, [7, "west"],
864);
865
866sub key_down {
867 my ($self, $ev) = @_;
868
869 my $mod = $ev->key_mod;
870 my $sym = $ev->key_sym;
871
872 if ($sym == SDLK_KP5) {
873 $::CONN->send ("command stay fire");
874 } elsif (exists $DIR{$sym}) {
875 if ($mod & KMOD_SHIFT) {
876 $self->{shft}++;
877 $::CONN->send ("command fire $DIR{$sym}[0]");
878 } elsif ($mod & KMOD_CTRL) {
879 $self->{ctrl}++;
880 $::CONN->send ("command run $DIR{$sym}[0]");
881 } else {
882 $::CONN->send ("command $DIR{$sym}[1]");
883 }
884 }
885}
886
887sub key_up {
888 my ($self, $ev) = @_;
889
890 my $mod = $ev->key_mod;
891 my $sym = $ev->key_sym;
892
893 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
894 $::CONN->send ("command fire_stop");
895 }
896 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
897 $::CONN->send ("command run_stop");
898 }
899}
900
901#############################################################################
902
903package Crossfire::Client::Widget::Animator;
904
905use SDL::OpenGL;
906
907our @ISA = Crossfire::Client::Widget::Bin::;
908
909sub moveto {
910 my ($self, $x, $y) = @_;
911
912 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
913 $self->{speed} = 0.2;
914 $self->{time} = 1;
915
916 ::animation_start $self;
917}
918
919sub animate {
920 my ($self, $interval) = @_;
921
922 $self->{time} -= $interval * $self->{speed};
923 if ($self->{time} <= 0) {
924 $self->{time} = 0;
925 ::animation_stop $self;
926 }
927
928 my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
929
930 $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
931 $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
932}
933
934sub _draw {
935 my ($self) = @_;
936
937 glPushMatrix;
938 glRotate $self->{time} * 10000, 0, 1, 0;
939 $self->{children}[0]->draw;
940 glPopMatrix;
941}
942
1181; 9431;
944

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines