ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.34
Committed: Sun Apr 9 02:44:51 2006 UTC (18 years, 1 month ago) by elmex
Branch: MAIN
Changes since 1.33: +108 -1 lines
Log Message:
some latenight eyecandy

File Contents

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