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.13 by elmex, Fri Apr 7 20:57:29 2006 UTC vs.
Revision 1.20 by elmex, Sat Apr 8 17:21:01 2006 UTC

1package Crossfire::Client::Widget; 1package Crossfire::Client::Widget;
2 2
3use strict; 3use strict;
4
5use Scalar::Util;
6
4use SDL::OpenGL; 7use SDL::OpenGL;
5use SDL::OpenGL::Constants; 8use SDL::OpenGL::Constants;
6 9
7our $FOCUS; # the widget with current focus 10our $FOCUS; # the widget with current focus
8our @ACTIVE_WIDGETS; 11our @ACTIVE_WIDGETS;
… …
19 bless { @_ }, $class 22 bless { @_ }, $class
20} 23}
21 24
22sub activate { 25sub activate {
23 push @ACTIVE_WIDGETS, $_[0]; 26 push @ACTIVE_WIDGETS, $_[0];
27 Scalar::Util::weaken $ACTIVE_WIDGETS[-1];
24} 28}
25 29
26sub deactivate { 30sub deactivate {
27 @ACTIVE_WIDGETS = 31 @ACTIVE_WIDGETS =
28 sort { $a->{z} <=> $b->{z} } 32 sort { $a->{z} <=> $b->{z} }
29 grep { $_ != $_[0] } 33 grep { $_ && $_ != $_[0] }
30 @ACTIVE_WIDGETS; 34 @ACTIVE_WIDGETS;
35}
36
37sub move {
38 my ($self, $x, $y, $z) = @_;
39 $self->{x} = $x;
40 $self->{y} = $y;
41 $self->{z} = $z if defined $z;
42}
43
44sub needs_redraw {
45 0
46}
47
48sub size_request {
49 die "size_request is abtract";
31} 50}
32 51
33sub focus_in { 52sub focus_in {
34 my ($widget) = @_; 53 my ($widget) = @_;
35 $FOCUS = $widget; 54 $FOCUS = $widget;
… …
53 72
54sub button_up { 73sub button_up {
55 my ($widget, $sdlev) = @_; 74 my ($widget, $sdlev) = @_;
56} 75}
57 76
77sub w { $_[0]->{w} }
78sub h { $_[0]->{h} }
58sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} } 79sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }
59sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} } 80sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }
60sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} } 81sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }
61 82
62sub draw { 83sub draw {
… …
74 95
75sub bbox { 96sub bbox {
76 my ($widget) = @_; 97 my ($widget) = @_;
77} 98}
78 99
100sub DESTROY {
101 my ($self) = @_;
102
103 $self->deactivate;
104}
105
79package Crossfire::Client::Widget::Label; 106package Crossfire::Client::Widget::Container;
80 107
81our @ISA = Crossfire::Client::Widget::; 108our @ISA = Crossfire::Client::Widget::;
82 109
83use SDL::OpenGL; 110use SDL::OpenGL;
84 111
85sub new { 112sub add { $_[0]->{child} = $_[1] }
86 my ($class, $x, $y, $z, $ttf, $text) = @_; 113sub get { $_[0]->{child} }
87 114
88 my $self = $class->SUPER::new (x => $x, y => $y, z => $z); 115sub size_request { $_[0]->{child}->size_request if $_[0]->{child} }
89 116
90 $self->{texture} = new_from_ttf Crossfire::Client::Texture $ttf, $text; 117sub _draw { die "Containers can't be drawn!" }
91 118
92 $self 119package Crossfire::Client::Widget::Window;
93}
94 120
95sub _draw { 121our @ISA = Crossfire::Client::Widget::Container::;
122
123use SDL::OpenGL;
124
125sub add {
96 my ($self) = @_; 126 my ($self, $chld) = @_;
127 $self->SUPER::add ($chld);
128 $self->render_chld;
129}
97 130
131sub 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
146sub size_request {
147 my ($self) = @_;
148 my $chld = $self->get
149 or return (0, 0);
150 $chld->size_request
151}
152
153sub _draw {
154 my ($self) = @_;
155
98 my $tex = $self->{texture}; 156 my $tex = $self->{texture}
157 or return;
99 158
100 $self->{x}--; 159 warn "DRAW TEX: $tex->{width} $tex->{height}\n";
101
102 glEnable GL_BLEND; 160 glEnable GL_BLEND;
103 glEnable GL_TEXTURE_2D; 161 glEnable GL_TEXTURE_2D;
104 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 162 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
105 glBindTexture GL_TEXTURE_2D, $tex->{name}; 163 glBindTexture GL_TEXTURE_2D, $tex->{name};
106 164
… …
115 173
116 glDisable GL_BLEND; 174 glDisable GL_BLEND;
117 glDisable GL_TEXTURE_2D; 175 glDisable GL_TEXTURE_2D;
118} 176}
119 177
178package Crossfire::Client::Widget::Frame;
179
180our @ISA = Crossfire::Client::Widget::Container::;
181
182use SDL::OpenGL;
183
184sub size_request {
185 my ($self) = @_;
186 my $chld = $self->get
187 or return (0, 0);
188 map { $_ + 4 } $chld->size_request;
189}
190
191sub _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
212package Crossfire::Client::Widget::Table;
213
214our @ISA = Crossfire::Client::Widget::Container::;
215
216use SDL::OpenGL;
217
218sub add {
219 my ($self, $x, $y, $chld) = @_;
220 $self->{childs}[$y][$x] = $chld;
221}
222
223sub 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
237sub 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
251sub 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
271sub _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
293package Crossfire::Client::Widget::VBox;
294
295our @ISA = Crossfire::Client::Widget::Container::;
296
297use SDL::OpenGL;
298
299sub add {
300 my ($self, $chld) = @_;
301 push @{$self->{childs}}, $chld;
302}
303
304sub 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
317sub _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
331package Crossfire::Client::Widget::Label;
332
333our @ISA = Crossfire::Client::Widget::;
334
335use SDL::OpenGL;
336
337sub 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
347sub set_text {
348 my ($self, $text) = @_;
349 $self->{texture} = new_from_ttf Crossfire::Client::Texture $self->{ttf}, $self->{text} = $text;
350}
351
352sub get_text {
353 my ($self, $text) = @_;
354 $self->{text}
355}
356
357sub size_request {
358 my ($self) = @_;
359
360 (
361 $self->{texture}{width},
362 $self->{texture}{height},
363 )
364}
365
366sub _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
120package Crossfire::Client::Widget::TextView; 389package Crossfire::Client::Widget::TextView;
121 390
122use strict; 391use strict;
123 392
124our @ISA = qw/Crossfire::Client::Widget/; 393our @ISA = qw/Crossfire::Client::Widget/;
… …
140 409
141use strict; 410use strict;
142 411
143our @ISA = qw/Crossfire::Client::Widget/; 412our @ISA = qw/Crossfire::Client::Widget/;
144 413
414use SDL;
145use SDL::OpenGL; 415use SDL::OpenGL;
146use SDL::OpenGL::Constants; 416use SDL::OpenGL::Constants;
147 417
148sub key_down { 418sub key_down {
149 print "MAPKEYDOWN\n"; 419 print "MAPKEYDOWN\n";
… …
171 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) { 441 for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
172 my $tex = $::CONN->{face}[$num]{texture} || next; 442 my $tex = $::CONN->{face}[$num]{texture} || next;
173 443
174 glBindTexture GL_TEXTURE_2D, $tex->{name}; 444 glBindTexture GL_TEXTURE_2D, $tex->{name};
175 445
446 my $w = $tex->{width};
447 my $h = $tex->{height};
448
449 my $px = ($x + 1) * 32 - $w;
450 my $py = ($y + 1) * 32 - $h;
451
176 glBegin GL_QUADS; 452 glBegin GL_QUADS;
177 glTexCoord 0, 0; glVertex $x * 32 , $y * 32; 453 glTexCoord 0, 0; glVertex $px , $py;
178 glTexCoord 0, 1; glVertex $x * 32 , $y * 32 + 32; 454 glTexCoord 0, 1; glVertex $px , $py + $h;
179 glTexCoord 1, 1; glVertex $x * 32 + 32, $y * 32 + 32; 455 glTexCoord 1, 1; glVertex $px + $w, $py + $h;
180 glTexCoord 1, 0; glVertex $x * 32 + 32, $y * 32; 456 glTexCoord 1, 0; glVertex $px + $w, $py;
181 glEnd; 457 glEnd;
182 } 458 }
183 } 459 }
184 } 460 }
185 461
186 glDisable GL_TEXTURE_2D; 462 glDisable GL_TEXTURE_2D;
187 glDisable GL_BLEND; 463 glDisable GL_BLEND;
188} 464}
189 465
466my %DIR = (
467 SDLK_KP8, [1, "north"],
468 SDLK_KP9, [2, "northeast"],
469 SDLK_KP6, [3, "east"],
470 SDLK_KP3, [4, "southeast"],
471 SDLK_KP2, [5, "south"],
472 SDLK_KP1, [6, "southwest"],
473 SDLK_KP4, [7, "west"],
474 SDLK_KP7, [8, "northwest"],
475
476 SDLK_UP, [1, "north"],
477 SDLK_RIGHT, [3, "east"],
478 SDLK_DOWN, [5, "south"],
479 SDLK_LEFT, [7, "west"],
480);
481
482sub key_down {
483 my ($self, $ev) = @_;
484
485 my $mod = $ev->key_mod;
486 my $sym = $ev->key_sym;
487
488 if ($sym == SDLK_KP5) {
489 $::CONN->send ("command stay fire");
490 } elsif (exists $DIR{$sym}) {
491 if ($mod & KMOD_SHIFT) {
492 $self->{shft}++;
493 $::CONN->send ("command fire $DIR{$sym}[0]");
494 } elsif ($mod & KMOD_CTRL) {
495 $self->{ctrl}++;
496 $::CONN->send ("command run $DIR{$sym}[0]");
497 } else {
498 $::CONN->send ("command $DIR{$sym}[1]");
499 }
500 }
501}
502
503sub key_up {
504 my ($self, $ev) = @_;
505
506 my $mod = $ev->key_mod;
507 my $sym = $ev->key_sym;
508
509 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
510 $::CONN->send ("command fire_stop");
511 }
512 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
513 $::CONN->send ("command run_stop");
514 }
515}
516
1901; 5171;
191 518

Diff Legend

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