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.67 by root, Tue Apr 11 14:36:59 2006 UTC vs.
Revision 1.73 by root, Tue Apr 11 18:06:53 2006 UTC

1package CFClient::Widget; 1package CFClient::UI;
2 2
3use strict; 3use strict;
4 4
5use Scalar::Util; 5use Scalar::Util;
6
7use SDL::OpenGL;
8use SDL::OpenGL::Constants;
9 6
10use CFClient; 7use CFClient;
11 8
12our ($FOCUS, $HOVER, $GRAB); # various widgets 9our ($FOCUS, $HOVER, $GRAB); # various widgets
13 10
69 $HOVER->update if $HOVER; 66 $HOVER->update if $HOVER;
70 } 67 }
71 68
72 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER; 69 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER;
73} 70}
71
72#############################################################################
73
74package CFClient::UI::Base;
75
76use strict;
77
78use SDL::OpenGL;
74 79
75sub new { 80sub new {
76 my $class = shift; 81 my $class = shift;
77 82
78 bless { 83 bless {
114} 119}
115 120
116sub focus_in { 121sub focus_in {
117 my ($self) = @_; 122 my ($self) = @_;
118 123
124 return if $FOCUS == $self;
125
119 my $focus = $FOCUS; $FOCUS = $self; 126 my $focus = $FOCUS; $FOCUS = $self;
120 $focus->update if $focus; 127 $focus->update if $focus;
121 $FOCUS->update; 128 $FOCUS->update;
122} 129}
123 130
130 $focus->update if $focus; #? 137 $focus->update if $focus; #?
131} 138}
132 139
133sub mouse_motion { } 140sub mouse_motion { }
134sub button_up { } 141sub button_up { }
135sub button_down { }
136sub key_down { } 142sub key_down { }
137sub key_up { } 143sub key_up { }
144
145sub button_down {
146 my ($self, $ev, $x, $y) = @_;
147
148 $self->focus_in;
149}
138 150
139sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 151sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
140sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 152sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
141sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 153sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
142sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 154sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
143sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 155sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
144 156
145sub draw { 157sub draw {
146 my ($self) = @_; 158 my ($self) = @_;
147 159
160 return unless $self->{h} && $self->{w};
161
148 glPushMatrix; 162 glPushMatrix;
149 glTranslate $self->{x}, $self->{y}, 0; 163 glTranslate $self->{x}, $self->{y}, 0;
150 $self->_draw; 164 $self->_draw;
165 glPopMatrix;
166
151 if ($self == $HOVER) { 167 if ($self == $HOVER) {
168 my ($x, $y) = @$self{qw(x y)};
169
152 glColor 1, 1, 1, 0.4; 170 glColor 1, 1, 1, 0.1;
153 glEnable GL_BLEND; 171 glEnable GL_BLEND;
154 glBegin GL_QUADS; 172 glBegin GL_QUADS;
155 glVertex 0 , 0; 173 glVertex $x , $y;
156 glVertex $self->{w}, 0; 174 glVertex $x + $self->{w}, $y;
157 glVertex $self->{w}, $self->{h}; 175 glVertex $x + $self->{w}, $y + $self->{h};
158 glVertex 0 , $self->{h}; 176 glVertex $x , $y + $self->{h};
159 glEnd; 177 glEnd;
160 glDisable GL_BLEND; 178 glDisable GL_BLEND;
161 } 179 }
162 glPopMatrix;
163} 180}
164 181
165sub _draw { 182sub _draw {
166 my ($self) = @_; 183 my ($self) = @_;
167 184
207 224
208 $self->{parent}->update 225 $self->{parent}->update
209 if $self->{parent}; 226 if $self->{parent};
210} 227}
211 228
229sub connect {
230 my ($self, $signal, $cb) = @_;
231
232 push @{ $self->{cb}{$signal} }, $cb;
233}
234
235sub emit {
236 my ($self, $signal, @args) = @_;
237
238 $_->($self, @args)
239 for @{$self->{cb}{$signal} || []};
240}
241
212sub DESTROY { 242sub DESTROY {
213 my ($self) = @_; 243 my ($self) = @_;
214 244
215 #$self->deactivate; 245 #$self->deactivate;
216} 246}
217 247
218############################################################################# 248#############################################################################
219 249
250package CFClient::UI::DrawBG;
251
252our @ISA = CFClient::UI::Base::;
253
254use strict;
255use SDL::OpenGL;
256
257sub new {
258 my $class = shift;
259
260 # range [value, low, high, page]
261
262 $class->SUPER::new (
263 bg => [0, 0, 0, 0.4],
264 active_bg => [1, 1, 1],
265 @_
266 )
267}
268
269sub _draw {
270 my ($self) = @_;
271
272 my ($w, $h) = @$self{qw(w h)};
273
274 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
275 glBegin GL_QUADS;
276 glVertex 0 , 0;
277 glVertex 0 , $h;
278 glVertex $w, $h;
279 glVertex $w, 0;
280 glEnd;
281}
282
283#############################################################################
284
220package CFClient::Widget::Empty; 285package CFClient::UI::Empty;
221 286
222our @ISA = CFClient::Widget::; 287our @ISA = CFClient::UI::Base::;
223 288
224sub size_request { 289sub size_request {
225 (0, 0) 290 (0, 0)
226} 291}
227 292
228sub draw { } 293sub draw { }
229 294
230############################################################################# 295#############################################################################
231 296
232package CFClient::Widget::Container; 297package CFClient::UI::Container;
233 298
234our @ISA = CFClient::Widget::; 299our @ISA = CFClient::UI::Base::;
235 300
236sub new { 301sub new {
237 my ($class, %arg) = @_; 302 my ($class, %arg) = @_;
238 303
239 my $children = delete $arg{children} || []; 304 my $children = delete $arg{children} || [];
289 $_->draw for @{$self->{children}}; 354 $_->draw for @{$self->{children}};
290} 355}
291 356
292############################################################################# 357#############################################################################
293 358
294package CFClient::Widget::Bin; 359package CFClient::UI::Bin;
295 360
296our @ISA = CFClient::Widget::Container::; 361our @ISA = CFClient::UI::Container::;
297 362
298sub new { 363sub new {
299 my ($class, %arg) = @_; 364 my ($class, %arg) = @_;
300 365
301 my $child = (delete $arg{child}) || new CFClient::Widget::Empty::; 366 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
302 367
303 $class->SUPER::new (children => [$child], %arg) 368 $class->SUPER::new (children => [$child], %arg)
304} 369}
305 370
306sub add { 371sub add {
314sub remove { 379sub remove {
315 my ($self, $widget) = @_; 380 my ($self, $widget) = @_;
316 381
317 $self->SUPER::remove ($widget); 382 $self->SUPER::remove ($widget);
318 383
319 $self->{children} = [new CFClient::Widget::Empty] 384 $self->{children} = [new CFClient::UI::Empty]
320 unless @{$self->{children}}; 385 unless @{$self->{children}};
321} 386}
322 387
323sub child { $_[0]->{children}[0] } 388sub child { $_[0]->{children}[0] }
324 389
325sub size_request { 390sub size_request {
326 $_[0]{children}[0]->size_request if $_[0]{children}[0]; 391 $_[0]{children}[0]->size_request
327} 392}
328 393
329sub size_allocate { 394sub size_allocate {
330 my ($self, $w, $h) = @_; 395 my ($self, $w, $h) = @_;
331 396
397 return unless $self->{w} != $w || $self->{h} != $h;
398
332 $self->SUPER::size_allocate ($w, $h); 399 $self->SUPER::size_allocate ($w, $h);
333 $self->{children}[0]->size_allocate ($w, $h) 400 $self->{children}[0]->size_allocate ($w, $h);
334 if $self->{children}[0]
335} 401}
336 402
337############################################################################# 403#############################################################################
338 404
339package CFClient::Widget::Window; 405package CFClient::UI::Window;
340 406
341our @ISA = CFClient::Widget::Bin::; 407our @ISA = CFClient::UI::Bin::;
342 408
343use SDL::OpenGL; 409use SDL::OpenGL;
344 410
345sub new { 411sub new {
346 my ($class, %arg) = @_; 412 my ($class, %arg) = @_;
366} 432}
367 433
368sub size_allocate { 434sub size_allocate {
369 my ($self, $w, $h) = @_; 435 my ($self, $w, $h) = @_;
370 436
437 return unless $self->{w} != $w || $self->{h} != $h;
438
371 $self->{w} = $w; 439 $self->{w} = $w;
372 $self->{h} = $h; 440 $self->{h} = $h;
373 441
374 $self->child->size_allocate ($w, $h); 442 $self->child->size_allocate ($w, $h);
375 443
394 glDisable GL_TEXTURE_2D; 462 glDisable GL_TEXTURE_2D;
395} 463}
396 464
397############################################################################# 465#############################################################################
398 466
399package CFClient::Widget::Frame; 467package CFClient::UI::Frame;
400 468
401our @ISA = CFClient::Widget::Bin::; 469our @ISA = CFClient::UI::Bin::;
402 470
403use SDL::OpenGL; 471use SDL::OpenGL;
404 472
405sub size_request { 473sub size_request {
406 my ($self) = @_; 474 my ($self) = @_;
413} 481}
414 482
415sub size_allocate { 483sub size_allocate {
416 my ($self, $w, $h) = @_; 484 my ($self, $w, $h) = @_;
417 485
486 return unless $self->{w} != $w || $self->{h} != $h;
487
418 $self->{w} = $w; 488 $self->{w} = $w;
419 $self->{h} = $h; 489 $self->{h} = $h;
420 490
421 $self->child->size_allocate ($w - 4, $h - 4); 491 $self->child->size_allocate ($w - 4, $h - 4);
422 $self->child->move (2, 2); 492 $self->child->move (2, 2);
440 $chld->draw; 510 $chld->draw;
441} 511}
442 512
443############################################################################# 513#############################################################################
444 514
445package CFClient::Widget::FancyFrame; 515package CFClient::UI::FancyFrame;
446 516
447our @ISA = CFClient::Widget::Bin::; 517our @ISA = CFClient::UI::Bin::;
448 518
449use SDL::OpenGL; 519use SDL::OpenGL;
450 520
451my @tex = 521my @tex =
452 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 522 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
455sub size_request { 525sub size_request {
456 my ($self) = @_; 526 my ($self) = @_;
457 527
458 my ($w, $h) = $self->SUPER::size_request; 528 my ($w, $h) = $self->SUPER::size_request;
459 529
460 $h += $tex[1]->{height}; 530 $h += $tex[1]->{h};
461 $h += $tex[4]->{height}; 531 $h += $tex[4]->{h};
462 $w += $tex[2]->{width}; 532 $w += $tex[2]->{w};
463 $w += $tex[3]->{width}; 533 $w += $tex[3]->{w};
464 534
465 ($w, $h) 535 ($w, $h)
466} 536}
467 537
468sub size_allocate { 538sub size_allocate {
469 my ($self, $w, $h) = @_; 539 my ($self, $w, $h) = @_;
470 540
541 return unless $self->{w} != $w || $self->{h} != $h;
542
471 $self->SUPER::size_allocate ($w, $h); 543 $self->SUPER::size_allocate ($w, $h);
472 544
473 $h -= $tex[1]->{height}; 545 $h -= $tex[1]->{h};
474 $h -= $tex[4]->{height}; 546 $h -= $tex[4]->{h};
475 $w -= $tex[2]->{width}; 547 $w -= $tex[2]->{w};
476 $w -= $tex[3]->{width}; 548 $w -= $tex[3]->{w};
477 549
478 $h = $h < 0 ? 0 : $h; 550 $h = $h < 0 ? 0 : $h;
479 $w = $w < 0 ? 0 : $w; 551 $w = $w < 0 ? 0 : $w;
480 552
481 my $child = $self->child; 553 my $child = $self->child;
482 554
483 $child->size_allocate ($w, $h); 555 $child->size_allocate ($w, $h);
484 $child->move ($tex[3]->{width}, $tex[1]->{height}); 556 $child->move ($tex[3]->{w}, $tex[1]->{h});
485} 557}
486 558
487sub _draw { 559sub _draw {
488 my ($self) = @_; 560 my ($self) = @_;
489 561
494 glEnable GL_TEXTURE_2D; 566 glEnable GL_TEXTURE_2D;
495 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 567 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
496 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 568 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
497 569
498 my $top = $tex[1]; 570 my $top = $tex[1];
499 $top->draw_quad (0, 0, $w, $top->{height}); 571 $top->draw_quad (0, 0, $w, $top->{h});
500 572
501 my $left = $tex[3]; 573 my $left = $tex[3];
502 $left->draw_quad (0, $top->{height}, $left->{width}, $ch); 574 $left->draw_quad (0, $top->{h}, $left->{w}, $ch);
503 575
504 my $right = $tex[2]; 576 my $right = $tex[2];
505 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch); 577 $right->draw_quad ($w - $right->{w}, $top->{h}, $right->{w}, $ch);
506 578
507 my $bottom = $tex[4]; 579 my $bottom = $tex[4];
508 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height}); 580 $bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
509 581
510 my $bg = $tex[0]; 582 my $bg = $tex[0];
511 glBindTexture GL_TEXTURE_2D, $bg->{name}; 583 glBindTexture GL_TEXTURE_2D, $bg->{name};
512 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 584 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
513 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT; 585 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
514 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT; 586 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
515 587
516 my $rep_x = $cw / $bg->{width}; 588 my $rep_x = $cw / $bg->{w};
517 my $rep_y = $ch / $bg->{height}; 589 my $rep_y = $ch / $bg->{h};
518 590
519 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch); 591 $bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
520 592
521 glDisable GL_BLEND; 593 glDisable GL_BLEND;
522 glDisable GL_TEXTURE_2D; 594 glDisable GL_TEXTURE_2D;
523 595
524 $self->child->draw; 596 $self->child->draw;
525 597
526} 598}
527 599
528############################################################################# 600#############################################################################
529 601
530package CFClient::Widget::Table; 602package CFClient::UI::Table;
531 603
532our @ISA = CFClient::Widget::Bin::; 604our @ISA = CFClient::UI::Base::;
533 605
534use SDL::OpenGL; 606use SDL::OpenGL;
535 607
536sub add { 608sub add {
537 my ($self, $x, $y, $chld) = @_; 609 my ($self, $x, $y, $chld) = @_;
612 } 684 }
613} 685}
614 686
615############################################################################# 687#############################################################################
616 688
617package CFClient::Widget::VBox; 689package CFClient::UI::VBox;
618 690
619our @ISA = CFClient::Widget::Container::; 691our @ISA = CFClient::UI::Container::;
620 692
621use SDL::OpenGL; 693use SDL::OpenGL;
622 694
623sub size_request { 695sub size_request {
624 my ($self) = @_; 696 my ($self) = @_;
632} 704}
633 705
634sub size_allocate { 706sub size_allocate {
635 my ($self, $w, $h) = @_; 707 my ($self, $w, $h) = @_;
636 708
709 return unless $self->{w} != $w || $self->{h} != $h;
710
637 $self->w ($w); 711 $self->{w} = $w;
638 $self->h ($h); 712 $self->{h} = $h;
639 713
640 my $exp; 714 return unless $self->{h};
641 my @oth; 715
642 # find expand widget 716 my $children = $self->{children};
643 for (@{$self->{children}}) { 717
644 if ($_->{expand}) { 718 my @h = map +($_->size_request)[1], @$children;
645 $exp = $_; 719
646 last; 720 my $req_h = List::Util::sum @h;
721
722 if ($req_h > $h) {
723 # ah well, not enough space
724 $_ = $h[$_] * $h / $req_h for @h;
725 } else {
726 my @exp = grep $_->{expand}, @$children;
727 @exp = @$children unless @exp;
728
729 my %exp = map +($_ => 1), @exp;
730
731 for (0 .. $#$children) {
732 my $child = $children->[$_];
733
734 my $alloc_h = $h[$_];
735 $alloc_h += ($h - $req_h) / @exp if $exp{$child};
736 $h[$_] = $alloc_h;
647 } 737 }
648 push @oth, $_;
649 }
650
651 my ($ow, $oh);
652
653 # get sizes of other widgets
654 for (@oth) {
655 my ($w, $h) = $_->size_request;
656 $oh += $h;
657 if ($ow < $w) { $ow = $w }
658 } 738 }
659 739
660 my $y = 0; 740 my $y = 0;
661 for (@{$self->{children}}) { 741 for (0 .. $#$children) {
742 my $child = $children->[$_];
743 my $h = $h[$_];
662 $_->move (0, $y); 744 $child->move (0, $y);
663
664 if ($_ == $exp) {
665 $_->size_allocate ($w, $h - $oh);
666 $y += $h - $oh;
667 } else {
668 my ($cw, $h) = $_->size_request;
669 $_->size_allocate ($w, $h); 745 $child->size_allocate ($w, $h);
746
670 $y += $h; 747 $y += $h;
671 }
672 } 748 }
673} 749}
674 750
675############################################################################# 751#############################################################################
676 752
677package CFClient::Widget::Label; 753package CFClient::UI::Label;
678 754
679our @ISA = CFClient::Widget::; 755our @ISA = CFClient::UI::Base::;
680 756
681use SDL::OpenGL; 757use SDL::OpenGL;
682 758
683sub new { 759sub new {
684 my ($class, %arg) = @_; 760 my ($class, %arg) = @_;
685 761
686 # TODO: color, and make height, xyz etc. optional
687 my $self = $class->SUPER::new ( 762 my $self = $class->SUPER::new (
688 color => [1, 1, 1], 763 fg => [1, 1, 1],
689 height => $::FONTSIZE, 764 height => $::FONTSIZE,
690 text => "", 765 text => "",
766 align => -1,
691 layout => new CFClient::Layout, 767 layout => new CFClient::Layout,
692 %arg 768 %arg
693 ); 769 );
694 770
695 $self->set_text ($self->{text}); 771 $self->set_text ($self->{text});
696 772
697 $self 773 $self
698} 774}
699 775
776sub escape_text {
777 local $_ = $_[1];
778
779 s/&/&amp;/g;
780 s/>/&gt;/g;
781 s/</&lt;/g;
782
783 $_[1]
784}
785
700sub set_text { 786sub set_text {
701 my ($self, $text) = @_; 787 my ($self, $text) = @_;
702 788
703 $self->{text} = $text; 789 $self->{text} = $text;
704 $self->{layout}->set_markup ($text); 790 $self->{layout}->set_markup ($text);
705 791
706 delete $self->{texture}; 792 delete $self->{texture};
793 $self->update;
707} 794}
708 795
709sub get_text { 796sub get_text {
710 my ($self, $text) = @_; 797 my ($self, $text) = @_;
711 798
716 my ($self) = @_; 803 my ($self) = @_;
717 804
718 $self->{layout}->set_width; 805 $self->{layout}->set_width;
719 $self->{layout}->set_height ($self->{height}); 806 $self->{layout}->set_height ($self->{height});
720 $self->{layout}->size 807 $self->{layout}->size
721# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack 808# if ($self->{texture}{w} > 1 && $self->{texture}{height} > 1) { #TODO: hack
722# ( 809# (
723# $self->{texture}{width}, 810# $self->{texture}{w},
724# $self->{texture}{height}, 811# $self->{texture}{h},
725# ) 812# )
726# } else { 813# } else {
727# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height}; 814# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{h};
728# 815#
729# ($w, $h) 816# ($w, $h)
730# } 817# }
731} 818}
732 819
733sub size_allocate { 820sub size_allocate {
734 my ($self, $w, $h) = @_; 821 my ($self, $w, $h) = @_;
735 822
823 return unless $self->{w} != $w || $self->{h} != $h;
824
736 $self->SUPER::size_allocate ($w, $h); 825 $self->SUPER::size_allocate ($w, $h);
737 delete $self->{texture}; 826 delete $self->{texture};
827}
828
829sub update {
830 my ($self) = @_;
831
832 delete $self->{texture};
833 $self->SUPER::update;
738} 834}
739 835
740sub _draw { 836sub _draw {
741 my ($self) = @_; 837 my ($self) = @_;
742 838
748 glEnable GL_BLEND; 844 glEnable GL_BLEND;
749 glEnable GL_TEXTURE_2D; 845 glEnable GL_TEXTURE_2D;
750 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 846 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
751 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 847 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
752 848
753 glColor @{$self->{color}}; 849 glColor @{$self->{fg}};
754 850
851 my $x =
852 $self->{align} < 0 ? 0
853 : $self->{align} > 0 ? $self->{w} - $self->{texture}{w}
854 : ($self->{w} + $self->{texture}{w}) * 0.5;
855
755 $tex->draw_quad (0, 0); 856 $tex->draw_quad ($x, 0);
756 857
757 glDisable GL_BLEND; 858 glDisable GL_BLEND;
758 glDisable GL_TEXTURE_2D; 859 glDisable GL_TEXTURE_2D;
759} 860}
760 861
761############################################################################# 862#############################################################################
762 863
763package CFClient::Widget::Entry; 864package CFClient::UI::Entry;
764 865
765our @ISA = CFClient::Widget::Label::; 866our @ISA = CFClient::UI::Label::;
766 867
767use SDL; 868use SDL;
768use SDL::OpenGL; 869use SDL::OpenGL;
769 870
871sub new {
872 my $class = shift;
873
874 $class->SUPER::new (
875 fg => [1, 1, 1],
876 bg => [0, 0, 0, 0.4],
877 active_bg => [1, 1, 1],
878 active_fg => [0, 0, 0],
879 @_
880 )
881}
882
883sub _set_text {
884 my ($self, $text) = @_;
885
886 $self->{last_activity} = $::NOW;
887
888 $self->{text} = $text;
889 $self->{layout}->set_width ($self->{w});
890
891 $text =~ s/./*/g if $self->{hidden};
892
893
894 $self->{layout}->set_markup ($self->escape_text ($text));
895
896 $text = substr $text, 0, $self->{cursor};
897 utf8::encode $text;
898
899 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
900}
901
902sub size_request {
903 my ($self) = @_;
904
905 my ($w, $h) = $self->SUPER::size_request;
906
907 ($w + 1, $h) # add 1 for cursor
908}
909
910sub size_allocate {
911 my ($self, $w, $h) = @_;
912
913 return unless $self->{w} != $w || $self->{h} != $h;
914
915 $self->SUPER::size_allocate ($w, $h);
916
917 $self->_set_text ($self->{text});
918}
919
920sub set_text {
921 my ($self, $text) = @_;
922
923 $self->{cursor} = length $text;
924 $self->_set_text ($text);
925 $self->update;
926}
927
770sub key_down { 928sub key_down {
771 my ($self, $ev) = @_; 929 my ($self, $ev) = @_;
772 930
773 my $mod = $ev->key_mod; 931 my $mod = $ev->key_mod;
774 my $sym = $ev->key_sym; 932 my $sym = $ev->key_sym;
776 my $uni = $ev->key_unicode; 934 my $uni = $ev->key_unicode;
777 935
778 my $text = $self->get_text; 936 my $text = $self->get_text;
779 937
780 if ($sym == SDLK_BACKSPACE) { 938 if ($sym == SDLK_BACKSPACE) {
781 substr $text, -1, 1, ''; 939 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
940 } elsif ($sym == SDLK_DELETE) {
941 substr $text, $self->{cursor}, 1, "";
942 } elsif ($sym == SDLK_LEFT) {
943 --$self->{cursor} if $self->{cursor};
944 } elsif ($sym == SDLK_RIGHT) {
945 ++$self->{cursor} if $self->{cursor} < length $self->{text};
782 } elsif ($uni) { 946 } elsif ($uni) {
783 $text .= chr $uni; 947 substr $text, $self->{cursor}++, 0, chr $uni;
784 } 948 }
785 949
786 $self->set_text ($text); 950 $self->_set_text ($text);
951 $self->update;
952}
953
954sub focus_in {
955 my ($self) = @_;
956
957 $self->{last_activity} = $::NOW;
958
959 $self->SUPER::focus_in;
787} 960}
788 961
789sub button_down { 962sub button_down {
790 my ($self, $ev) = @_; 963 my ($self, $ev, $x, $y) = @_;
791 964
792 $self->focus_in; 965 $self->SUPER::button_down ($ev, $x, $y);
966
967 my $idx = $self->{layout}->xy_to_index ($x, $y);
968
969 # byte-index to char-index
970 my $text = $self->{layout};
971 utf8::encode $text;
972 $self->{cursor} = length substr $text, 0, $idx;
973
974 $self->_set_text ($self->{text});
975 $self->update;
793} 976}
794 977
795sub mouse_motion { 978sub mouse_motion {
796 my ($self, $ev, $x, $y) = @_; 979 my ($self, $ev, $x, $y) = @_;
797 printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 980# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
798} 981}
799 982
800sub _draw { 983sub _draw {
801 my ($self) = @_; 984 my ($self) = @_;
802 985
986 local $self->{fg} = $self->{fg};
987
803 if ($FOCUS == $self) { 988 if ($FOCUS == $self) {
804 glColor 1, 1, 1; 989 glColor @{$self->{active_bg}};
990 $self->{fg} = $self->{active_fg};
805 } else { 991 } else {
806 glColor 0.7, 0.7, 0.7; 992 glColor @{$self->{bg}};
807 } 993 }
808 994
809 glBegin GL_QUADS; 995 glBegin GL_QUADS;
810 glVertex 0 , 0; 996 glVertex 0 , 0;
811 glVertex 0 , $self->{h} - 1; 997 glVertex 0 , $self->{h};
812 glVertex $self->{w} - 1, $self->{h} - 1; 998 glVertex $self->{w}, $self->{h};
813 glVertex $self->{w} - 1, 0; 999 glVertex $self->{w}, 0;
814 glEnd; 1000 glEnd;
815 1001
816 $self->SUPER::_draw; 1002 $self->SUPER::_draw;
817}
818 1003
819############################################################################# 1004 #TODO: force update every cursor change :(
1005 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1006 glColor @{$self->{fg}};
1007 glBegin GL_LINES;
1008 glVertex $self->{cur_x}, $self->{cur_y};
1009 glVertex $self->{cur_x}, $self->{cur_y} + $self->{cur_h};
1010 glEnd;
1011 }
1012}
820 1013
1014#############################################################################
1015
1016package CFClient::UI::Slider;
1017
1018use strict;
1019
1020use SDL::OpenGL;
1021use SDL::OpenGL::Constants;
1022
1023our @ISA = CFClient::UI::DrawBG::;
1024
1025sub size_request {
1026 my ($self) = @_;
1027
1028 my $w = 50;
1029 my $h = 10;
1030
1031 $self->{vertical} ? ($h, $w) : ($w, $h)
1032}
1033
1034sub new {
1035 my $class = shift;
1036
1037 # range [value, low, high, page]
1038
1039 $class->SUPER::new (
1040 fg => [1, 1, 1],
1041 active_fg => [0, 0, 0],
1042 range => [0, 0, 100, 10],
1043 vertical => 1,
1044 @_
1045 )
1046}
1047
1048sub button_down {
1049 my ($self, $ev, $x, $y) = @_;
1050
1051 $self->SUPER::button_down ($ev, $x, $y);
1052 $self->mouse_motion ($ev, $x, $y);
1053}
1054
1055sub mouse_motion {
1056 my ($self, $ev, $x, $y) = @_;
1057
1058 if ($GRAB == $self) {
1059 my ($value, $lo, $hi, $page) = @{$self->{range}};
1060
1061 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
1062
1063 $x = $x * ($hi - $lo) / $w + $lo;
1064 $x = $lo if $x < $lo;
1065 $x = $hi - $page if $x > $hi - $page;
1066 $self->{range}[0] = $x;
1067
1068 $self->emit (changed => $x);
1069 $self->update;
1070 }
1071}
1072
1073sub _draw {
1074 my ($self) = @_;
1075
1076 $self->SUPER::_draw ();
1077
1078 my ($w, $h) = @$self{qw(w h)};
1079
1080 if ($self->{vertical}) {
1081 # draw a vertical slider like a rotated horizontal slider
1082
1083 glRotate 90, 0, 0, 1;
1084 glTranslate 0, -$self->{w}, 0;
1085
1086 ($w, $h) = ($h, $w);
1087 }
1088
1089 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1090 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1091
1092 my ($value, $lo, $hi, $page) = @{$self->{range}};
1093
1094 $page = int $page * $w / ($hi - $lo);
1095 $value = int +($value - $lo) * $w / ($hi - $lo);
1096
1097 $w -= $page;
1098 $page &= ~1;
1099 glTranslate $page * 0.5, 0, 0;
1100
1101 glColor @$fg;
1102 glBegin GL_LINES;
1103 glVertex 0, 0; glVertex 0, $h;
1104 glVertex $w - 1, 0; glVertex $w - 1, $h;
1105 glVertex 0, $h * 0.5; glVertex $w, $h * 0.5;
1106 glEnd;
1107
1108 my $knob_a = $value - $page * 0.5;
1109 my $knob_b = $value + $page * 0.5;
1110
1111 glBegin GL_QUADS;
1112 glColor @$fg;
1113 glVertex $knob_a, 0;
1114 glVertex $knob_a, $h;
1115 glVertex $knob_b, $h;
1116 glVertex $knob_b, 0;
1117
1118 if ($knob_a < $knob_b - 2) {
1119 glColor @$bg;
1120 glVertex $knob_a + 1, 1;
1121 glVertex $knob_a + 1, $h - 1;
1122 glVertex $knob_b - 1, $h - 1;
1123 glVertex $knob_b - 1, 1;
1124 }
1125 glEnd;
1126}
1127
1128#############################################################################
1129
821package CFClient::Widget::MapWidget; 1130package CFClient::UI::MapWidget;
822 1131
823use strict; 1132use strict;
824 1133
825use List::Util qw(min max); 1134use List::Util qw(min max);
826 1135
827use SDL; 1136use SDL;
828use SDL::OpenGL; 1137use SDL::OpenGL;
829use SDL::OpenGL::Constants; 1138use SDL::OpenGL::Constants;
830 1139
831our @ISA = CFClient::Widget::; 1140our @ISA = CFClient::UI::Base::;
832 1141
833sub new { 1142sub new {
834 my $class = shift; 1143 my $class = shift;
835 1144
836 $class->SUPER::new ( 1145 $class->SUPER::new (
910 } 1219 }
911 1220
912 for my $num (grep $_, @$cell[1,2,3]) { 1221 for my $num (grep $_, @$cell[1,2,3]) {
913 my $tex = $::CONN->{face}[$num]{texture} || next; 1222 my $tex = $::CONN->{face}[$num]{texture} || next;
914 1223
915 my $w = $tex->{width}; 1224 my ($w, $h) = @$tex{qw(w h)};
916 my $h = $tex->{height};
917 1225
918 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h); 1226 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
919 } 1227 }
920 } 1228 }
921 } 1229 }
1003 } 1311 }
1004} 1312}
1005 1313
1006############################################################################# 1314#############################################################################
1007 1315
1008package CFClient::Widget::Animator; 1316package CFClient::UI::Animator;
1009 1317
1010use SDL::OpenGL; 1318use SDL::OpenGL;
1011 1319
1012our @ISA = CFClient::Widget::Bin::; 1320our @ISA = CFClient::UI::Bin::;
1013 1321
1014sub moveto { 1322sub moveto {
1015 my ($self, $x, $y) = @_; 1323 my ($self, $x, $y) = @_;
1016 1324
1017 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 1325 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
1045 glPopMatrix; 1353 glPopMatrix;
1046} 1354}
1047 1355
1048############################################################################# 1356#############################################################################
1049 1357
1050package CFClient::Widget::Toplevel; 1358package CFClient::UI::Toplevel;
1051 1359
1052our @ISA = CFClient::Widget::Container::; 1360our @ISA = CFClient::UI::Container::;
1053 1361
1054sub size_request { 1362sub size_request {
1055 ($::WIDTH, $::HEIGHT) 1363 ($::WIDTH, $::HEIGHT)
1056} 1364}
1057 1365
1091 $self->_draw; 1399 $self->_draw;
1092} 1400}
1093 1401
1094############################################################################# 1402#############################################################################
1095 1403
1096package CFClient::Widget; 1404package CFClient::UI;
1097 1405
1098$TOPLEVEL = new CFClient::Widget::Toplevel; 1406$TOPLEVEL = new CFClient::UI::Toplevel;
1099 1407
11001 14081
1101 1409

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines