ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.21
Committed: Sat Apr 8 18:15:59 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.20: +11 -5 lines
Log Message:
*** empty log message ***

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 $self->{texture} =
137 Crossfire::Client::Texture->new_from_opengl (
138 $w, $h, sub {
139 my ($txt, $w, $h) = @_;
140 $chld->_draw;
141 }
142 );
143 $self->{texture}->upload;
144 }
145
146 sub size_request {
147 my ($self) = @_;
148 my $chld = $self->get
149 or return (0, 0);
150 $chld->size_request
151 }
152
153 sub _draw {
154 my ($self) = @_;
155
156 my $tex = $self->{texture}
157 or return;
158
159 warn "DRAW TEX: $tex->{width} $tex->{height}\n";
160 glEnable GL_BLEND;
161 glEnable GL_TEXTURE_2D;
162 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
163 glBindTexture GL_TEXTURE_2D, $tex->{name};
164
165 glColor 1, 1, 1;
166
167 glBegin GL_QUADS;
168 glTexCoord 0, 0; glVertex 0 , 0;
169 glTexCoord 0, 1; glVertex 0 , $tex->{height};
170 glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
171 glTexCoord 1, 0; glVertex $tex->{width}, 0;
172 glEnd;
173
174 glDisable GL_BLEND;
175 glDisable GL_TEXTURE_2D;
176 }
177
178 package Crossfire::Client::Widget::Frame;
179
180 our @ISA = Crossfire::Client::Widget::Container::;
181
182 use SDL::OpenGL;
183
184 sub size_request {
185 my ($self) = @_;
186 my $chld = $self->get
187 or return (0, 0);
188 map { $_ + 4 } $chld->size_request;
189 }
190
191 sub _draw {
192 my ($self) = @_;
193
194 my $chld = $self->get;
195
196 my ($w, $h) = $chld->size_request;
197
198 glColor 1, 0, 0;
199 glBegin GL_QUADS;
200 glTexCoord 0, 0; glVertex 0 , 0;
201 glTexCoord 0, 1; glVertex 0 , $h + 4;
202 glTexCoord 1, 1; glVertex $w + 4 , $h + 4;
203 glTexCoord 1, 0; glVertex $w + 4 , 0;
204 glEnd;
205
206 glPushMatrix;
207 glTranslate (2, 2, 0);
208 $chld->_draw;
209 glPopMatrix;
210 }
211
212 package Crossfire::Client::Widget::Table;
213
214 our @ISA = Crossfire::Client::Widget::Container::;
215
216 use SDL::OpenGL;
217
218 sub add {
219 my ($self, $x, $y, $chld) = @_;
220 $self->{childs}[$y][$x] = $chld;
221 }
222
223 sub max_row_height {
224 my ($self, $row) = @_;
225
226 my $hs = 0;
227 for (my $xi = 0; $xi <= $#{$self->{childs}->[$row] || []}; $xi++) {
228 my $c = $self->{childs}->[$row]->[$xi];
229 if ($c) {
230 my ($w, $h) = $c->size_request;
231 if ($hs < $h) { $hs = $h }
232 }
233 }
234 return $hs;
235 }
236
237 sub max_col_width {
238 my ($self, $col) = @_;
239
240 my $ws = 0;
241 for (my $yi = 0; $yi <= $#{$self->{childs} || []}; $yi++) {
242 my $c = ($self->{childs}->[$yi] || [])->[$col];
243 if ($c) {
244 my ($w, $h) = $c->size_request;
245 if ($ws < $w) { $ws = $w }
246 }
247 }
248 return $ws;
249 }
250
251 sub size_request {
252 my ($self) = @_;
253
254 my ($hs, $ws) = (0, 0);
255
256 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
257 $hs += $self->max_row_height ($yi);
258 }
259
260 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
261 my $wm = 0;
262 for (my $xi = 0; $xi <= $#{$self->{childs}->[$yi]}; $xi++) {
263 $wm += $self->max_col_width ($xi)
264 }
265 if ($ws < $wm) { $ws = $wm }
266 }
267
268 return ($ws, $hs);
269 }
270
271 sub _draw {
272 my ($self) = @_;
273
274 my $y = 0;
275 for (my $yi = 0; $yi <= $#{$self->{childs}}; $yi++) {
276 my $x = 0;
277
278 for (my $xi = 0; $xi <= $#{$self->{childs}->[$yi]}; $xi++) {
279
280 glPushMatrix;
281 glTranslate ($x, $y, 0);
282 my $c = $self->{childs}->[$yi]->[$xi];
283 $c->_draw if $c;
284 glPopMatrix;
285
286 $x += $self->max_col_width ($xi);
287 }
288
289 $y += $self->max_row_height ($yi);
290 }
291 }
292
293 package Crossfire::Client::Widget::VBox;
294
295 our @ISA = Crossfire::Client::Widget::Container::;
296
297 use SDL::OpenGL;
298
299 sub add {
300 my ($self, $chld) = @_;
301 push @{$self->{childs}}, $chld;
302 }
303
304 sub size_request {
305 my ($self) = @_;
306
307 my ($hs, $ws) = (0, 0);
308 for (@{$self->{childs} || []}) {
309 my ($w, $h) = $_->size_request;
310 $hs += $h;
311 if ($ws < $w) { $ws = $w }
312 }
313
314 return ($ws, $hs);
315 }
316
317 sub _draw {
318 my ($self) = @_;
319
320 my ($x, $y);
321 for (@{$self->{childs} || []}) {
322 glPushMatrix;
323 glTranslate (0, $y, 0);
324 $_->_draw;
325 glPopMatrix;
326 my ($w, $h) = $_->size_request;
327 $y += $h;
328 }
329 }
330
331 package Crossfire::Client::Widget::Label;
332
333 our @ISA = Crossfire::Client::Widget::;
334
335 use SDL::OpenGL;
336
337 sub new {
338 my ($class, $x, $y, $z, $ttf, $text) = @_;
339
340 my $self = $class->SUPER::new (x => $x, y => $y, z => $z, ttf => $ttf);
341
342 $self->set_text ($text);
343
344 $self
345 }
346
347 sub set_text {
348 my ($self, $text) = @_;
349 $self->{texture} = new_from_ttf Crossfire::Client::Texture $self->{ttf}, $self->{text} = $text;
350 }
351
352 sub get_text {
353 my ($self, $text) = @_;
354 $self->{text}
355 }
356
357 sub size_request {
358 my ($self) = @_;
359
360 (
361 $self->{texture}{width},
362 $self->{texture}{height},
363 )
364 }
365
366 sub _draw {
367 my ($self) = @_;
368
369 my $tex = $self->{texture};
370
371 glEnable GL_BLEND;
372 glEnable GL_TEXTURE_2D;
373 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
374 glBindTexture GL_TEXTURE_2D, $tex->{name};
375
376 glColor 1, 1, 1;
377
378 glBegin GL_QUADS;
379 glTexCoord 0, 0; glVertex 0 , 0;
380 glTexCoord 0, 1; glVertex 0 , $tex->{height};
381 glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
382 glTexCoord 1, 0; glVertex $tex->{width}, 0;
383 glEnd;
384
385 glDisable GL_BLEND;
386 glDisable GL_TEXTURE_2D;
387 }
388
389 package Crossfire::Client::Widget::TextView;
390
391 use strict;
392
393 our @ISA = qw/Crossfire::Client::Widget/;
394
395 use SDL::OpenGL;
396 use SDL::OpenGL::Constants;
397
398 sub add_line {
399 my ($self, $line) = @_;
400 push @{$self->{lines}}, $line;
401 }
402
403 sub _draw {
404 my ($self) = @_;
405
406 }
407
408 package Crossfire::Client::Widget::MapWidget;
409
410 use strict;
411
412 our @ISA = qw/Crossfire::Client::Widget/;
413
414 use SDL;
415 use SDL::OpenGL;
416 use SDL::OpenGL::Constants;
417
418 sub key_down {
419 print "MAPKEYDOWN\n";
420 }
421
422 sub key_up {
423 }
424
425 sub _draw {
426 my ($self) = @_;
427
428 glEnable GL_TEXTURE_2D;
429 glEnable GL_BLEND;
430 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
431
432 my $map = $::CONN->{map};
433
434 for my $x (0 .. int $::WIDTH / 32) {
435 for my $y (0 .. int $::HEIGHT / 32) {
436
437 my $cell = $map->[$x + $::CONN->{mapx}]
438 [$y + $::CONN->{mapy}]
439 or next;
440
441 my $darkness = $cell->[0] * (1 / 255);
442 if ($darkness < 0) {
443 $darkness = 0.5;
444 }
445 glColor $darkness, $darkness, $darkness;
446
447 for my $num (grep $_, @$cell[1,2,3]) {
448 my $tex = $::CONN->{face}[$num]{texture} || next;
449
450 glBindTexture GL_TEXTURE_2D, $tex->{name};
451
452 my $w = $tex->{width};
453 my $h = $tex->{height};
454
455 my $px = ($x + 1) * 32 - $w;
456 my $py = ($y + 1) * 32 - $h;
457
458 glBegin GL_QUADS;
459 glTexCoord 0, 0; glVertex $px , $py;
460 glTexCoord 0, 1; glVertex $px , $py + $h;
461 glTexCoord 1, 1; glVertex $px + $w, $py + $h;
462 glTexCoord 1, 0; glVertex $px + $w, $py;
463 glEnd;
464 }
465 }
466 }
467
468 glDisable GL_TEXTURE_2D;
469 glDisable GL_BLEND;
470 }
471
472 my %DIR = (
473 SDLK_KP8, [1, "north"],
474 SDLK_KP9, [2, "northeast"],
475 SDLK_KP6, [3, "east"],
476 SDLK_KP3, [4, "southeast"],
477 SDLK_KP2, [5, "south"],
478 SDLK_KP1, [6, "southwest"],
479 SDLK_KP4, [7, "west"],
480 SDLK_KP7, [8, "northwest"],
481
482 SDLK_UP, [1, "north"],
483 SDLK_RIGHT, [3, "east"],
484 SDLK_DOWN, [5, "south"],
485 SDLK_LEFT, [7, "west"],
486 );
487
488 sub key_down {
489 my ($self, $ev) = @_;
490
491 my $mod = $ev->key_mod;
492 my $sym = $ev->key_sym;
493
494 if ($sym == SDLK_KP5) {
495 $::CONN->send ("command stay fire");
496 } elsif (exists $DIR{$sym}) {
497 if ($mod & KMOD_SHIFT) {
498 $self->{shft}++;
499 $::CONN->send ("command fire $DIR{$sym}[0]");
500 } elsif ($mod & KMOD_CTRL) {
501 $self->{ctrl}++;
502 $::CONN->send ("command run $DIR{$sym}[0]");
503 } else {
504 $::CONN->send ("command $DIR{$sym}[1]");
505 }
506 }
507 }
508
509 sub key_up {
510 my ($self, $ev) = @_;
511
512 my $mod = $ev->key_mod;
513 my $sym = $ev->key_sym;
514
515 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
516 $::CONN->send ("command fire_stop");
517 }
518 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
519 $::CONN->send ("command run_stop");
520 }
521 }
522
523 1;
524