… | |
… | |
140 | 0 |
140 | 0 |
141 | } |
141 | } |
142 | |
142 | |
143 | sub size_request { |
143 | sub size_request { |
144 | require Carp; |
144 | require Carp; |
145 | Carp::confess "size_request is abtract"; |
145 | Carp::confess "size_request is abstract"; |
146 | } |
146 | } |
147 | |
147 | |
148 | sub configure { |
148 | sub configure { |
149 | my ($self, $x, $y, $w, $h) = @_; |
149 | my ($self, $x, $y, $w, $h) = @_; |
150 | |
150 | |
… | |
… | |
152 | my $w2 = List::Util::min $w, int $h * $self->{aspect}; |
152 | my $w2 = List::Util::min $w, int $h * $self->{aspect}; |
153 | my $h2 = List::Util::min $h, int $w / $self->{aspect}; |
153 | my $h2 = List::Util::min $h, int $w / $self->{aspect}; |
154 | |
154 | |
155 | # use alignment to adjust x, y |
155 | # use alignment to adjust x, y |
156 | |
156 | |
157 | $x += ($w - $w2) * 0.5; |
157 | $x += int +($w - $w2) * 0.5; |
158 | $y += ($h - $h2) * 0.5; |
158 | $y += int +($h - $h2) * 0.5; |
159 | |
159 | |
160 | ($w, $h) = ($w2, $h2); |
160 | ($w, $h) = ($w2, $h2); |
161 | } |
161 | } |
162 | |
162 | |
163 | if ($self->{x} != $x || $self->{y} != $y) { |
163 | if ($self->{x} != $x || $self->{y} != $y) { |
… | |
… | |
582 | |
582 | |
583 | our @ISA = CFClient::UI::Bin::; |
583 | our @ISA = CFClient::UI::Bin::; |
584 | |
584 | |
585 | use CFClient::OpenGL; |
585 | use CFClient::OpenGL; |
586 | |
586 | |
|
|
587 | sub new { |
|
|
588 | my $class = shift; |
|
|
589 | |
|
|
590 | my $self = $class->SUPER::new ( |
|
|
591 | bg => [1, 1, 1, 1], |
|
|
592 | border_bg => [1, 1, 1, 1], |
|
|
593 | border => 0.8, |
|
|
594 | @_ |
|
|
595 | ); |
|
|
596 | |
|
|
597 | $self |
|
|
598 | } |
|
|
599 | |
|
|
600 | sub set_size { |
|
|
601 | my ($self, $w, $h) = @_; |
|
|
602 | $self->{req_w} = $w; |
|
|
603 | $self->{req_h} = $h; |
|
|
604 | $self->check_size; |
|
|
605 | } |
|
|
606 | |
587 | sub size_request { |
607 | sub size_request { |
588 | my ($self) = @_; |
608 | my ($self) = @_; |
589 | my $chld = $self->child |
609 | ($self->{req_w}, $self->{req_h}) |
590 | or return (0, 0); |
|
|
591 | |
|
|
592 | $chld->move (2, 2); |
|
|
593 | |
|
|
594 | map { $_ + 4 } $chld->size_request; |
|
|
595 | } |
610 | } |
596 | |
611 | |
597 | sub size_allocate { |
612 | sub size_allocate { |
598 | my ($self, $x, $y, $w, $h) = @_; |
613 | my ($self, $w, $h) = @_; |
599 | |
614 | $self->{w} = $w; |
|
|
615 | $self->{h} = $h; |
600 | $self->child->configure (2, 2, $w - 4, $h - 4); |
616 | $self->child->configure (0, 0, $w, $h); |
601 | } |
617 | } |
602 | |
618 | |
603 | sub _draw { |
619 | sub _draw { |
604 | my ($self) = @_; |
620 | my ($self) = @_; |
605 | |
621 | |
606 | my $chld = $self->child; |
622 | my ($w, $h) = ($self->{w}, $self->{h}); |
607 | |
623 | |
608 | my ($w, $h) = $chld->size_request; |
624 | glEnable GL_BLEND; |
|
|
625 | glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; |
|
|
626 | glEnable GL_TEXTURE_2D; |
|
|
627 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; |
609 | |
628 | |
610 | glBegin GL_QUADS; |
629 | # glBegin GL_QUADS; |
611 | glColor 0, 0, 0; |
630 | # glColor 0, 0, 0, 0; |
612 | glVertex 0 , 0; |
631 | # glVertex 0 , 0; |
613 | glVertex 0 , $h + 4; |
632 | # glVertex 0 , $h; |
614 | glVertex $w + 4 , $h + 4; |
633 | # glVertex $w, $h; |
615 | glVertex $w + 4 , 0; |
634 | # glVertex $w, 0; |
616 | glEnd; |
635 | # glEnd; |
617 | |
636 | |
|
|
637 | |
618 | $chld->draw; |
638 | $self->child->draw; |
|
|
639 | glDisable GL_BLEND; |
|
|
640 | glDisable GL_TEXTURE_2D; |
619 | } |
641 | } |
620 | |
642 | |
621 | ############################################################################# |
643 | ############################################################################# |
622 | |
644 | |
623 | package CFClient::UI::FancyFrame; |
645 | package CFClient::UI::FancyFrame; |
… | |
… | |
1109 | |
1131 | |
1110 | sub size_allocate { |
1132 | sub size_allocate { |
1111 | my ($self, $w, $h) = @_; |
1133 | my ($self, $w, $h) = @_; |
1112 | |
1134 | |
1113 | delete $self->{texture}; |
1135 | delete $self->{texture}; |
|
|
1136 | } |
|
|
1137 | |
|
|
1138 | sub set_fontsize { |
|
|
1139 | my ($self, $fontsize) = @_; |
|
|
1140 | |
|
|
1141 | $self->{fontsize} = $fontsize; |
|
|
1142 | $self->check_size; |
1114 | } |
1143 | } |
1115 | |
1144 | |
1116 | sub _draw { |
1145 | sub _draw { |
1117 | my ($self) = @_; |
1146 | my ($self) = @_; |
1118 | |
1147 | |
… | |
… | |
1456 | |
1485 | |
1457 | $tex->draw_quad (0, 0, $s, $s); |
1486 | $tex->draw_quad (0, 0, $s, $s); |
1458 | |
1487 | |
1459 | glDisable GL_TEXTURE_2D; |
1488 | glDisable GL_TEXTURE_2D; |
1460 | glDisable GL_BLEND; |
1489 | glDisable GL_BLEND; |
|
|
1490 | } |
|
|
1491 | |
|
|
1492 | ############################################################################# |
|
|
1493 | |
|
|
1494 | package CFClient::UI::Image; |
|
|
1495 | |
|
|
1496 | our @ISA = CFClient::UI::Base::; |
|
|
1497 | |
|
|
1498 | use CFClient::OpenGL; |
|
|
1499 | use Carp qw/confess/; |
|
|
1500 | |
|
|
1501 | our %loaded_images; |
|
|
1502 | |
|
|
1503 | sub new { |
|
|
1504 | my $class = shift; |
|
|
1505 | |
|
|
1506 | my $self = $class->SUPER::new (@_); |
|
|
1507 | |
|
|
1508 | $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; |
|
|
1509 | |
|
|
1510 | $loaded_images{$self->{image}} ||= |
|
|
1511 | new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; |
|
|
1512 | |
|
|
1513 | my $tex = $self->{tex} = $loaded_images{$self->{image}}; |
|
|
1514 | |
|
|
1515 | Scalar::Util::weaken $loaded_images{$self->{image}}; |
|
|
1516 | |
|
|
1517 | $self->{aspect} = $tex->{w} / $tex->{h}; |
|
|
1518 | |
|
|
1519 | $self |
|
|
1520 | } |
|
|
1521 | |
|
|
1522 | sub size_request { |
|
|
1523 | my ($self) = @_; |
|
|
1524 | |
|
|
1525 | ($self->{tex}->{w}, $self->{tex}->{h}) |
|
|
1526 | } |
|
|
1527 | |
|
|
1528 | sub _draw { |
|
|
1529 | my ($self) = @_; |
|
|
1530 | |
|
|
1531 | my $tex = $self->{tex}; |
|
|
1532 | |
|
|
1533 | my ($w, $h) = ($self->{w}, $self->{h}); |
|
|
1534 | |
|
|
1535 | if ($self->{rot90}) { |
|
|
1536 | glRotate 90, 0, 0, 1; |
|
|
1537 | glTranslate 0, -$self->{w}, 0; |
|
|
1538 | |
|
|
1539 | ($w, $h) = ($h, $w); |
|
|
1540 | } |
|
|
1541 | |
|
|
1542 | glEnable GL_BLEND; |
|
|
1543 | glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; |
|
|
1544 | glEnable GL_TEXTURE_2D; |
|
|
1545 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; |
|
|
1546 | |
|
|
1547 | $tex->draw_quad (0, 0, $w, $h); |
|
|
1548 | |
|
|
1549 | glDisable GL_BLEND; |
|
|
1550 | glDisable GL_TEXTURE_2D; |
1461 | } |
1551 | } |
1462 | |
1552 | |
1463 | ############################################################################# |
1553 | ############################################################################# |
1464 | |
1554 | |
1465 | package CFClient::UI::VGauge; |
1555 | package CFClient::UI::VGauge; |
… | |
… | |
1593 | $self->add ($self->{max} = new CFClient::UI::Label valign => 1, align => 0, template => "999"); |
1683 | $self->add ($self->{max} = new CFClient::UI::Label valign => 1, align => 0, template => "999"); |
1594 | |
1684 | |
1595 | $self |
1685 | $self |
1596 | } |
1686 | } |
1597 | |
1687 | |
|
|
1688 | sub set_fontsize { |
|
|
1689 | my ($self, $fsize) = @_; |
|
|
1690 | |
|
|
1691 | $self->{value}->set_fontsize ($fsize); |
|
|
1692 | $self->{max} ->set_fontsize ($fsize); |
|
|
1693 | } |
|
|
1694 | |
1598 | sub set_value { |
1695 | sub set_value { |
1599 | my ($self, $val, $max) = @_; |
1696 | my ($self, $val, $max) = @_; |
1600 | |
1697 | |
1601 | $self->set_max ($max) |
1698 | $self->set_max ($max) |
1602 | if defined $max; |
1699 | if defined $max; |
… | |
… | |
2027 | } |
2124 | } |
2028 | |
2125 | |
2029 | sub add { |
2126 | sub add { |
2030 | my ($self, $child) = @_; |
2127 | my ($self, $child) = @_; |
2031 | |
2128 | |
|
|
2129 | # integerize window positions |
|
|
2130 | $child->{x} = int $child->{x}; |
|
|
2131 | $child->{y} = int $child->{y}; |
|
|
2132 | |
2032 | $self->SUPER::add ($child); |
2133 | $self->SUPER::add ($child); |
2033 | } |
2134 | } |
2034 | |
2135 | |
2035 | sub on_refresh { |
2136 | sub on_refresh { |
2036 | my ($self, $id, $cb) = @_; |
2137 | my ($self, $id, $cb) = @_; |