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.65 by root, Tue Apr 11 14:04:27 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
285package CFClient::UI::Empty;
286
287our @ISA = CFClient::UI::Base::;
288
289sub size_request {
290 (0, 0)
291}
292
293sub draw { }
294
295#############################################################################
296
220package CFClient::Widget::Container; 297package CFClient::UI::Container;
221 298
222our @ISA = CFClient::Widget::; 299our @ISA = CFClient::UI::Base::;
223 300
224sub new { 301sub new {
225 my ($class, %arg) = @_; 302 my ($class, %arg) = @_;
226 303
227 my $children = delete $arg{children} || []; 304 my $children = delete $arg{children} || [];
… …
236 my ($self, $chld, $expand) = @_; 313 my ($self, $chld, $expand) = @_;
237 314
238 $chld->{expand} = $expand; 315 $chld->{expand} = $expand;
239 $chld->set_parent ($self); 316 $chld->set_parent ($self);
240 317
241 @{$self->{children}} = 318 $self->{children} = [
242 sort { $a->{z} <=> $b->{z} } 319 sort { $a->{z} <=> $b->{z} }
243 @{$self->{children}}, $chld; 320 @{$self->{children}}, $chld
321 ];
244 322
245 $self->size_allocate ($self->{w}, $self->{h}) 323 $self->size_allocate ($self->{w}, $self->{h})
246 if $self->{w}; #TODO: check for "realised state" 324 if $self->{w}; #TODO: check for "realised state"
247} 325}
248 326
… …
276 $_->draw for @{$self->{children}}; 354 $_->draw for @{$self->{children}};
277} 355}
278 356
279############################################################################# 357#############################################################################
280 358
281package CFClient::Widget::Bin; 359package CFClient::UI::Bin;
282 360
283our @ISA = CFClient::Widget::Container::; 361our @ISA = CFClient::UI::Container::;
362
363sub new {
364 my ($class, %arg) = @_;
365
366 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
367
368 $class->SUPER::new (children => [$child], %arg)
369}
370
371sub add {
372 my ($self, $widget) = @_;
373
374 $self->{children} = [];
375
376 $self->SUPER::add ($widget);
377}
378
379sub remove {
380 my ($self, $widget) = @_;
381
382 $self->SUPER::remove ($widget);
383
384 $self->{children} = [new CFClient::UI::Empty]
385 unless @{$self->{children}};
386}
284 387
285sub child { $_[0]->{children}[0] } 388sub child { $_[0]->{children}[0] }
286 389
287sub size_request { 390sub size_request {
288 $_[0]{children}[0]->size_request if $_[0]{children}[0]; 391 $_[0]{children}[0]->size_request
289} 392}
290 393
291sub size_allocate { 394sub size_allocate {
292 my ($self, $w, $h) = @_; 395 my ($self, $w, $h) = @_;
293 396
397 return unless $self->{w} != $w || $self->{h} != $h;
398
294 $self->SUPER::size_allocate ($w, $h); 399 $self->SUPER::size_allocate ($w, $h);
295 $self->{children}[0]->size_allocate ($w, $h) 400 $self->{children}[0]->size_allocate ($w, $h);
296 if $self->{children}[0]
297} 401}
298 402
299############################################################################# 403#############################################################################
300 404
301package CFClient::Widget::Window; 405package CFClient::UI::Window;
302 406
303our @ISA = CFClient::Widget::Bin::; 407our @ISA = CFClient::UI::Bin::;
304 408
305use SDL::OpenGL; 409use SDL::OpenGL;
306 410
307sub new { 411sub new {
308 my ($class, %arg) = @_; 412 my ($class, %arg) = @_;
… …
328} 432}
329 433
330sub size_allocate { 434sub size_allocate {
331 my ($self, $w, $h) = @_; 435 my ($self, $w, $h) = @_;
332 436
437 return unless $self->{w} != $w || $self->{h} != $h;
438
333 $self->{w} = $w; 439 $self->{w} = $w;
334 $self->{h} = $h; 440 $self->{h} = $h;
335 441
336 $self->child->size_allocate ($w, $h); 442 $self->child->size_allocate ($w, $h);
337 443
… …
356 glDisable GL_TEXTURE_2D; 462 glDisable GL_TEXTURE_2D;
357} 463}
358 464
359############################################################################# 465#############################################################################
360 466
361package CFClient::Widget::Frame; 467package CFClient::UI::Frame;
362 468
363our @ISA = CFClient::Widget::Bin::; 469our @ISA = CFClient::UI::Bin::;
364 470
365use SDL::OpenGL; 471use SDL::OpenGL;
366 472
367sub size_request { 473sub size_request {
368 my ($self) = @_; 474 my ($self) = @_;
… …
375} 481}
376 482
377sub size_allocate { 483sub size_allocate {
378 my ($self, $w, $h) = @_; 484 my ($self, $w, $h) = @_;
379 485
486 return unless $self->{w} != $w || $self->{h} != $h;
487
380 $self->{w} = $w; 488 $self->{w} = $w;
381 $self->{h} = $h; 489 $self->{h} = $h;
382 490
383 $self->child->size_allocate ($w - 4, $h - 4); 491 $self->child->size_allocate ($w - 4, $h - 4);
384 $self->child->move (2, 2); 492 $self->child->move (2, 2);
… …
402 $chld->draw; 510 $chld->draw;
403} 511}
404 512
405############################################################################# 513#############################################################################
406 514
407package CFClient::Widget::FancyFrame; 515package CFClient::UI::FancyFrame;
408 516
409our @ISA = CFClient::Widget::Bin::; 517our @ISA = CFClient::UI::Bin::;
410 518
411use SDL::OpenGL; 519use SDL::OpenGL;
412 520
413my @tex = 521my @tex =
414 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 522 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
… …
417sub size_request { 525sub size_request {
418 my ($self) = @_; 526 my ($self) = @_;
419 527
420 my ($w, $h) = $self->SUPER::size_request; 528 my ($w, $h) = $self->SUPER::size_request;
421 529
422 $h += $tex[1]->{height}; 530 $h += $tex[1]->{h};
423 $h += $tex[4]->{height}; 531 $h += $tex[4]->{h};
424 $w += $tex[2]->{width}; 532 $w += $tex[2]->{w};
425 $w += $tex[3]->{width}; 533 $w += $tex[3]->{w};
426 534
427 ($w, $h) 535 ($w, $h)
428} 536}
429 537
430sub size_allocate { 538sub size_allocate {
431 my ($self, $w, $h) = @_; 539 my ($self, $w, $h) = @_;
432 540
541 return unless $self->{w} != $w || $self->{h} != $h;
542
433 $self->SUPER::size_allocate ($w, $h); 543 $self->SUPER::size_allocate ($w, $h);
434 544
435 $h -= $tex[1]->{height}; 545 $h -= $tex[1]->{h};
436 $h -= $tex[4]->{height}; 546 $h -= $tex[4]->{h};
437 $w -= $tex[2]->{width}; 547 $w -= $tex[2]->{w};
438 $w -= $tex[3]->{width}; 548 $w -= $tex[3]->{w};
439 549
440 $h = $h < 0 ? 0 : $h; 550 $h = $h < 0 ? 0 : $h;
441 $w = $w < 0 ? 0 : $w; 551 $w = $w < 0 ? 0 : $w;
442 552
553 my $child = $self->child;
554
443 $self->child->size_allocate ($w, $h); 555 $child->size_allocate ($w, $h);
444 $self->child->move ($tex[3]->{width}, $tex[1]->{height}); 556 $child->move ($tex[3]->{w}, $tex[1]->{h});
445} 557}
446 558
447sub _draw { 559sub _draw {
448 my ($self) = @_; 560 my ($self) = @_;
449 561
… …
454 glEnable GL_TEXTURE_2D; 566 glEnable GL_TEXTURE_2D;
455 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 567 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
456 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 568 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
457 569
458 my $top = $tex[1]; 570 my $top = $tex[1];
459 $top->draw_quad (0, 0, $w, $top->{height}); 571 $top->draw_quad (0, 0, $w, $top->{h});
460 572
461 my $left = $tex[3]; 573 my $left = $tex[3];
462 $left->draw_quad (0, $top->{height}, $left->{width}, $ch); 574 $left->draw_quad (0, $top->{h}, $left->{w}, $ch);
463 575
464 my $right = $tex[2]; 576 my $right = $tex[2];
465 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch); 577 $right->draw_quad ($w - $right->{w}, $top->{h}, $right->{w}, $ch);
466 578
467 my $bottom = $tex[4]; 579 my $bottom = $tex[4];
468 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height}); 580 $bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h});
469 581
470 my $bg = $tex[0]; 582 my $bg = $tex[0];
471 glBindTexture GL_TEXTURE_2D, $bg->{name}; 583 glBindTexture GL_TEXTURE_2D, $bg->{name};
472 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 584 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
473 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT; 585 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
474 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT; 586 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
475 587
476 my $rep_x = $cw / $bg->{width}; 588 my $rep_x = $cw / $bg->{w};
477 my $rep_y = $ch / $bg->{height}; 589 my $rep_y = $ch / $bg->{h};
478 590
479 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch); 591 $bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch);
480 592
481 glDisable GL_BLEND; 593 glDisable GL_BLEND;
482 glDisable GL_TEXTURE_2D; 594 glDisable GL_TEXTURE_2D;
483 595
484 $self->child->draw; 596 $self->child->draw;
485 597
486} 598}
487 599
488############################################################################# 600#############################################################################
489 601
490package CFClient::Widget::Table; 602package CFClient::UI::Table;
491 603
492our @ISA = CFClient::Widget::Bin::; 604our @ISA = CFClient::UI::Base::;
493 605
494use SDL::OpenGL; 606use SDL::OpenGL;
495 607
496sub add { 608sub add {
497 my ($self, $x, $y, $chld) = @_; 609 my ($self, $x, $y, $chld) = @_;
… …
572 } 684 }
573} 685}
574 686
575############################################################################# 687#############################################################################
576 688
577package CFClient::Widget::VBox; 689package CFClient::UI::VBox;
578 690
579our @ISA = CFClient::Widget::Container::; 691our @ISA = CFClient::UI::Container::;
580 692
581use SDL::OpenGL; 693use SDL::OpenGL;
582 694
583sub size_request { 695sub size_request {
584 my ($self) = @_; 696 my ($self) = @_;
… …
592} 704}
593 705
594sub size_allocate { 706sub size_allocate {
595 my ($self, $w, $h) = @_; 707 my ($self, $w, $h) = @_;
596 708
709 return unless $self->{w} != $w || $self->{h} != $h;
710
597 $self->w ($w); 711 $self->{w} = $w;
598 $self->h ($h); 712 $self->{h} = $h;
599 713
600 my $exp; 714 return unless $self->{h};
601 my @oth; 715
602 # find expand widget 716 my $children = $self->{children};
603 for (@{$self->{children}}) { 717
604 if ($_->{expand}) { 718 my @h = map +($_->size_request)[1], @$children;
605 $exp = $_; 719
606 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;
607 } 737 }
608 push @oth, $_;
609 }
610
611 my ($ow, $oh);
612
613 # get sizes of other widgets
614 for (@oth) {
615 my ($w, $h) = $_->size_request;
616 $oh += $h;
617 if ($ow < $w) { $ow = $w }
618 } 738 }
619 739
620 my $y = 0; 740 my $y = 0;
621 for (@{$self->{children}}) { 741 for (0 .. $#$children) {
742 my $child = $children->[$_];
743 my $h = $h[$_];
622 $_->move (0, $y); 744 $child->move (0, $y);
623
624 if ($_ == $exp) {
625 $_->size_allocate ($w, $h - $oh);
626 $y += $h - $oh;
627 } else {
628 my ($cw, $h) = $_->size_request;
629 $_->size_allocate ($w, $h); 745 $child->size_allocate ($w, $h);
746
630 $y += $h; 747 $y += $h;
631 }
632 } 748 }
633} 749}
634 750
635############################################################################# 751#############################################################################
636 752
637package CFClient::Widget::Label; 753package CFClient::UI::Label;
638 754
639our @ISA = CFClient::Widget::; 755our @ISA = CFClient::UI::Base::;
640 756
641use SDL::OpenGL; 757use SDL::OpenGL;
642 758
643sub new { 759sub new {
644 my ($class, %arg) = @_; 760 my ($class, %arg) = @_;
645 761
646 # TODO: color, and make height, xyz etc. optional
647 my $self = $class->SUPER::new ( 762 my $self = $class->SUPER::new (
648 color => [1, 1, 1], 763 fg => [1, 1, 1],
649 height => $::FONTSIZE, 764 height => $::FONTSIZE,
650 text => "", 765 text => "",
766 align => -1,
651 layout => new CFClient::Layout, 767 layout => new CFClient::Layout,
652 %arg 768 %arg
653 ); 769 );
654 770
655 $self->set_text ($self->{text}); 771 $self->set_text ($self->{text});
656 772
657 $self 773 $self
658} 774}
659 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
660sub set_text { 786sub set_text {
661 my ($self, $text) = @_; 787 my ($self, $text) = @_;
662 788
663 $self->{text} = $text; 789 $self->{text} = $text;
664 $self->{layout}->set_markup ($text); 790 $self->{layout}->set_markup ($text);
665 791
666 delete $self->{texture}; 792 delete $self->{texture};
793 $self->update;
667} 794}
668 795
669sub get_text { 796sub get_text {
670 my ($self, $text) = @_; 797 my ($self, $text) = @_;
671 798
… …
676 my ($self) = @_; 803 my ($self) = @_;
677 804
678 $self->{layout}->set_width; 805 $self->{layout}->set_width;
679 $self->{layout}->set_height ($self->{height}); 806 $self->{layout}->set_height ($self->{height});
680 $self->{layout}->size 807 $self->{layout}->size
681# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack 808# if ($self->{texture}{w} > 1 && $self->{texture}{height} > 1) { #TODO: hack
682# ( 809# (
683# $self->{texture}{width}, 810# $self->{texture}{w},
684# $self->{texture}{height}, 811# $self->{texture}{h},
685# ) 812# )
686# } else { 813# } else {
687# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height}; 814# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{h};
688# 815#
689# ($w, $h) 816# ($w, $h)
690# } 817# }
691} 818}
692 819
693sub size_allocate { 820sub size_allocate {
694 my ($self, $w, $h) = @_; 821 my ($self, $w, $h) = @_;
695 822
823 return unless $self->{w} != $w || $self->{h} != $h;
824
696 $self->SUPER::size_allocate ($w, $h); 825 $self->SUPER::size_allocate ($w, $h);
697 delete $self->{texture}; 826 delete $self->{texture};
827}
828
829sub update {
830 my ($self) = @_;
831
832 delete $self->{texture};
833 $self->SUPER::update;
698} 834}
699 835
700sub _draw { 836sub _draw {
701 my ($self) = @_; 837 my ($self) = @_;
702 838
… …
708 glEnable GL_BLEND; 844 glEnable GL_BLEND;
709 glEnable GL_TEXTURE_2D; 845 glEnable GL_TEXTURE_2D;
710 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 846 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
711 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 847 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
712 848
713 glColor @{$self->{color}}; 849 glColor @{$self->{fg}};
714 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
715 $tex->draw_quad (0, 0); 856 $tex->draw_quad ($x, 0);
716 857
717 glDisable GL_BLEND; 858 glDisable GL_BLEND;
718 glDisable GL_TEXTURE_2D; 859 glDisable GL_TEXTURE_2D;
719} 860}
720 861
721############################################################################# 862#############################################################################
722 863
723package CFClient::Widget::Entry; 864package CFClient::UI::Entry;
724 865
725our @ISA = CFClient::Widget::Label::; 866our @ISA = CFClient::UI::Label::;
726 867
727use SDL; 868use SDL;
728use SDL::OpenGL; 869use SDL::OpenGL;
729 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
730sub key_down { 928sub key_down {
731 my ($self, $ev) = @_; 929 my ($self, $ev) = @_;
732 930
733 my $mod = $ev->key_mod; 931 my $mod = $ev->key_mod;
734 my $sym = $ev->key_sym; 932 my $sym = $ev->key_sym;
… …
736 my $uni = $ev->key_unicode; 934 my $uni = $ev->key_unicode;
737 935
738 my $text = $self->get_text; 936 my $text = $self->get_text;
739 937
740 if ($sym == SDLK_BACKSPACE) { 938 if ($sym == SDLK_BACKSPACE) {
741 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};
742 } elsif ($uni) { 946 } elsif ($uni) {
743 $text .= chr $uni; 947 substr $text, $self->{cursor}++, 0, chr $uni;
744 } 948 }
745 949
746 $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;
747} 960}
748 961
749sub button_down { 962sub button_down {
750 my ($self, $ev) = @_; 963 my ($self, $ev, $x, $y) = @_;
751 964
752 $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;
753} 976}
754 977
755sub mouse_motion { 978sub mouse_motion {
756 my ($self, $ev, $x, $y) = @_; 979 my ($self, $ev, $x, $y) = @_;
757 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#
758} 981}
759 982
760sub _draw { 983sub _draw {
761 my ($self) = @_; 984 my ($self) = @_;
762 985
986 local $self->{fg} = $self->{fg};
987
763 if ($FOCUS == $self) { 988 if ($FOCUS == $self) {
764 glColor 1, 1, 1; 989 glColor @{$self->{active_bg}};
990 $self->{fg} = $self->{active_fg};
765 } else { 991 } else {
766 glColor 0.7, 0.7, 0.7; 992 glColor @{$self->{bg}};
767 } 993 }
768 994
769 glBegin GL_QUADS; 995 glBegin GL_QUADS;
770 glVertex 0 , 0; 996 glVertex 0 , 0;
771 glVertex 0 , $self->{h} - 1; 997 glVertex 0 , $self->{h};
772 glVertex $self->{w} - 1, $self->{h} - 1; 998 glVertex $self->{w}, $self->{h};
773 glVertex $self->{w} - 1, 0; 999 glVertex $self->{w}, 0;
774 glEnd; 1000 glEnd;
775 1001
776 $self->SUPER::_draw; 1002 $self->SUPER::_draw;
777}
778 1003
779############################################################################# 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}
780 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
781package CFClient::Widget::MapWidget; 1130package CFClient::UI::MapWidget;
782 1131
783use strict; 1132use strict;
784 1133
785use List::Util qw(min max); 1134use List::Util qw(min max);
786 1135
787use SDL; 1136use SDL;
788use SDL::OpenGL; 1137use SDL::OpenGL;
789use SDL::OpenGL::Constants; 1138use SDL::OpenGL::Constants;
790 1139
791our @ISA = CFClient::Widget::; 1140our @ISA = CFClient::UI::Base::;
792 1141
793sub new { 1142sub new {
794 my $class = shift; 1143 my $class = shift;
795 1144
796 $class->SUPER::new ( 1145 $class->SUPER::new (
… …
870 } 1219 }
871 1220
872 for my $num (grep $_, @$cell[1,2,3]) { 1221 for my $num (grep $_, @$cell[1,2,3]) {
873 my $tex = $::CONN->{face}[$num]{texture} || next; 1222 my $tex = $::CONN->{face}[$num]{texture} || next;
874 1223
875 my $w = $tex->{width}; 1224 my ($w, $h) = @$tex{qw(w h)};
876 my $h = $tex->{height};
877 1225
878 $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);
879 } 1227 }
880 } 1228 }
881 } 1229 }
… …
963 } 1311 }
964} 1312}
965 1313
966############################################################################# 1314#############################################################################
967 1315
968package CFClient::Widget::Animator; 1316package CFClient::UI::Animator;
969 1317
970use SDL::OpenGL; 1318use SDL::OpenGL;
971 1319
972our @ISA = CFClient::Widget::Bin::; 1320our @ISA = CFClient::UI::Bin::;
973 1321
974sub moveto { 1322sub moveto {
975 my ($self, $x, $y) = @_; 1323 my ($self, $x, $y) = @_;
976 1324
977 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 1325 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
1005 glPopMatrix; 1353 glPopMatrix;
1006} 1354}
1007 1355
1008############################################################################# 1356#############################################################################
1009 1357
1010package CFClient::Widget::Toplevel; 1358package CFClient::UI::Toplevel;
1011 1359
1012our @ISA = CFClient::Widget::Container::; 1360our @ISA = CFClient::UI::Container::;
1013 1361
1014sub size_request { 1362sub size_request {
1015 ($::WIDTH, $::HEIGHT) 1363 ($::WIDTH, $::HEIGHT)
1016} 1364}
1017 1365
… …
1051 $self->_draw; 1399 $self->_draw;
1052} 1400}
1053 1401
1054############################################################################# 1402#############################################################################
1055 1403
1056package CFClient::Widget; 1404package CFClient::UI;
1057 1405
1058$TOPLEVEL = new CFClient::Widget::Toplevel; 1406$TOPLEVEL = new CFClient::UI::Toplevel;
1059 1407
10601 14081
1061 1409

Diff Legend

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