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.69 by root, Tue Apr 11 17:32:14 2006 UTC vs.
Revision 1.95 by root, Thu Apr 13 23:31:43 2006 UTC

1package CFClient::Widget; 1package CFClient::UI;
2 2
3use strict; 3use strict;
4 4
5use Scalar::Util; 5use Scalar::Util ();
6 6use List::Util ();
7use SDL::OpenGL;
8use SDL::OpenGL::Constants;
9 7
10use CFClient; 8use CFClient;
11 9
12our ($FOCUS, $HOVER, $GRAB); # various widgets 10our ($FOCUS, $HOVER, $GRAB); # various widgets
13 11
… …
45 43
46 my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y); 44 my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y);
47 45
48 $BUTTON_STATE &= ~(1 << ($ev->button - 1)); 46 $BUTTON_STATE &= ~(1 << ($ev->button - 1));
49 47
50 $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB; 48 $GRAB->button_up ($ev, $GRAB->translate ($x, $y)) if $GRAB;
51 49
52 if (!$BUTTON_STATE) { 50 if (!$BUTTON_STATE) {
53 my $grab = $GRAB; undef $GRAB; 51 my $grab = $GRAB; undef $GRAB;
54 $grab->update if $grab; 52 $grab->update if $grab;
55 $GRAB->update if $GRAB; 53 $GRAB->update if $GRAB;
… …
70 } 68 }
71 69
72 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER; 70 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
73} 71}
74 72
73#############################################################################
74
75package CFClient::UI::Base;
76
77use strict;
78
79use SDL::OpenGL;
80
75sub new { 81sub new {
76 my $class = shift; 82 my $class = shift;
77 83
78 bless { 84 my $self = bless {
79 x => 0, 85 x => 0,
80 y => 0, 86 y => 0,
81 z => 0, 87 z => 0,
88 w => -1,
89 h => -1,
82 @_ 90 @_
83 }, $class 91 }, $class;
92
93 for (keys %$self) {
94 if (/^connect_(.*)$/) {
95 $self->connect ($1 => delete $self->{$_});
96 }
97 }
98
99 $self
84} 100}
85 101
86sub move { 102sub move {
87 my ($self, $x, $y, $z) = @_; 103 my ($self, $x, $y, $z) = @_;
88 $self->{x} = $x; 104 $self->{x} = $x;
… …
97sub size_request { 113sub size_request {
98 require Carp; 114 require Carp;
99 Carp::confess "size_request is abtract"; 115 Carp::confess "size_request is abtract";
100} 116}
101 117
102sub size_allocate { 118sub _size_allocate {
103 my ($self, $w, $h) = @_; 119 my ($self, $x, $y, $w, $h) = @_;
120
121 $self->{x} = $x;
122 $self->{y} = $y;
123
124 return unless $self->{w} != $w || $self->{h} != $h;
104 125
105 $self->{w} = $w; 126 $self->{w} = $w;
106 $self->{h} = $h; 127 $self->{h} = $h;
107}
108 128
129 1
130}
131
132sub size_allocate {
133 my ($self, $x, $y, $w, $h) = @_;
134
135 $self->_size_allocate ($x, $y, $w, $h);
136}
137
109# translate global koordinates to local coordinate system 138# translate global coordinates to local coordinate system
110sub translate { 139sub translate {
111 my ($self, $x, $y) = @_; 140 my ($self, $x, $y) = @_;
112 141
113 $self->{parent}->translate ($x - $self->{x}, $y - $self->{y}); 142 $self->{parent}->translate ($x - $self->{x}, $y - $self->{y});
114} 143}
… …
155 return unless $self->{h} && $self->{w}; 184 return unless $self->{h} && $self->{w};
156 185
157 glPushMatrix; 186 glPushMatrix;
158 glTranslate $self->{x}, $self->{y}, 0; 187 glTranslate $self->{x}, $self->{y}, 0;
159 $self->_draw; 188 $self->_draw;
189 glPopMatrix;
190
160 if ($self == $HOVER) { 191 if ($self == $HOVER) {
161 glColor 1, 1, 1, 0.4; 192 my ($x, $y) = @$self{qw(x y)};
193
194 glColor 0, 0, 1, 0.2;
162 glEnable GL_BLEND; 195 glEnable GL_BLEND;
196 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
163 glBegin GL_QUADS; 197 glBegin GL_QUADS;
164 glVertex 0 , 0; 198 glVertex $x , $y;
165 glVertex $self->{w}, 0; 199 glVertex $x + $self->{w}, $y;
166 glVertex $self->{w}, $self->{h}; 200 glVertex $x + $self->{w}, $y + $self->{h};
167 glVertex 0 , $self->{h}; 201 glVertex $x , $y + $self->{h};
168 glEnd; 202 glEnd;
169 glDisable GL_BLEND; 203 glDisable GL_BLEND;
170 } 204 }
171 glPopMatrix;
172} 205}
173 206
174sub _draw { 207sub _draw {
175 my ($self) = @_; 208 my ($self) = @_;
176 209
177 warn "no draw defined for $self\n"; 210 warn "no draw defined for $self\n";
178}
179
180sub bbox {
181 my ($self) = @_;
182 my ($w, $h) = $self->size_request;
183 (
184 $self->{x},
185 $self->{y},
186 $self->{x} = $w,
187 $self->{y} = $h
188 )
189} 211}
190 212
191sub find_widget { 213sub find_widget {
192 my ($self, $x, $y) = @_; 214 my ($self, $x, $y) = @_;
193 215
… …
196 && $y >= $self->{y} && $y < $self->{y} + $self->{h}; 218 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
197 219
198 () 220 ()
199} 221}
200 222
201sub del_parent { $_[0]->{parent} = undef }
202
203sub set_parent { 223sub set_parent {
204 my ($self, $par) = @_; 224 my ($self, $par) = @_;
205 225
206 $self->{parent} = $par; 226 $self->{parent} = $par;
207 Scalar::Util::weaken $self->{parent}; 227 Scalar::Util::weaken $self->{parent};
… …
216 236
217 $self->{parent}->update 237 $self->{parent}->update
218 if $self->{parent}; 238 if $self->{parent};
219} 239}
220 240
241sub connect {
242 my ($self, $signal, $cb) = @_;
243
244 push @{ $self->{cb}{$signal} }, $cb;
245}
246
247sub emit {
248 my ($self, $signal, @args) = @_;
249
250 $_->($self, @args)
251 for @{$self->{cb}{$signal} || []};
252}
253
221sub DESTROY { 254sub DESTROY {
222 my ($self) = @_; 255 my ($self) = @_;
223 256
224 #$self->deactivate; 257 #$self->deactivate;
225} 258}
226 259
227############################################################################# 260#############################################################################
228 261
229package CFClient::Widget::DrawBG; 262package CFClient::UI::DrawBG;
230 263
231our @ISA = CFClient::Widget::; 264our @ISA = CFClient::UI::Base::;
232 265
233use strict; 266use strict;
234use SDL::OpenGL; 267use SDL::OpenGL;
235 268
236sub new { 269sub new {
237 my $class = shift; 270 my $class = shift;
238 271
239 # range [value, low, high, page] 272 # range [value, low, high, page]
240 273
241 $class->SUPER::new ( 274 $class->SUPER::new (
242 bg => [0, 0, 0, 0.4], 275 bg => [0, 0, 0, 0.2],
243 active_bg => [1, 1, 1], 276 active_bg => [1, 1, 1, 0.5],
244 @_ 277 @_
245 ) 278 )
246} 279}
247 280
248sub _draw { 281sub _draw {
249 my ($self) = @_; 282 my ($self) = @_;
250 283
251 my ($w, $h) = @$self{qw(w h)}; 284 my ($w, $h) = @$self{qw(w h)};
252 285
286 glEnable GL_BLEND;
287 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
253 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} }; 288 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
289
254 glBegin GL_QUADS; 290 glBegin GL_QUADS;
255 glVertex 0 , 0; 291 glVertex 0 , 0;
256 glVertex 0 , $h; 292 glVertex 0 , $h;
257 glVertex $w, $h; 293 glVertex $w, $h;
258 glVertex $w, 0; 294 glVertex $w, 0;
259 glEnd; 295 glEnd;
260}
261 296
262############################################################################# 297 glDisable GL_BLEND;
298}
263 299
300#############################################################################
301
264package CFClient::Widget::Empty; 302package CFClient::UI::Empty;
265 303
266our @ISA = CFClient::Widget::; 304our @ISA = CFClient::UI::Base::;
267 305
268sub size_request { 306sub size_request {
269 (0, 0) 307 (0, 0)
270} 308}
271 309
272sub draw { } 310sub draw { }
273 311
274############################################################################# 312#############################################################################
275 313
276package CFClient::Widget::Container; 314package CFClient::UI::Container;
277 315
278our @ISA = CFClient::Widget::; 316our @ISA = CFClient::UI::Base::;
279 317
280sub new { 318sub new {
281 my ($class, %arg) = @_; 319 my ($class, %arg) = @_;
282 320
283 my $children = delete $arg{children} || []; 321 my $children = delete $arg{children} || [];
… …
287 325
288 $self 326 $self
289} 327}
290 328
291sub add { 329sub add {
292 my ($self, $chld, $expand) = @_; 330 my ($self, $chld) = @_;
293 331
294 $chld->{expand} = $expand;
295 $chld->set_parent ($self); 332 $chld->set_parent ($self);
296 333
297 $self->{children} = [ 334 $self->{children} = [
298 sort { $a->{z} <=> $b->{z} } 335 sort { $a->{z} <=> $b->{z} }
299 @{$self->{children}}, $chld 336 @{$self->{children}}, $chld
300 ]; 337 ];
301 338
302 $self->size_allocate ($self->{w}, $self->{h}) 339 $self->{w} = $self->{h} = -1;
303 if $self->{w}; #TODO: check for "realised state" 340 $self->update;
304} 341}
305 342
306sub remove { 343sub remove {
307 my ($self, $widget) = @_; 344 my ($self, $widget) = @_;
308 345
309 $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ]; 346 $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
310 347
311 $self->size_allocate ($self->{w}, $self->{h}); 348 $self->size_allocate (0, 0, $self->{w}, $self->{h});
312} 349}
313 350
314sub find_widget { 351sub find_widget {
315 my ($self, $x, $y) = @_; 352 my ($self, $x, $y) = @_;
316 353
… …
333 $_->draw for @{$self->{children}}; 370 $_->draw for @{$self->{children}};
334} 371}
335 372
336############################################################################# 373#############################################################################
337 374
338package CFClient::Widget::Bin; 375package CFClient::UI::Bin;
339 376
340our @ISA = CFClient::Widget::Container::; 377our @ISA = CFClient::UI::Container::;
341 378
342sub new { 379sub new {
343 my ($class, %arg) = @_; 380 my ($class, %arg) = @_;
344 381
345 my $child = (delete $arg{child}) || new CFClient::Widget::Empty::; 382 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
346 383
347 $class->SUPER::new (children => [$child], %arg) 384 $class->SUPER::new (children => [$child], %arg)
348} 385}
349 386
350sub add { 387sub add {
… …
358sub remove { 395sub remove {
359 my ($self, $widget) = @_; 396 my ($self, $widget) = @_;
360 397
361 $self->SUPER::remove ($widget); 398 $self->SUPER::remove ($widget);
362 399
363 $self->{children} = [new CFClient::Widget::Empty] 400 $self->{children} = [new CFClient::UI::Empty]
364 unless @{$self->{children}}; 401 unless @{$self->{children}};
365} 402}
366 403
367sub child { $_[0]->{children}[0] } 404sub child { $_[0]->{children}[0] }
368 405
369sub size_request { 406sub size_request {
370 $_[0]{children}[0]->size_request 407 $_[0]{children}[0]->size_request
371} 408}
372 409
373sub size_allocate { 410sub size_allocate {
374 my ($self, $w, $h) = @_; 411 my ($self, $x, $y, $w, $h) = @_;
375 412
376 return unless $self->{w} != $w || $self->{h} != $h; 413 $self->_size_allocate ($x, $y, $w, $h) or return;
377 414
378 $self->SUPER::size_allocate ($w, $h);
379 $self->{children}[0]->size_allocate ($w, $h); 415 $self->{children}[0]->size_allocate (0, 0, $w, $h);
380} 416}
381 417
382############################################################################# 418#############################################################################
383 419
384package CFClient::Widget::Window; 420package CFClient::UI::Window;
385 421
386our @ISA = CFClient::Widget::Bin::; 422our @ISA = CFClient::UI::Bin::;
387 423
388use SDL::OpenGL; 424use SDL::OpenGL;
389 425
390sub new { 426sub new {
391 my ($class, %arg) = @_; 427 my ($class, %arg) = @_;
… …
409 $self->{w}, $self->{h}, sub { $self->child->draw } 445 $self->{w}, $self->{h}, sub { $self->child->draw }
410 ); 446 );
411} 447}
412 448
413sub size_allocate { 449sub size_allocate {
414 my ($self, $w, $h) = @_; 450 my ($self, $x, $y, $w, $h) = @_;
415 451
416 return unless $self->{w} != $w || $self->{h} != $h; 452 $self->_size_allocate ($x, $y, $w, $h) or return;
417 453
418 $self->{w} = $w;
419 $self->{h} = $h;
420
421 $self->child->size_allocate ($w, $h); 454 $self->child->size_allocate (0, 0, $w, $h);
422 455
423 $self->render_chld; 456 $self->render_chld;
424} 457}
425 458
426sub _draw { 459sub _draw {
… …
430 463
431 my $tex = $self->{texture} 464 my $tex = $self->{texture}
432 or return; 465 or return;
433 466
434 glEnable GL_BLEND; 467 glEnable GL_BLEND;
468 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
435 glEnable GL_TEXTURE_2D; 469 glEnable GL_TEXTURE_2D;
436 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 470 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
437 471
438 $tex->draw_quad (0, 0, $w, $h); 472 $tex->draw_quad (0, 0, $w, $h);
439 473
… …
441 glDisable GL_TEXTURE_2D; 475 glDisable GL_TEXTURE_2D;
442} 476}
443 477
444############################################################################# 478#############################################################################
445 479
446package CFClient::Widget::Frame; 480package CFClient::UI::Frame;
447 481
448our @ISA = CFClient::Widget::Bin::; 482our @ISA = CFClient::UI::Bin::;
449 483
450use SDL::OpenGL; 484use SDL::OpenGL;
451 485
452sub size_request { 486sub size_request {
453 my ($self) = @_; 487 my ($self) = @_;
… …
458 492
459 map { $_ + 4 } $chld->size_request; 493 map { $_ + 4 } $chld->size_request;
460} 494}
461 495
462sub size_allocate { 496sub size_allocate {
463 my ($self, $w, $h) = @_; 497 my ($self, $x, $y, $w, $h) = @_;
464 498
465 return unless $self->{w} != $w || $self->{h} != $h; 499 $self->_size_allocate ($x, $y, $w, $h) or return;
466 500
467 $self->{w} = $w;
468 $self->{h} = $h;
469
470 $self->child->size_allocate ($w - 4, $h - 4); 501 $self->child->size_allocate (2, 2, $w - 4, $h - 4);
471 $self->child->move (2, 2);
472} 502}
473 503
474sub _draw { 504sub _draw {
475 my ($self) = @_; 505 my ($self) = @_;
476 506
… …
489 $chld->draw; 519 $chld->draw;
490} 520}
491 521
492############################################################################# 522#############################################################################
493 523
494package CFClient::Widget::FancyFrame; 524package CFClient::UI::FancyFrame;
495 525
496our @ISA = CFClient::Widget::Bin::; 526our @ISA = CFClient::UI::Bin::;
497 527
498use SDL::OpenGL; 528use SDL::OpenGL;
499 529
500my @tex = 530my @tex =
501 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 531 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
502 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 532 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
503 533
504sub size_request { 534sub size_request {
505 my ($self) = @_; 535 my ($self) = @_;
506 536
537 return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
538
507 my ($w, $h) = $self->SUPER::size_request; 539 my ($w, $h) = $self->SUPER::size_request;
508 540
509 $h += $tex[1]->{height}; 541 $h += $tex[1]->{h};
510 $h += $tex[4]->{height}; 542 $h += $tex[4]->{h};
511 $w += $tex[2]->{width}; 543 $w += $tex[2]->{w};
512 $w += $tex[3]->{width}; 544 $w += $tex[3]->{w};
513 545
514 ($w, $h) 546 ($w, $h)
515} 547}
516 548
517sub size_allocate { 549sub size_allocate {
518 my ($self, $w, $h) = @_; 550 my ($self, $x, $y, $w, $h) = @_;
519 551
520 return unless $self->{w} != $w || $self->{h} != $h; 552 $self->_size_allocate ($x, $y, $w, $h) or return;
521 553
522 $self->SUPER::size_allocate ($w, $h);
523
524 $h -= $tex[1]->{height}; 554 $h -= $tex[1]{h};
525 $h -= $tex[4]->{height}; 555 $h -= $tex[4]{h};
526 $w -= $tex[2]->{width}; 556 $w -= $tex[2]{w};
527 $w -= $tex[3]->{width}; 557 $w -= $tex[3]{w};
528 558
529 $h = $h < 0 ? 0 : $h; 559 $h = $h < 0 ? 0 : $h;
530 $w = $w < 0 ? 0 : $w; 560 $w = $w < 0 ? 0 : $w;
531 561
532 my $child = $self->child; 562 my $child = $self->child;
533 563
534 $child->size_allocate ($w, $h); 564 $child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h);
535 $child->move ($tex[3]->{width}, $tex[1]->{height}); 565}
566
567sub button_down {
568 my ($self, $ev, $x, $y) = @_;
569
570 if ($x < $self->{w} && $x >= $self->{w} - $tex[2]{w}
571 && $y < $self->{h} && $y >= $self->{h} - $tex[4]{h}) {
572
573 my ($ox, $oy) = ($ev->button_x, $ev->button_y);
574 my ($bw, $bh) = ($self->{w}, $self->{h});
575
576 $self->{motion} = sub {
577 my ($ev, $x, $y) = @_;
578
579 ($x, $y) = ($ev->motion_x, $ev->motion_y);
580
581 $self->{user_w} = $bw + $x - $ox;
582 $self->{user_h} = $bh + $y - $oy;
583 $self->update;
584 };
585
586 } elsif ($x >= 0 && $x < $self->{w}
587 && $y >= 0 && $y < $tex[1]{h}) {
588
589 my ($ox, $oy) = ($ev->button_x, $ev->button_y);
590 my ($bx, $by) = ($self->{x}, $self->{y});
591
592 $self->{motion} = sub {
593 my ($ev, $x, $y) = @_;
594
595 ($x, $y) = ($ev->motion_x, $ev->motion_y);
596
597 $self->move ($bx + $x - $ox, $by + $y - $oy);
598 $self->update;
599 };
600 }
601}
602
603sub button_up {
604 my ($self, $ev, $x, $y) = @_;
605
606 delete $self->{motion};
607}
608
609sub mouse_motion {
610 my ($self, $ev, $x, $y) = @_;
611
612 $self->{motion}->($ev, $x, $y) if $self->{motion};
536} 613}
537 614
538sub _draw { 615sub _draw {
539 my ($self) = @_; 616 my ($self) = @_;
540 617
541 my ($w, $h) = ($self->{w}, $self->{h}); 618 my ($w, $h) = ($self->{w}, $self->{h});
542 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 619 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
543 620
544 glEnable GL_BLEND; 621 glEnable GL_BLEND;
622 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
545 glEnable GL_TEXTURE_2D; 623 glEnable GL_TEXTURE_2D;
546 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
547 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 624 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
548 625
549 my $top = $tex[1]; 626 my $top = $tex[1];
550 $top->draw_quad (0, 0, $w, $top->{height}); 627 $top->draw_quad (0, 0, $w, $top->{h});
551 628
552 my $left = $tex[3]; 629 my $left = $tex[3];
553 $left->draw_quad (0, $top->{height}, $left->{width}, $ch); 630 $left->draw_quad (0, $top->{h}, $left->{w}, $ch);
554 631
555 my $right = $tex[2]; 632 my $right = $tex[2];
556 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch); 633 $right->draw_quad ($w - $right->{w}, $top->{h}, $right->{w}, $ch);
557 634
558 my $bottom = $tex[4]; 635 my $bottom = $tex[4];
559 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height}); 636 $bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
560 637
561 my $bg = $tex[0]; 638 my $bg = $tex[0];
639
562 glBindTexture GL_TEXTURE_2D, $bg->{name}; 640 glBindTexture GL_TEXTURE_2D, $bg->{name};
563 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 641 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
564 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
565 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
566 642
567 my $rep_x = $cw / $bg->{width}; 643 my $rep_x = $cw / $bg->{w};
568 my $rep_y = $ch / $bg->{height}; 644 my $rep_y = $ch / $bg->{h};
569 645
570 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch); 646 $bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
571 647
648 glDisable GL_TEXTURE_2D;
572 glDisable GL_BLEND; 649 glDisable GL_BLEND;
573 glDisable GL_TEXTURE_2D;
574 650
575 $self->child->draw; 651 $self->child->draw;
576 652
577} 653}
578 654
579############################################################################# 655#############################################################################
580 656
581package CFClient::Widget::Table; 657package CFClient::UI::Table;
582 658
583our @ISA = CFClient::Widget::Bin::; 659our @ISA = CFClient::UI::Base::;
660
661use List::Util qw(max sum);
584 662
585use SDL::OpenGL; 663use SDL::OpenGL;
664
665sub new {
666 my $class = shift;
667
668 $class->SUPER::new (
669 col_expand => [],
670 @_
671 )
672}
586 673
587sub add { 674sub add {
588 my ($self, $x, $y, $chld) = @_; 675 my ($self, $x, $y, $chld) = @_;
589 my $old_chld = $self->{children}[$y][$x];
590 676
591 $self->{children}[$y][$x] = $chld; 677 $self->{children}[$y][$x] = $chld;
592 $chld->set_parent ($self); 678 $chld->set_parent ($self);
679
680 $self->{w} = $self->{h} = -1;
593 $self->update; 681 $self->update;
594} 682}
595 683
596sub max_row_height { 684sub get_wh {
597 my ($self, $row) = @_; 685 my ($self) = @_;
598 686
599 my $hs = 0; 687 my (@w, @h);
600 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) { 688
689 for my $y (0 .. $#{$self->{children}}) {
601 my $c = $self->{children}->[$row]->[$xi]; 690 my $row = $self->{children}[$y]
602 if ($c) { 691 or next;
692
693 for my $x (0 .. $#$row) {
694 my $widget = $row->[$x]
695 or next;
603 my ($w, $h) = $c->size_request; 696 my ($w, $h) = $widget->size_request;
604 if ($hs < $h) { $hs = $h } 697
698 $w[$x] = max $w[$x], $w;
699 $h[$y] = max $h[$y], $h;
605 } 700 }
606 } 701 }
607 return $hs;
608}
609 702
610sub max_col_width { 703 (\@w, \@h)
704}
705
706sub size_request {
611 my ($self, $col) = @_; 707 my ($self) = @_;
612 708
709 my ($ws, $hs) = $self->get_wh;
710
711 (
712 (sum @$ws),
713 (sum @$hs),
714 )
715}
716
717sub size_allocate {
718 my ($self, $x, $y, $w, $h) = @_;
719
720 $self->_size_allocate ($x, $y, $w, $h) or return;
721
722 my ($ws, $hs) = $self->get_wh;
723
724 my $req_w = sum @$ws;
725 my $req_h = sum @$hs;
726
727 # TODO: nicer code && do row_expand
728 my @col_expand = @{$self->{col_expand}};
729 @col_expand = (1) x @$ws unless @col_expand;
730 my $col_expand = (sum @col_expand) || 1;
731
732 # linearly scale sizes
733 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
734 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
735
736 my $y;
737
738 for my $r (0 .. $#{$self->{children}}) {
739 my $row = $self->{children}[$r]
740 or next;
741
613 my $ws = 0; 742 my $x = 0;
614 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) { 743 my $row_h = $hs->[$r];
615 my $c = ($self->{children}->[$yi] || [])->[$col]; 744
616 if ($c) { 745 for my $c (0 .. $#$row) {
617 my ($w, $h) = $c->size_request; 746 my $col_w = $ws->[$c];
618 if ($ws < $w) { $ws = $w } 747
748 if (my $widget = $row->[$c]) {
749 $widget->size_allocate ($x, $y, $col_w, $row_h);
750 }
751
752 $x += $col_w;
619 } 753 }
754
755 $y += $row_h;
620 } 756 }
621 return $ws; 757
622} 758}
759
760sub find_widget {
761 my ($self, $x, $y) = @_;
762
763 $x -= $self->{x};
764 $y -= $self->{y};
765
766 my $res;
767
768 for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
769 $res = $_->find_widget ($x, $y)
770 and return $res;
771 }
772
773 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
774}
775
776sub _draw {
777 my ($self) = @_;
778
779 for (grep $_, @{$self->{children}}) {
780 $_->draw for grep $_, @$_;
781 }
782}
783
784#############################################################################
785
786package CFClient::UI::HBox;
787
788# TODO: wrap into common Box base class
789
790our @ISA = CFClient::UI::Container::;
623 791
624sub size_request { 792sub size_request {
625 my ($self) = @_; 793 my ($self) = @_;
626 794
795 my @alloc = map [$_->size_request], @{$self->{children}};
796
797 (
798 (List::Util::sum map $_->[0], @alloc),
799 (List::Util::max map $_->[1], @alloc),
800 )
801}
802
803sub size_allocate {
804 my ($self, $x, $y, $w, $h) = @_;
805
806 $self->_size_allocate ($x, $y, $w, $h);
807
627 my ($hs, $ws) = (0, 0); 808 ($h, $w) = ($w, $h);
628 809
629 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) { 810 my $children = $self->{children};
630 $hs += $self->max_row_height ($yi);
631 }
632 811
633 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) { 812 my @h = map +($_->size_request)[0], @$children;
634 my $wm = 0; 813
635 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) { 814 my $req_h = List::Util::sum @h;
636 $wm += $self->max_col_width ($xi) 815
816 if ($req_h > $h) {
817 # ah well, not enough space
818 $_ *= $h / $req_h for @h;
819 } else {
820 my $exp = List::Util::sum map $_->{expand}, @$children;
821 $exp ||= 1;
822
823 for (0 .. $#$children) {
824 my $child = $children->[$_];
825
826 my $alloc_h = $h[$_];
827 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
828 $h[$_] = $alloc_h;
637 } 829 }
638 if ($ws < $wm) { $ws = $wm }
639 } 830 }
640
641 return ($ws, $hs);
642}
643
644sub _draw {
645 my ($self) = @_;
646 831
647 my $y = 0; 832 my $y = 0;
648 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) { 833 for (0 .. $#$children) {
834 my $child = $children->[$_];
649 my $x = 0; 835 my $h = $h[$_];
836 $child->size_allocate ($y, 0, $h, $w);
650 837
651 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) { 838 $y += $h;
652
653 my $c = $self->{children}->[$yi]->[$xi];
654 if ($c) {
655 $c->move ($x, $y, 0); #TODO: Move to size_request
656 $c->draw if $c;
657 }
658
659 $x += $self->max_col_width ($xi);
660 }
661
662 $y += $self->max_row_height ($yi);
663 } 839 }
664} 840}
665 841
666############################################################################# 842#############################################################################
667 843
668package CFClient::Widget::VBox; 844package CFClient::UI::VBox;
669 845
846# TODO: wrap into common Box base class
847
670our @ISA = CFClient::Widget::Container::; 848our @ISA = CFClient::UI::Container::;
671
672use SDL::OpenGL;
673 849
674sub size_request { 850sub size_request {
675 my ($self) = @_; 851 my ($self) = @_;
676 852
677 my @alloc = map [$_->size_request], @{$self->{children}}; 853 my @alloc = map [$_->size_request], @{$self->{children}};
… …
681 (List::Util::sum map $_->[1], @alloc), 857 (List::Util::sum map $_->[1], @alloc),
682 ) 858 )
683} 859}
684 860
685sub size_allocate { 861sub size_allocate {
686 my ($self, $w, $h) = @_; 862 my ($self, $x, $y, $w, $h) = @_;
687 863
688 return unless $self->{w} != $w || $self->{h} != $h; 864 $self->_size_allocate ($x, $y, $w, $h);
689
690 $self->{w} = $w;
691 $self->{h} = $h;
692
693 return unless $self->{h};
694 865
695 my $children = $self->{children}; 866 my $children = $self->{children};
696 867
697 my @h = map +($_->size_request)[1], @$children; 868 my @h = map +($_->size_request)[1], @$children;
698 869
699 my $req_h = List::Util::sum @h; 870 my $req_h = List::Util::sum @h;
700 871
701 if ($req_h > $h) { 872 if ($req_h > $h) {
702 # ah well, not enough space 873 # ah well, not enough space
703 $_ = $h[$_] * $h / $req_h for @h; 874 $_ *= $h / $req_h for @h;
704 } else { 875 } else {
705 my @exp = grep $_->{expand}, @$children; 876 my $exp = List::Util::sum map $_->{expand}, @$children;
706 @exp = @$children unless @exp; 877 $exp ||= 1;
707 878
708 my %exp = map +($_ => 1), @exp;
709
710 for (0 .. $#$children) { 879 for (0 .. $#$children) {
711 my $child = $children->[$_]; 880 my $child = $children->[$_];
712 881
713 my $alloc_h = $h[$_]; 882 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
714 $alloc_h += ($h - $req_h) / @exp if $exp{$child};
715 $h[$_] = $alloc_h;
716 } 883 }
717 } 884 }
718 885
719 my $y = 0; 886 my $y = 0;
720 for (0 .. $#$children) { 887 for (0 .. $#$children) {
721 my $child = $children->[$_]; 888 my $child = $children->[$_];
722 my $h = $h[$_]; 889 my $h = $h[$_];
723 $child->move (0, $y);
724 $child->size_allocate ($w, $h); 890 $child->size_allocate (0, $y, $w, $h);
725 891
726 $y += $h; 892 $y += $h;
727 } 893 }
728} 894}
729 895
730############################################################################# 896#############################################################################
731 897
732package CFClient::Widget::Label; 898package CFClient::UI::Label;
733 899
734our @ISA = CFClient::Widget::; 900our @ISA = CFClient::UI::Base::;
735 901
736use SDL::OpenGL; 902use SDL::OpenGL;
737 903
738sub new { 904sub new {
739 my ($class, %arg) = @_; 905 my ($class, %arg) = @_;
740 906
741 my $self = $class->SUPER::new ( 907 my $self = $class->SUPER::new (
742 fg => [1, 1, 1], 908 fg => [1, 1, 1],
743 height => $::FONTSIZE, 909 height => $::FONTSIZE,
744 text => "", 910 text => "",
911 align => -1,
912 padding => 2,
745 layout => new CFClient::Layout, 913 layout => new CFClient::Layout,
746 %arg 914 %arg
747 ); 915 );
748 916
749 $self->set_text ($self->{text}); 917 $self->set_text ($self->{text});
750 918
… …
766 934
767 $self->{text} = $text; 935 $self->{text} = $text;
768 $self->{layout}->set_markup ($text); 936 $self->{layout}->set_markup ($text);
769 937
770 delete $self->{texture}; 938 delete $self->{texture};
939# $self->{w} = $self->{h} = -1;
771 $self->update; 940 $self->update;
772} 941}
773 942
774sub get_text { 943sub get_text {
775 my ($self, $text) = @_; 944 my ($self, $text) = @_;
… …
780sub size_request { 949sub size_request {
781 my ($self) = @_; 950 my ($self) = @_;
782 951
783 $self->{layout}->set_width; 952 $self->{layout}->set_width;
784 $self->{layout}->set_height ($self->{height}); 953 $self->{layout}->set_height ($self->{height});
785 $self->{layout}->size 954 my ($w, $h) = $self->{layout}->size;
786# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack 955
787# ( 956 (
788# $self->{texture}{width}, 957 $w + $self->{padding} * 2,
789# $self->{texture}{height}, 958 $h + $self->{padding} * 2,
790# ) 959 )
791# } else {
792# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
793#
794# ($w, $h)
795# }
796} 960}
797 961
798sub size_allocate { 962sub size_allocate {
799 my ($self, $w, $h) = @_; 963 my ($self, $x, $y, $w, $h) = @_;
800 964
801 return unless $self->{w} != $w || $self->{h} != $h; 965 $self->_size_allocate ($x, $y, $w, $h) or return;
802 966
803 $self->SUPER::size_allocate ($w, $h);
804 delete $self->{texture}; 967 delete $self->{texture};
805} 968}
806 969
807sub update { 970sub update {
808 my ($self) = @_; 971 my ($self) = @_;
… …
814sub _draw { 977sub _draw {
815 my ($self) = @_; 978 my ($self) = @_;
816 979
817 my $tex = $self->{texture} ||= do { 980 my $tex = $self->{texture} ||= do {
818 $self->{layout}->set_width ($self->{w}); 981 $self->{layout}->set_width ($self->{w});
982 $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
819 new_from_layout CFClient::Texture $self->{layout}; 983 new_from_layout CFClient::Texture $self->{layout}
820 }; 984 };
821 985
822 glEnable GL_BLEND; 986 glEnable GL_BLEND;
987 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
823 glEnable GL_TEXTURE_2D; 988 glEnable GL_TEXTURE_2D;
824 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
825 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 989 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
826 990
827 glColor @{$self->{fg}}; 991 glColor @{$self->{fg}};
828 992
993 my $x =
994 $self->{align} < 0 ? $self->{padding}
995 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
996 : ($self->{w} - $tex->{w}) * 0.5;
997
998 glTranslate $x, ($self->{h} - $tex->{h}) * 0.5, 0;
829 $tex->draw_quad (0, 0); 999 $tex->draw_quad (0, 0);
830 1000
1001 glDisable GL_TEXTURE_2D;
831 glDisable GL_BLEND; 1002 glDisable GL_BLEND;
832 glDisable GL_TEXTURE_2D;
833} 1003}
834 1004
835############################################################################# 1005#############################################################################
836 1006
837package CFClient::Widget::Entry; 1007package CFClient::UI::Entry;
838 1008
839our @ISA = CFClient::Widget::Label::; 1009our @ISA = CFClient::UI::Label::;
840 1010
841use SDL; 1011use SDL;
842use SDL::OpenGL; 1012use SDL::OpenGL;
843 1013
844sub new { 1014sub new {
845 my $class = shift; 1015 my $class = shift;
846 1016
847 $class->SUPER::new ( 1017 $class->SUPER::new (
848 fg => [1, 1, 1], 1018 fg => [1, 1, 1],
849 bg => [0, 0, 0, 0.4], 1019 bg => [0, 0, 0, 0.2],
850 active_bg => [1, 1, 1], 1020 active_bg => [1, 1, 1, 0.5],
851 active_fg => [0, 0, 0], 1021 active_fg => [0, 0, 0],
852 @_ 1022 @_
853 ) 1023 )
854} 1024}
855 1025
… …
858 1028
859 $self->{last_activity} = $::NOW; 1029 $self->{last_activity} = $::NOW;
860 1030
861 $self->{text} = $text; 1031 $self->{text} = $text;
862 $self->{layout}->set_width ($self->{w}); 1032 $self->{layout}->set_width ($self->{w});
1033 $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height});
1034
1035 $text =~ s/./*/g if $self->{hidden};
1036
863 $self->{layout}->set_markup ($self->escape_text ($text)); 1037 $self->{layout}->set_markup ($self->escape_text ($text) . " ");
864 1038
865 $text = substr $text, 0, $self->{cursor}; 1039 $text = substr $text, 0, $self->{cursor};
866 utf8::encode $text; 1040 utf8::encode $text;
867 1041
868 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text); 1042 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
… …
875 1049
876 ($w + 1, $h) # add 1 for cursor 1050 ($w + 1, $h) # add 1 for cursor
877} 1051}
878 1052
879sub size_allocate { 1053sub size_allocate {
880 my ($self, $w, $h) = @_; 1054 my ($self, $x, $y, $w, $h) = @_;
881 1055
882 return unless $self->{w} != $w || $self->{h} != $h;
883
884 $self->SUPER::size_allocate ($w, $h); 1056 $self->SUPER::size_allocate ($x, $y, $w, $h);
885 1057
886 $self->_set_text ($self->{text}); 1058 $self->_set_text ($self->{text});
887} 1059}
888 1060
889sub set_text { 1061sub set_text {
… …
910 substr $text, $self->{cursor}, 1, ""; 1082 substr $text, $self->{cursor}, 1, "";
911 } elsif ($sym == SDLK_LEFT) { 1083 } elsif ($sym == SDLK_LEFT) {
912 --$self->{cursor} if $self->{cursor}; 1084 --$self->{cursor} if $self->{cursor};
913 } elsif ($sym == SDLK_RIGHT) { 1085 } elsif ($sym == SDLK_RIGHT) {
914 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 1086 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1087 } elsif ($sym == SDLK_HOME) {
1088 $self->{cursor} = 0;
1089 } elsif ($sym == SDLK_END) {
1090 $self->{cursor} = length $text;
915 } elsif ($uni) { 1091 } elsif ($uni) {
916 substr $text, $self->{cursor}++, 0, chr $uni; 1092 substr $text, $self->{cursor}++, 0, chr $uni;
917 } 1093 }
918 1094
919 $self->_set_text ($text); 1095 $self->_set_text ($text);
… …
934 $self->SUPER::button_down ($ev, $x, $y); 1110 $self->SUPER::button_down ($ev, $x, $y);
935 1111
936 my $idx = $self->{layout}->xy_to_index ($x, $y); 1112 my $idx = $self->{layout}->xy_to_index ($x, $y);
937 1113
938 # byte-index to char-index 1114 # byte-index to char-index
939 my $text = $self->{layout}; 1115 my $text = $self->{text};
940 utf8::encode $text; 1116 utf8::encode $text;
941 $self->{cursor} = length substr $text, 0, $idx; 1117 $self->{cursor} = length substr $text, 0, $idx;
942 1118
943 $self->_set_text ($self->{text}); 1119 $self->_set_text ($self->{text});
944 $self->update; 1120 $self->update;
… …
959 $self->{fg} = $self->{active_fg}; 1135 $self->{fg} = $self->{active_fg};
960 } else { 1136 } else {
961 glColor @{$self->{bg}}; 1137 glColor @{$self->{bg}};
962 } 1138 }
963 1139
1140 glEnable GL_BLEND;
1141 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
964 glBegin GL_QUADS; 1142 glBegin GL_QUADS;
965 glVertex 0 , 0; 1143 glVertex 0 , 0;
966 glVertex 0 , $self->{h}; 1144 glVertex 0 , $self->{h};
967 glVertex $self->{w}, $self->{h}; 1145 glVertex $self->{w}, $self->{h};
968 glVertex $self->{w}, 0; 1146 glVertex $self->{w}, 0;
969 glEnd; 1147 glEnd;
1148 glDisable GL_BLEND;
970 1149
971 $self->SUPER::_draw; 1150 $self->SUPER::_draw;
972 1151
973 #TODO: force update every cursor change :( 1152 #TODO: force update every cursor change :(
974 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) { 1153 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
… …
980 } 1159 }
981} 1160}
982 1161
983############################################################################# 1162#############################################################################
984 1163
985package CFClient::Widget::Slider; 1164package CFClient::UI::Button;
986 1165
987use strict; 1166our @ISA = CFClient::UI::Label::;
988 1167
1168use SDL;
989use SDL::OpenGL; 1169use SDL::OpenGL;
990use SDL::OpenGL::Constants;
991 1170
992our @ISA = CFClient::Widget::DrawBG::; 1171my @tex =
993 1172 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
994sub size_request { 1173 qw(b1_button_active.png);
995 my ($self) = @_;
996
997 my $w = 20;
998 my $h = 10;
999
1000 $self->{vertical} ? ($h, $w) : ($w, $h)
1001}
1002 1174
1003sub new { 1175sub new {
1004 my $class = shift; 1176 my $class = shift;
1005 1177
1178 $class->SUPER::new (
1179 padding => 4,
1180 fg => [1, 1, 1],
1181 bg => [1, 1, 1, 0.2],
1182 active_fg => [1, 1, 0],
1183# active_bg => [0, 0, 0, 0.5],
1184# border_fg => [1, 1, 0],
1185 @_
1186 )
1187}
1188
1189sub button_up {
1190 my ($self, $ev, $x, $y) = @_;
1191
1192 if ($x >= 0 && $x < $self->{w}
1193 && $y >= 0 && $y < $self->{h}) {
1194 $self->emit ("activate");
1195 }
1196}
1197
1198sub _draw {
1199 my ($self) = @_;
1200
1201 local $self->{fg} = $self->{fg};
1202 my $tex = $tex[0];
1203
1204 glEnable GL_BLEND;
1205 glEnable GL_TEXTURE_2D;
1206 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1207
1208 if ($GRAB == $self) {
1209 $self->{fg} = $self->{active_fg};
1210 }
1211
1212 glBindTexture GL_TEXTURE_2D, $tex->{name};
1213 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1214
1215 $tex->draw_quad (0, 0, $self->{w}, $self->{h});
1216
1217 glDisable GL_TEXTURE_2D;
1218 glDisable GL_BLEND;
1219
1220 $self->SUPER::_draw;
1221}
1222
1223#############################################################################
1224
1225package CFClient::UI::CheckBox;
1226
1227our @ISA = CFClient::UI::DrawBG::;
1228
1229use SDL;
1230use SDL::OpenGL;
1231
1232sub new {
1233 my $class = shift;
1234
1235 $class->SUPER::new (
1236 padding => 2,
1237 fg => [1, 1, 1],
1238 active_fg => [1, 1, 0],
1239 state => 0,
1240 @_
1241 )
1242}
1243
1244sub size_request {
1245 my ($self) = @_;
1246
1247 ($self->{padding} * 2 + 6) x 2
1248}
1249
1250sub size_allocate {
1251 my ($self, $x, $y, $w, $h) = @_;
1252
1253 $self->_size_allocate ($x, $y, $w, $h);
1254}
1255
1256sub button_down {
1257 my ($self, $ev, $x, $y) = @_;
1258
1259 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
1260 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
1261 $self->{state} = !$self->{state};
1262 $self->emit (changed => $self->{state});
1263 }
1264}
1265
1266sub _draw {
1267 my ($self) = @_;
1268
1269 $self->SUPER::_draw;
1270
1271 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;
1272
1273 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1274
1275 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1276
1277 glBegin GL_LINE_LOOP;
1278 glVertex 0 , 0;
1279 glVertex 0 , $s;
1280 glVertex $s, $s;
1281 glVertex $s, 0;
1282 glEnd;
1283
1284 if ($self->{state}) {
1285 glBegin GL_LINES;
1286 glVertex 0 , 0;
1287 glVertex $s, $s;
1288 glVertex $s, 0;
1289 glVertex 0 , $s;
1290 glEnd;
1291 }
1292}
1293
1294#############################################################################
1295
1296package CFClient::UI::Slider;
1297
1298use strict;
1299
1300use SDL::OpenGL;
1301
1302our @ISA = CFClient::UI::DrawBG::;
1303
1304sub new {
1305 my $class = shift;
1306
1006 # range [value, low, high, page] 1307 # range [value, low, high, page]
1007 1308
1008 $class->SUPER::new ( 1309 my $self = $class->SUPER::new (
1009 fg => [1, 1, 1], 1310 fg => [1, 1, 1],
1010 active_fg => [0, 0, 0], 1311 active_fg => [0, 0, 0],
1011 range => [0, 0, 100, 10], 1312 range => [0, 0, 100, 10],
1313 req_w => 40,
1314 req_h => 10,
1012 vertical => 0, 1315 vertical => 0,
1013 @_ 1316 @_
1014 ) 1317 );
1318
1319 $self
1320}
1321
1322sub size_request {
1323 my ($self) = @_;
1324
1325 my $w = $self->{req_w};
1326 my $h = $self->{req_h};
1327
1328 $self->{vertical} ? ($h, $w) : ($w, $h)
1015} 1329}
1016 1330
1017sub button_down { 1331sub button_down {
1018 my ($self, $ev, $x, $y) = @_; 1332 my ($self, $ev, $x, $y) = @_;
1019 1333
… …
1025 my ($self, $ev, $x, $y) = @_; 1339 my ($self, $ev, $x, $y) = @_;
1026 1340
1027 if ($GRAB == $self) { 1341 if ($GRAB == $self) {
1028 my ($value, $lo, $hi, $page) = @{$self->{range}}; 1342 my ($value, $lo, $hi, $page) = @{$self->{range}};
1029 1343
1344 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
1345
1030 $x = $x * ($hi - $lo) / $self->{w} + $lo; 1346 $x = $x * ($hi - $lo) / $w + $lo;
1031 $x = $lo if $x < $lo; 1347 $x = $lo if $x < $lo;
1032 $x = $hi - $page if $x > $hi - $page; 1348 $x = $hi - $page if $x > $hi - $page;
1033 $self->{range}[0] = $x; 1349 $self->{range}[0] = $x;
1034 1350
1035 $self->{changed}($x) if $self->{changed}; 1351 $self->emit (changed => $x);
1036 $self->update; 1352 $self->update;
1037 } 1353 }
1038} 1354}
1039 1355
1040sub _draw { 1356sub _draw {
1041 my ($self) = @_; 1357 my ($self) = @_;
1042 1358
1043 $self->SUPER::_draw (); 1359 $self->SUPER::_draw ();
1044
1045 glPushMatrix;
1046 1360
1047 my ($w, $h) = @$self{qw(w h)}; 1361 my ($w, $h) = @$self{qw(w h)};
1048 1362
1049 if ($self->{vertical}) { 1363 if ($self->{vertical}) {
1050 # draw a vertical slider like a rotated horizontal slider 1364 # draw a vertical slider like a rotated horizontal slider
1051 1365
1052 glTranslate 0, $self->{w};
1053 glRotate 90, 0, 0, 1; 1366 glRotate 90, 0, 0, 1;
1367 glTranslate 0, -$self->{w}, 0;
1054 1368
1055 ($w, $h) = ($h, $w); 1369 ($w, $h) = ($h, $w);
1056 } 1370 }
1057 1371
1058 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg}; 1372 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
… …
1064 $value = int +($value - $lo) * $w / ($hi - $lo); 1378 $value = int +($value - $lo) * $w / ($hi - $lo);
1065 1379
1066 $w -= $page; 1380 $w -= $page;
1067 $page &= ~1; 1381 $page &= ~1;
1068 glTranslate $page * 0.5, 0, 0; 1382 glTranslate $page * 0.5, 0, 0;
1383 $page ||= 2;
1069 1384
1070 glColor @$fg; 1385 glColor @$fg;
1071 glBegin GL_LINES; 1386 glBegin GL_LINES;
1072 glVertex 0, 0; glVertex 0, $h; 1387 glVertex 0, 0; glVertex 0, $h;
1073 glVertex $w - 1, 0; glVertex $w - 1, $h; 1388 glVertex $w - 1, 0; glVertex $w - 1, $h;
… …
1090 glVertex $knob_a + 1, $h - 1; 1405 glVertex $knob_a + 1, $h - 1;
1091 glVertex $knob_b - 1, $h - 1; 1406 glVertex $knob_b - 1, $h - 1;
1092 glVertex $knob_b - 1, 1; 1407 glVertex $knob_b - 1, 1;
1093 } 1408 }
1094 glEnd; 1409 glEnd;
1095
1096 glPopMatrix;
1097} 1410}
1098 1411
1099############################################################################# 1412#############################################################################
1100 1413
1101package CFClient::Widget::MapWidget; 1414package CFClient::UI::MapWidget;
1102 1415
1103use strict; 1416use strict;
1104 1417
1105use List::Util qw(min max); 1418use List::Util qw(min max);
1106 1419
1107use SDL; 1420use SDL;
1108use SDL::OpenGL; 1421use SDL::OpenGL;
1109use SDL::OpenGL::Constants;
1110 1422
1111our @ISA = CFClient::Widget::; 1423our @ISA = CFClient::UI::Base::;
1112 1424
1113sub new { 1425sub new {
1114 my $class = shift; 1426 my $class = shift;
1115 1427
1116 $class->SUPER::new ( 1428 $class->SUPER::new (
… …
1127sub key_up { 1439sub key_up {
1128} 1440}
1129 1441
1130sub size_request { 1442sub size_request {
1131 ( 1443 (
1132 1 + int $::WIDTH / 32, 1444 1 + 32 * int $::WIDTH / 32,
1133 1 + int $::HEIGHT / 32, 1445 1 + 32 * int $::HEIGHT / 32,
1134 ) 1446 )
1135} 1447}
1136 1448
1137sub update { 1449sub update {
1138 my ($self) = @_; 1450 my ($self) = @_;
1139 1451
1140 $self->{need_update} = 1; 1452 $self->{need_update} = 1;
1453 $self->SUPER::update;
1141} 1454}
1142 1455
1143sub _draw { 1456sub draw {
1144 my ($self) = @_; 1457 my ($self) = @_;
1145 1458
1459 $self->{need_update}++;#d#
1146 if (delete $self->{need_update}) { 1460 if (delete $self->{need_update}) {
1147 glNewList $self->{list}, GL_COMPILE; 1461 glNewList $self->{list}, GL_COMPILE;
1148 1462
1149 my $mx = $::CONN->{mapx};
1150 my $my = $::CONN->{mapy};
1151
1152 my $map = $::CONN->{map};
1153
1154 my ($xofs, $yofs);
1155
1156 my $sw = 1 + int $::WIDTH / 32; 1463 my $sw = int $::WIDTH / 32;
1157 my $sh = 1 + int $::HEIGHT / 32; 1464 my $sh = int $::HEIGHT / 32;
1158 1465
1159 if ($::CONN->{mapw} > $sw) { 1466 if ($::MAP) {
1160 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5; 1467 my ($w, $h, $data) = $::MAP->draw (0, 0, $sw, $sh);
1161 } else {
1162 $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
1163 }
1164 1468
1165 if ($::CONN->{maph} > $sh) { 1469 if ($::CFG->{fow_enable}) {
1166 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5; 1470 if ($::CFG->{fow_smooth}) { # smooth fog of war
1167 } else { 1471 glConvolutionParameter GL_CONVOLUTION_2D, GL_CONVOLUTION_BORDER_MODE, GL_CONSTANT_BORDER;
1168 $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs}; 1472 glConvolutionFilter2D
1169 } 1473 GL_CONVOLUTION_2D,
1170 1474 GL_ALPHA,
1171 glEnable GL_TEXTURE_2D; 1475 3, 3,
1172 glEnable GL_BLEND; 1476 GL_ALPHA, GL_FLOAT,
1173 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1477 pack "f*",
1174 1478 0.1, 0.1, 0.1,
1175 my $sw4 = ($sw + 3) & ~3; 1479 0.1, 0.2, 0.1,
1176 my $darkness = "\x00" x ($sw4 * $sh); 1480 0.1, 0.1, 0.1,
1177
1178 for my $x (0 .. $sw - 1) {
1179 my $row = $map->[$x + $xofs];
1180 for my $y (0 .. $sh - 1) {
1181
1182 my $cell = $row->[$y + $yofs]
1183 or next; 1481 ;
1184 1482 glEnable GL_CONVOLUTION_2D;
1185 my $dark = $cell->[0];
1186 if ($dark < 0) {
1187 substr $darkness, $y * $sw4 + $x, 1, chr 224;
1188 } else {
1189 substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
1190 } 1483 }
1191 1484
1192 for my $num (grep $_, @$cell[1,2,3]) { 1485 my $tex = new CFClient::Texture
1193 my $tex = $::CONN->{face}[$num]{texture} || next; 1486 w => $w,
1194 1487 h => $h,
1195 my $w = $tex->{width}; 1488 data => $data,
1196 my $h = $tex->{height}; 1489 internalformat => GL_ALPHA,
1490 format => GL_ALPHA;
1197 1491
1198 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h); 1492 glDisable GL_CONVOLUTION_2D if $::CFG->{fow_smooth};
1199 } 1493
1494 glEnable GL_BLEND;
1495 glEnable GL_TEXTURE_2D;
1496 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1497
1498 glColor +($::CFG->{fow_intensity}) x 3, 1;
1499 $tex->draw_quad (0, 0, $w * 32, $h * 32);
1500
1501 glDisable GL_TEXTURE_2D;
1502 glDisable GL_BLEND;
1200 } 1503 }
1201 } 1504 }
1202 1505
1203# if (1) { # higher quality darkness 1506 glEndList;
1204# $lighting =~ s/(.)/$1$1$1/gs;
1205# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
1206#
1207# $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
1208#
1209# $lighting = $pb->get_pixels;
1210# $lighting =~ s/(.)../$1/gs;
1211# } 1507 }
1212 1508
1213 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1509 glCallList $self->{list};
1214 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1215 1510
1216 $darkness = new CFClient::Texture 1511 if ($FOCUS != $self) {
1217 width => $sw4, 1512 glEnable GL_BLEND;
1218 height => $sh, 1513 glColor 0, 0, 1, 0.4;
1219 data => $darkness, 1514 glBegin GL_QUADS;
1220 internalformat => GL_ALPHA, 1515 glVertex 0, 0;
1221 format => GL_ALPHA; 1516 glVertex 0, $::HEIGHT;
1222 1517 glVertex $::WIDTH, $::HEIGHT;
1223 glColor 0.45, 0.45, 0.45, 1; 1518 glVertex $::WIDTH, 0;
1224 $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32); 1519 glEnd;
1225
1226 glDisable GL_TEXTURE_2D;
1227 glDisable GL_BLEND; 1520 glDisable GL_BLEND;
1228
1229 glEndList;
1230 } 1521 }
1231
1232 glCallList $self->{list};
1233} 1522}
1234 1523
1235my %DIR = ( 1524my %DIR = (
1236 SDLK_KP8, [1, "north"], 1525 SDLK_KP8, [1, "north"],
1237 SDLK_KP9, [2, "northeast"], 1526 SDLK_KP9, [2, "northeast"],
… …
1253 1542
1254 my $mod = $ev->key_mod; 1543 my $mod = $ev->key_mod;
1255 my $sym = $ev->key_sym; 1544 my $sym = $ev->key_sym;
1256 1545
1257 if ($sym == SDLK_KP5) { 1546 if ($sym == SDLK_KP5) {
1258 $::CONN->send ("command stay fire"); 1547 $::CONN->user_send ("command stay fire");
1548 } elsif ($sym == SDLK_a) {
1549 $::CONN->user_send ("command apply");
1259 } elsif (exists $DIR{$sym}) { 1550 } elsif (exists $DIR{$sym}) {
1260 if ($mod & KMOD_SHIFT) { 1551 if ($mod & KMOD_SHIFT) {
1261 $self->{shft}++; 1552 $self->{shft}++;
1262 $::CONN->send ("command fire $DIR{$sym}[0]"); 1553 $::CONN->user_send ("command fire $DIR{$sym}[0]");
1263 } elsif ($mod & KMOD_CTRL) { 1554 } elsif ($mod & KMOD_CTRL) {
1264 $self->{ctrl}++; 1555 $self->{ctrl}++;
1265 $::CONN->send ("command run $DIR{$sym}[0]"); 1556 $::CONN->user_send ("command run $DIR{$sym}[0]");
1266 } else { 1557 } else {
1267 $::CONN->send ("command $DIR{$sym}[1]"); 1558 $::CONN->user_send ("command $DIR{$sym}[1]");
1268 } 1559 }
1269 } 1560 }
1270} 1561}
1271 1562
1272sub key_up { 1563sub key_up {
… …
1274 1565
1275 my $mod = $ev->key_mod; 1566 my $mod = $ev->key_mod;
1276 my $sym = $ev->key_sym; 1567 my $sym = $ev->key_sym;
1277 1568
1278 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) { 1569 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
1279 $::CONN->send ("command fire_stop"); 1570 $::CONN->user_send ("command fire_stop");
1280 } 1571 }
1281 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) { 1572 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
1282 $::CONN->send ("command run_stop"); 1573 $::CONN->user_send ("command run_stop");
1283 } 1574 }
1284} 1575}
1285 1576
1286############################################################################# 1577#############################################################################
1287 1578
1288package CFClient::Widget::Animator; 1579package CFClient::UI::Animator;
1289 1580
1290use SDL::OpenGL; 1581use SDL::OpenGL;
1291 1582
1292our @ISA = CFClient::Widget::Bin::; 1583our @ISA = CFClient::UI::Bin::;
1293 1584
1294sub moveto { 1585sub moveto {
1295 my ($self, $x, $y) = @_; 1586 my ($self, $x, $y) = @_;
1296 1587
1297 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 1588 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
1325 glPopMatrix; 1616 glPopMatrix;
1326} 1617}
1327 1618
1328############################################################################# 1619#############################################################################
1329 1620
1330package CFClient::Widget::Toplevel; 1621package CFClient::UI::Toplevel;
1331 1622
1332our @ISA = CFClient::Widget::Container::; 1623our @ISA = CFClient::UI::Container::;
1333 1624
1334sub size_request { 1625sub size_request {
1335 ($::WIDTH, $::HEIGHT) 1626 ($::WIDTH, $::HEIGHT)
1336} 1627}
1337 1628
1338sub size_allocate { 1629sub size_allocate {
1339 my ($self, $w, $h) = @_; 1630 my ($self, $x, $y, $w, $h) = @_;
1340 1631
1341 $self->SUPER::size_allocate ($w, $h); 1632 $self->_size_allocate ($x, $y, $w, $h);
1342 1633
1343 $_->size_allocate ($_->size_request) 1634 $_->size_allocate ($_->{x}, $_->{y}, $_->size_request)
1344 for @{$self->{children}}; 1635 for @{$self->{children}};
1345} 1636}
1346 1637
1347sub translate { 1638sub translate {
1348 my ($self, $x, $y) = @_; 1639 my ($self, $x, $y) = @_;
… …
1351} 1642}
1352 1643
1353sub update { 1644sub update {
1354 my ($self) = @_; 1645 my ($self) = @_;
1355 1646
1356 $self->size_allocate ($self->size_request); 1647 $self->size_allocate (0, 0, $::WIDTH, $::HEIGHT);
1357 ::refresh (); 1648 ::refresh ();
1358} 1649}
1359 1650
1360sub add { 1651sub add {
1361 my ($self, $widget) = @_; 1652 my ($self, $widget) = @_;
1362 1653
1363 $self->SUPER::add ($widget); 1654 $self->SUPER::add ($widget);
1364 1655
1365 $widget->size_allocate ($widget->size_request); 1656 $widget->size_allocate ($widget->{x}, $widget->{y}, $widget->size_request);
1366} 1657}
1367 1658
1368sub draw { 1659sub draw {
1369 my ($self) = @_; 1660 my ($self) = @_;
1370 1661
1371 $self->_draw; 1662 $self->_draw;
1372} 1663}
1373 1664
1374############################################################################# 1665#############################################################################
1375 1666
1376package CFClient::Widget; 1667package CFClient::UI;
1377 1668
1378$TOPLEVEL = new CFClient::Widget::Toplevel; 1669$TOPLEVEL = new CFClient::UI::Toplevel;
1379 1670
13801 16711
1381 1672

Diff Legend

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