ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.22
Committed: Sat Apr 8 18:18:09 2006 UTC (18 years, 2 months ago) by elmex
Branch: MAIN
Changes since 1.21: +9 -5 lines
Log Message:
debugging Widget::Window

File Contents

# Content
1 package Crossfire::Client::Widget;
2
3 use strict;
4
5 use Scalar::Util;
6
7 use SDL::OpenGL;
8 use SDL::OpenGL::Constants;
9
10 our $FOCUS; # the widget with current focus
11 our @ACTIVE_WIDGETS;
12
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 sub feed_sdl_button_down_event { $FOCUS->button_down ($_[0]) if $FOCUS }
17 sub feed_sdl_button_up_event { $FOCUS->button_up ($_[0]) if $FOCUS }
18
19 sub new {
20 my $class = shift;
21
22 bless { @_ }, $class
23 }
24
25 sub activate {
26 push @ACTIVE_WIDGETS, $_[0];
27 Scalar::Util::weaken $ACTIVE_WIDGETS[-1];
28 }
29
30 sub deactivate {
31 @ACTIVE_WIDGETS =
32 sort { $a->{z} <=> $b->{z} }
33 grep { $_ && $_ != $_[0] }
34 @ACTIVE_WIDGETS;
35 }
36
37 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 sub needs_redraw {
45 0
46 }
47
48 sub size_request {
49 die "size_request is abtract";
50 }
51
52 sub focus_in {
53 my ($widget) = @_;
54 $FOCUS = $widget;
55 }
56
57 sub focus_out {
58 my ($widget) = @_;
59 }
60
61 sub key_down {
62 my ($widget, $sdlev) = @_;
63 }
64
65 sub key_up {
66 my ($widget, $sdlev) = @_;
67 }
68
69 sub button_down {
70 my ($widget, $sdlev) = @_;
71 }
72
73 sub button_up {
74 my ($widget, $sdlev) = @_;
75 }
76
77 sub w { $_[0]->{w} }
78 sub h { $_[0]->{h} }
79 sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }
80 sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }
81 sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }
82
83 sub draw {
84 my ($self) = @_;
85
86 glPushMatrix;
87 glTranslate $self->{x}, $self->{y}, 0;
88 $self->_draw;
89 glPopMatrix;
90 }
91
92 sub _draw {
93 my ($widget) = @_;
94 }
95
96 sub bbox {
97 my ($widget) = @_;
98 }
99
100 sub DESTROY {
101 my ($self) = @_;
102
103 $self->deactivate;
104 }
105
106 package Crossfire::Client::Widget::Container;
107
108 our @ISA = Crossfire::Client::Widget::;
109
110 use SDL::OpenGL;
111
112 sub add { $_[0]->{child} = $_[1] }
113 sub get { $_[0]->{child} }
114
115 sub size_request { $_[0]->{child}->size_request if $_[0]->{child} }
116
117 sub _draw { die "Containers can't be drawn!" }
118
119 package Crossfire::Client::Widget::Window;
120
121 our @ISA = Crossfire::Client::Widget::Container::;
122
123 use SDL::OpenGL;
124
125 sub add {
126 my ($self, $chld) = @_;
127 $self->SUPER::add ($chld);
128 $self->render_chld;
129 }
130
131 sub render_chld {
132 my ($self) = @_;
133 my $chld = $self->get;
134 my ($w, $h) = $self->size_request;
135
136 $w = $h = 256;
137
138 $self->{texture} =
139 Crossfire::Client::Texture->new_from_opengl (
140 $w, $h, sub {
141 glPushMatrix;
142 glLoadIdentity;
143 $chld->_draw;
144 glPopMatrix;
145 }
146 );
147 $self->{texture}->upload;
148 }
149
150 sub size_request {
151 my ($self) = @_;
152 my $chld = $self->get
153 or return (0, 0);
154 $chld->size_request
155 }
156
157 sub _draw {
158 my ($self) = @_;
159
160 my ($w, $h) = $self->size_request;
161 my $tex = $self->{texture}
162 or return;
163
164 glEnable GL_BLEND;
165 glEnable GL_TEXTURE_2D;
166 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
167 glBindTexture GL_TEXTURE_2D, $tex->{name};
168
169 glColor 1, 1, 1;
170
171 glBegin GL_QUADS;
172 glTexCoord 0, 0; glVertex 0 , 0;
173 glTexCoord 0, 1; glVertex 0 , $h;
174 glTexCoord 1, 1; glVertex $w , $h;
175 glTexCoord 1, 0; glVertex $w , 0;
176 glEnd;
177
178 glDisable GL_BLEND;
179 glDisable GL_TEXTURE_2D;
180 }
181
182 package Crossfire::Client::Widget::Frame;
183
184 our @ISA = Crossfire::Client::Widget::Container::;
185
186 use SDL::OpenGL;
187
188 sub size_request {
189 my ($self) = @_;
190 my $chld = $self->get
191 or return (0, 0);
192 map { $_ + 4 } $chld->size_request;
193 }
194
195 sub _draw {
196 my ($self) = @_;
197
198 my $chld = $self->get;
199
200 my ($w, $h) = $chld->size_request;
201
202 glColor 1, 0, 0;
203 glBegin GL_QUADS;
204 glTexCoord 0, 0; glVertex 0 , 0;
205 glTexCoord 0, 1; glVertex 0 , $h + 4;
206 glTexCoord 1, 1; glVertex $w + 4 , $h + 4;
207 glTexCoord 1, 0; glVertex $w + 4 , 0;
208 glEnd;
209
210 glPushMatrix;
211 glTranslate (2, 2, 0);
212 $chld->_draw;
213 glPopMatrix;
214 }
215
216 package Crossfire::Client::Widget::Table;
217
218 our @ISA = Crossfire::Client::Widget::Container::;
219
220 use SDL::OpenGL;
221
222 sub add {
223 my ($self, $x, $y, $chld) = @_;
224 $self->{childs}[$y][$x] = $chld;
225 }
226
227 sub max_row_height {
228 my ($self, $row) = @_;
229
230 my $hs = 0;
231 for (my $xi = 0; $xi <= $#{$self->{childs}->[$row] || []}; $xi++) {
232 my $c = $self->{childs}->[$row]->[$xi];
233 if ($c) {
234 my ($w, $h) = $c->size_request;
235 if ($hs < $h) { $hs = $h }
236 }
237 }
238 return $hs;
239 }
240
241 sub max_col_width {
242 my ($self, $col) = @_;
243
244 my $ws = 0;
245 for (my $yi = 0; $yi <= $#{$self->{childs} || []}; $yi++) {
246 my $c = ($self->{childs}->[$yi] || [])->[$col];
247 if ($c) {
248 my ($w, $h) = $c->size_request;
249 if ($ws < $w) { $ws = $w }
250 }
251 }
252 return $ws;
253 }
254
255 sub size_request {
256 my ($self) = @_;
257
258 my ($hs, $ws) = (0, 0);
259
260 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
261 $hs += $self->max_row_height ($yi);
262 }
263
264 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
265 my $wm = 0;
266 for (my $xi = 0; $xi <= $#{$self->{childs}->[$yi]}; $xi++) {
267 $wm += $self->max_col_width ($xi)
268 }
269 if ($ws < $wm) { $ws = $wm }
270 }
271
272 return ($ws, $hs);
273 }
274
275 sub _draw {
276 my ($self) = @_;
277
278 my $y = 0;
279 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
280 my $x = 0;
281
282 for (my $xi = 0; $xi <= $#{$self->{childs}->[$yi]}; $xi++) {
283
284 glPushMatrix;
285 glTranslate ($x, $y, 0);
286 my $c = $self->{childs}->[$yi]->[$xi];
287 $c->_draw if $c;
288 glPopMatrix;
289
290 $x += $self->max_col_width ($xi);
291 }
292
293 $y += $self->max_row_height ($yi);
294 }
295 }
296
297 package Crossfire::Client::Widget::VBox;
298
299 our @ISA = Crossfire::Client::Widget::Container::;
300
301 use SDL::OpenGL;
302
303 sub add {
304 my ($self, $chld) = @_;
305 push @{$self->{childs}}, $chld;
306 }
307
308 sub size_request {
309 my ($self) = @_;
310
311 my ($hs, $ws) = (0, 0);
312 for (@{$self->{childs} || []}) {
313 my ($w, $h) = $_->size_request;
314 $hs += $h;
315 if ($ws < $w) { $ws = $w }
316 }
317
318 return ($ws, $hs);
319 }
320
321 sub _draw {
322 my ($self) = @_;
323
324 my ($x, $y);
325 for (@{$self->{childs} || []}) {
326 glPushMatrix;
327 glTranslate (0, $y, 0);
328 $_->_draw;
329 glPopMatrix;
330 my ($w, $h) = $_->size_request;
331 $y += $h;
332 }
333 }
334
335 package Crossfire::Client::Widget::Label;
336
337 our @ISA = Crossfire::Client::Widget::;
338
339 use SDL::OpenGL;
340
341 sub new {
342 my ($class, $x, $y, $z, $ttf, $text) = @_;
343
344 my $self = $class->SUPER::new (x => $x, y => $y, z => $z, ttf => $ttf);
345
346 $self->set_text ($text);
347
348 $self
349 }
350
351 sub set_text {
352 my ($self, $text) = @_;
353 $self->{texture} = new_from_ttf Crossfire::Client::Texture $self->{ttf}, $self->{text} = $text;
354 }
355
356 sub get_text {
357 my ($self, $text) = @_;
358 $self->{text}
359 }
360
361 sub size_request {
362 my ($self) = @_;
363
364 (
365 $self->{texture}{width},
366 $self->{texture}{height},
367 )
368 }
369
370 sub _draw {
371 my ($self) = @_;
372
373 my $tex = $self->{texture};
374
375 glEnable GL_BLEND;
376 glEnable GL_TEXTURE_2D;
377 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
378 glBindTexture GL_TEXTURE_2D, $tex->{name};
379
380 glColor 1, 1, 1;
381
382 glBegin GL_QUADS;
383 glTexCoord 0, 0; glVertex 0 , 0;
384 glTexCoord 0, 1; glVertex 0 , $tex->{height};
385 glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
386 glTexCoord 1, 0; glVertex $tex->{width}, 0;
387 glEnd;
388
389 glDisable GL_BLEND;
390 glDisable GL_TEXTURE_2D;
391 }
392
393 package Crossfire::Client::Widget::TextView;
394
395 use strict;
396
397 our @ISA = qw/Crossfire::Client::Widget/;
398
399 use SDL::OpenGL;
400 use SDL::OpenGL::Constants;
401
402 sub add_line {
403 my ($self, $line) = @_;
404 push @{$self->{lines}}, $line;
405 }
406
407 sub _draw {
408 my ($self) = @_;
409
410 }
411
412 package Crossfire::Client::Widget::MapWidget;
413
414 use strict;
415
416 our @ISA = qw/Crossfire::Client::Widget/;
417
418 use SDL;
419 use SDL::OpenGL;
420 use SDL::OpenGL::Constants;
421
422 sub key_down {
423 print "MAPKEYDOWN\n";
424 }
425
426 sub key_up {
427 }
428
429 sub _draw {
430 my ($self) = @_;
431
432 glEnable GL_TEXTURE_2D;
433 glEnable GL_BLEND;
434 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
435
436 my $map = $::CONN->{map};
437
438 for my $x (0 .. int $::WIDTH / 32) {
439 for my $y (0 .. int $::HEIGHT / 32) {
440
441 my $cell = $map->[$x + $::CONN->{mapx}]
442 [$y + $::CONN->{mapy}]
443 or next;
444
445 my $darkness = $cell->[0] * (1 / 255);
446 if ($darkness < 0) {
447 $darkness = 0.5;
448 }
449 glColor $darkness, $darkness, $darkness;
450
451 for my $num (grep $_, @$cell[1,2,3]) {
452 my $tex = $::CONN->{face}[$num]{texture} || next;
453
454 glBindTexture GL_TEXTURE_2D, $tex->{name};
455
456 my $w = $tex->{width};
457 my $h = $tex->{height};
458
459 my $px = ($x + 1) * 32 - $w;
460 my $py = ($y + 1) * 32 - $h;
461
462 glBegin GL_QUADS;
463 glTexCoord 0, 0; glVertex $px , $py;
464 glTexCoord 0, 1; glVertex $px , $py + $h;
465 glTexCoord 1, 1; glVertex $px + $w, $py + $h;
466 glTexCoord 1, 0; glVertex $px + $w, $py;
467 glEnd;
468 }
469 }
470 }
471
472 glDisable GL_TEXTURE_2D;
473 glDisable GL_BLEND;
474 }
475
476 my %DIR = (
477 SDLK_KP8, [1, "north"],
478 SDLK_KP9, [2, "northeast"],
479 SDLK_KP6, [3, "east"],
480 SDLK_KP3, [4, "southeast"],
481 SDLK_KP2, [5, "south"],
482 SDLK_KP1, [6, "southwest"],
483 SDLK_KP4, [7, "west"],
484 SDLK_KP7, [8, "northwest"],
485
486 SDLK_UP, [1, "north"],
487 SDLK_RIGHT, [3, "east"],
488 SDLK_DOWN, [5, "south"],
489 SDLK_LEFT, [7, "west"],
490 );
491
492 sub key_down {
493 my ($self, $ev) = @_;
494
495 my $mod = $ev->key_mod;
496 my $sym = $ev->key_sym;
497
498 if ($sym == SDLK_KP5) {
499 $::CONN->send ("command stay fire");
500 } elsif (exists $DIR{$sym}) {
501 if ($mod & KMOD_SHIFT) {
502 $self->{shft}++;
503 $::CONN->send ("command fire $DIR{$sym}[0]");
504 } elsif ($mod & KMOD_CTRL) {
505 $self->{ctrl}++;
506 $::CONN->send ("command run $DIR{$sym}[0]");
507 } else {
508 $::CONN->send ("command $DIR{$sym}[1]");
509 }
510 }
511 }
512
513 sub key_up {
514 my ($self, $ev) = @_;
515
516 my $mod = $ev->key_mod;
517 my $sym = $ev->key_sym;
518
519 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
520 $::CONN->send ("command fire_stop");
521 }
522 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
523 $::CONN->send ("command run_stop");
524 }
525 }
526
527 1;
528