package CFClient::UI; use strict; use Scalar::Util (); use List::Util (); use CFClient; our ($FOCUS, $HOVER, $GRAB); # various widgets our $TOPLEVEL; our $BUTTON_STATE; # class methods for events sub feed_sdl_key_down_event { $FOCUS->key_down ($_[0]) if $FOCUS; } sub feed_sdl_key_up_event { $FOCUS->key_up ($_[0]) if $FOCUS; } sub feed_sdl_button_down_event { my ($ev) = @_; my ($x, $y) = ($ev->motion_x, $ev->motion_y); if (!$BUTTON_STATE) { my $widget = $TOPLEVEL->find_widget ($x, $y); $GRAB = $widget; $GRAB->update if $GRAB; } $BUTTON_STATE |= 1 << ($ev->button - 1); $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB; } sub feed_sdl_button_up_event { my ($ev) = @_; my ($x, $y) = ($ev->motion_x, $ev->motion_y); my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y); $BUTTON_STATE &= ~(1 << ($ev->button - 1)); $GRAB->button_up ($ev, $GRAB->translate ($x, $y)) if $GRAB; if (!$BUTTON_STATE) { my $grab = $GRAB; undef $GRAB; $grab->update if $grab; $GRAB->update if $GRAB; } } sub feed_sdl_motion_event { my ($ev) = @_; my ($x, $y) = ($ev->motion_x, $ev->motion_y); my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y); if ($widget != $HOVER) { my $hover = $HOVER; $HOVER = $widget; $hover->update if $hover; $HOVER->update if $HOVER; } $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER; } ############################################################################# package CFClient::UI::Base; use strict; use SDL::OpenGL; sub new { my $class = shift; my $self = bless { x => 0, y => 0, z => 0, w => -1, h => -1, @_ }, $class; for (keys %$self) { if (/^connect_(.*)$/) { $self->connect ($1 => delete $self->{$_}); } } $self } sub move { my ($self, $x, $y, $z) = @_; $self->{x} = $x; $self->{y} = $y; $self->{z} = $z if defined $z; } sub needs_redraw { 0 } sub size_request { require Carp; Carp::confess "size_request is abtract"; } sub _size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->{x} = $x; $self->{y} = $y; return unless $self->{w} != $w || $self->{h} != $h; $self->{w} = $w; $self->{h} = $h; 1 } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h); } # translate global coordinates to local coordinate system sub translate { my ($self, $x, $y) = @_; $self->{parent}->translate ($x - $self->{x}, $y - $self->{y}); } sub focus_in { my ($self) = @_; return if $FOCUS == $self; my $focus = $FOCUS; $FOCUS = $self; $focus->update if $focus; $FOCUS->update; } sub focus_out { my ($self) = @_; return unless $FOCUS == $self; my $focus = $FOCUS; undef $FOCUS; $focus->update if $focus; #? } sub mouse_motion { } sub button_up { } sub key_down { } sub key_up { } sub button_down { my ($self, $ev, $x, $y) = @_; $self->focus_in; } sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } sub draw { my ($self) = @_; return unless $self->{h} && $self->{w}; glPushMatrix; glTranslate $self->{x}, $self->{y}, 0; $self->_draw; glPopMatrix; if ($self == $HOVER) { my ($x, $y) = @$self{qw(x y)}; glColor 0, 0, 1, 0.2; glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glBegin GL_QUADS; glVertex $x , $y; glVertex $x + $self->{w}, $y; glVertex $x + $self->{w}, $y + $self->{h}; glVertex $x , $y + $self->{h}; glEnd; glDisable GL_BLEND; } } sub _draw { my ($self) = @_; warn "no draw defined for $self\n"; } sub find_widget { my ($self, $x, $y) = @_; return $self if $x >= $self->{x} && $x < $self->{x} + $self->{w} && $y >= $self->{y} && $y < $self->{y} + $self->{h}; () } sub set_parent { my ($self, $par) = @_; $self->{parent} = $par; Scalar::Util::weaken $self->{parent}; } sub get_parent { $_[0]->{parent} } sub update { my ($self) = @_; $self->{parent}->update if $self->{parent}; } sub connect { my ($self, $signal, $cb) = @_; push @{ $self->{cb}{$signal} }, $cb; } sub emit { my ($self, $signal, @args) = @_; $_->($self, @args) for @{$self->{cb}{$signal} || []}; } sub DESTROY { my ($self) = @_; #$self->deactivate; } ############################################################################# package CFClient::UI::DrawBG; our @ISA = CFClient::UI::Base::; use strict; use SDL::OpenGL; sub new { my $class = shift; # range [value, low, high, page] $class->SUPER::new ( bg => [0, 0, 0, 0.2], active_bg => [1, 1, 1, 0.5], @_ ) } sub _draw { my ($self) = @_; my ($w, $h) = @$self{qw(w h)}; glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} }; glBegin GL_QUADS; glVertex 0 , 0; glVertex 0 , $h; glVertex $w, $h; glVertex $w, 0; glEnd; glDisable GL_BLEND; } ############################################################################# package CFClient::UI::Empty; our @ISA = CFClient::UI::Base::; sub size_request { (0, 0) } sub draw { } ############################################################################# package CFClient::UI::Container; our @ISA = CFClient::UI::Base::; sub new { my ($class, %arg) = @_; my $children = delete $arg{children} || []; my $self = $class->SUPER::new (children => [], %arg); $self->add ($_) for @$children; $self } sub add { my ($self, $chld) = @_; $chld->set_parent ($self); $self->{children} = [ sort { $a->{z} <=> $b->{z} } @{$self->{children}}, $chld ]; $self->{w} = $self->{h} = -1; $self->update; } sub remove { my ($self, $widget) = @_; $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ]; $self->size_allocate (0, 0, $self->{w}, $self->{h}); } sub find_widget { my ($self, $x, $y) = @_; $x -= $self->{x}; $y -= $self->{y}; my $res; for (reverse @{ $self->{children} }) { $res = $_->find_widget ($x, $y) and return $res; } $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) } sub _draw { my ($self) = @_; $_->draw for @{$self->{children}}; } ############################################################################# package CFClient::UI::Bin; our @ISA = CFClient::UI::Container::; sub new { my ($class, %arg) = @_; my $child = (delete $arg{child}) || new CFClient::UI::Empty::; $class->SUPER::new (children => [$child], %arg) } sub add { my ($self, $widget) = @_; $self->{children} = []; $self->SUPER::add ($widget); } sub remove { my ($self, $widget) = @_; $self->SUPER::remove ($widget); $self->{children} = [new CFClient::UI::Empty] unless @{$self->{children}}; } sub child { $_[0]->{children}[0] } sub size_request { $_[0]{children}[0]->size_request } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; $self->{children}[0]->size_allocate (0, 0, $w, $h); } ############################################################################# package CFClient::UI::Window; our @ISA = CFClient::UI::Bin::; use SDL::OpenGL; sub new { my ($class, %arg) = @_; my $self = $class->SUPER::new (%arg); } sub update { my ($self) = @_; # we want to do this delayed... $self->render_chld; $self->SUPER::update; } sub render_chld { my ($self) = @_; $self->{texture} = CFClient::Texture->new_from_opengl ( $self->{w}, $self->{h}, sub { $self->child->draw } ); } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; $self->child->size_allocate (0, 0, $w, $h); $self->render_chld; } sub _draw { my ($self) = @_; my ($w, $h) = ($self->w, $self->h); my $tex = $self->{texture} or return; glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glEnable GL_TEXTURE_2D; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; $tex->draw_quad (0, 0, $w, $h); glDisable GL_BLEND; glDisable GL_TEXTURE_2D; } ############################################################################# package CFClient::UI::Frame; our @ISA = CFClient::UI::Bin::; use SDL::OpenGL; sub size_request { my ($self) = @_; my $chld = $self->child or return (0, 0); $chld->move (2, 2); map { $_ + 4 } $chld->size_request; } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; $self->child->size_allocate (2, 2, $w - 4, $h - 4); } sub _draw { my ($self) = @_; my $chld = $self->child; my ($w, $h) = $chld->size_request; glBegin GL_QUADS; glColor 0, 0, 0; glVertex 0 , 0; glVertex 0 , $h + 4; glVertex $w + 4 , $h + 4; glVertex $w + 4 , 0; glEnd; $chld->draw; } ############################################################################# package CFClient::UI::FancyFrame; our @ISA = CFClient::UI::Bin::; use SDL::OpenGL; my @tex = map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); sub size_request { my ($self) = @_; return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h}; my ($w, $h) = $self->SUPER::size_request; $h += $tex[1]->{h}; $h += $tex[4]->{h}; $w += $tex[2]->{w}; $w += $tex[3]->{w}; ($w, $h) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; $h -= $tex[1]{h}; $h -= $tex[4]{h}; $w -= $tex[2]{w}; $w -= $tex[3]{w}; $h = $h < 0 ? 0 : $h; $w = $w < 0 ? 0 : $w; my $child = $self->child; $child->size_allocate ($tex[3]->{w}, $tex[1]->{h}, $w, $h); } sub button_down { my ($self, $ev, $x, $y) = @_; if ($x < $self->{w} && $x >= $self->{w} - $tex[2]{w} && $y < $self->{h} && $y >= $self->{h} - $tex[4]{h}) { my ($ox, $oy) = ($ev->button_x, $ev->button_y); my ($bw, $bh) = ($self->{w}, $self->{h}); $self->{motion} = sub { my ($ev, $x, $y) = @_; ($x, $y) = ($ev->motion_x, $ev->motion_y); $self->{user_w} = $bw + $x - $ox; $self->{user_h} = $bh + $y - $oy; $self->update; }; } elsif ($x >= 0 && $x < $self->{w} && $y >= 0 && $y < $tex[1]{h}) { my ($ox, $oy) = ($ev->button_x, $ev->button_y); my ($bx, $by) = ($self->{x}, $self->{y}); $self->{motion} = sub { my ($ev, $x, $y) = @_; ($x, $y) = ($ev->motion_x, $ev->motion_y); $self->move ($bx + $x - $ox, $by + $y - $oy); $self->update; }; } } sub button_up { my ($self, $ev, $x, $y) = @_; delete $self->{motion}; } sub mouse_motion { my ($self, $ev, $x, $y) = @_; $self->{motion}->($ev, $x, $y) if $self->{motion}; } sub _draw { my ($self) = @_; my ($w, $h) = ($self->{w}, $self->{h}); my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glEnable GL_TEXTURE_2D; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; my $top = $tex[1]; $top->draw_quad (0, 0, $w, $top->{h}); my $left = $tex[3]; $left->draw_quad (0, $top->{h}, $left->{w}, $ch); my $right = $tex[2]; $right->draw_quad ($w - $right->{w}, $top->{h}, $right->{w}, $ch); my $bottom = $tex[4]; $bottom->draw_quad (0, $h - $bottom->{h}, $w, $bottom->{h}); my $bg = $tex[0]; glBindTexture GL_TEXTURE_2D, $bg->{name}; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; my $rep_x = $cw / $bg->{w}; my $rep_y = $ch / $bg->{h}; $bg->draw_quad ($left->{w}, $top->{h}, $cw, $ch); glDisable GL_TEXTURE_2D; glDisable GL_BLEND; $self->child->draw; } ############################################################################# package CFClient::UI::Table; our @ISA = CFClient::UI::Base::; use List::Util qw(max sum); use SDL::OpenGL; sub new { my $class = shift; $class->SUPER::new ( col_expand => [], @_ ) } sub add { my ($self, $x, $y, $chld) = @_; $self->{children}[$y][$x] = $chld; $chld->set_parent ($self); $self->{w} = $self->{h} = -1; $self->update; } sub get_wh { my ($self) = @_; my (@w, @h); for my $y (0 .. $#{$self->{children}}) { my $row = $self->{children}[$y] or next; for my $x (0 .. $#$row) { my $widget = $row->[$x] or next; my ($w, $h) = $widget->size_request; $w[$x] = max $w[$x], $w; $h[$y] = max $h[$y], $h; } } (\@w, \@h) } sub size_request { my ($self) = @_; my ($ws, $hs) = $self->get_wh; ( (sum @$ws), (sum @$hs), ) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; my ($ws, $hs) = $self->get_wh; my $req_w = sum @$ws; my $req_h = sum @$hs; # TODO: nicer code && do row_expand my @col_expand = @{$self->{col_expand}}; @col_expand = (1) x @$ws unless @col_expand; my $col_expand = (sum @col_expand) || 1; # linearly scale sizes $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs; my $y; for my $r (0 .. $#{$self->{children}}) { my $row = $self->{children}[$r] or next; my $x = 0; my $row_h = $hs->[$r]; for my $c (0 .. $#$row) { my $col_w = $ws->[$c]; if (my $widget = $row->[$c]) { $widget->size_allocate ($x, $y, $col_w, $row_h); } $x += $col_w; } $y += $row_h; } } sub find_widget { my ($self, $x, $y) = @_; $x -= $self->{x}; $y -= $self->{y}; my $res; for (grep $_, map @$_, grep $_, @{ $self->{children} }) { $res = $_->find_widget ($x, $y) and return $res; } $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) } sub _draw { my ($self) = @_; for (grep $_, @{$self->{children}}) { $_->draw for grep $_, @$_; } } ############################################################################# package CFClient::UI::HBox; # TODO: wrap into common Box base class our @ISA = CFClient::UI::Container::; sub size_request { my ($self) = @_; my @alloc = map [$_->size_request], @{$self->{children}}; ( (List::Util::sum map $_->[0], @alloc), (List::Util::max map $_->[1], @alloc), ) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h); ($h, $w) = ($w, $h); my $children = $self->{children}; my @h = map +($_->size_request)[0], @$children; my $req_h = List::Util::sum @h; if ($req_h > $h) { # ah well, not enough space $_ *= $h / $req_h for @h; } else { my $exp = List::Util::sum map $_->{expand}, @$children; $exp ||= 1; for (0 .. $#$children) { my $child = $children->[$_]; my $alloc_h = $h[$_]; $alloc_h += ($h - $req_h) * $child->{expand} / $exp; $h[$_] = $alloc_h; } } my $y = 0; for (0 .. $#$children) { my $child = $children->[$_]; my $h = $h[$_]; $child->size_allocate ($y, 0, $h, $w); $y += $h; } } ############################################################################# package CFClient::UI::VBox; # TODO: wrap into common Box base class our @ISA = CFClient::UI::Container::; sub size_request { my ($self) = @_; my @alloc = map [$_->size_request], @{$self->{children}}; ( (List::Util::max map $_->[0], @alloc), (List::Util::sum map $_->[1], @alloc), ) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h); my $children = $self->{children}; my @h = map +($_->size_request)[1], @$children; my $req_h = List::Util::sum @h; if ($req_h > $h) { # ah well, not enough space $_ *= $h / $req_h for @h; } else { my $exp = List::Util::sum map $_->{expand}, @$children; $exp ||= 1; for (0 .. $#$children) { my $child = $children->[$_]; $h[$_] += ($h - $req_h) * $child->{expand} / $exp; } } my $y = 0; for (0 .. $#$children) { my $child = $children->[$_]; my $h = $h[$_]; $child->size_allocate (0, $y, $w, $h); $y += $h; } } ############################################################################# package CFClient::UI::Label; our @ISA = CFClient::UI::Base::; use SDL::OpenGL; sub new { my ($class, %arg) = @_; my $self = $class->SUPER::new ( fg => [1, 1, 1], height => $::FONTSIZE, text => "", align => -1, padding => 2, layout => new CFClient::Layout, %arg ); $self->set_text ($self->{text}); $self } sub escape_text { local $_ = $_[1]; s/&/&/g; s/>/>/g; s/{text} = $text; $self->{layout}->set_markup ($text); delete $self->{texture}; # $self->{w} = $self->{h} = -1; $self->update; } sub get_text { my ($self, $text) = @_; $self->{text} } sub size_request { my ($self) = @_; $self->{layout}->set_width; $self->{layout}->set_height ($self->{height}); my ($w, $h) = $self->{layout}->size; ( $w + $self->{padding} * 2, $h + $self->{padding} * 2, ) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h) or return; delete $self->{texture}; } sub update { my ($self) = @_; delete $self->{texture}; $self->SUPER::update; } sub _draw { my ($self) = @_; my $tex = $self->{texture} ||= do { $self->{layout}->set_width ($self->{w}); $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height}); new_from_layout CFClient::Texture $self->{layout} }; glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glEnable GL_TEXTURE_2D; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; glColor @{$self->{fg}}; my $x = $self->{align} < 0 ? $self->{padding} : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} : ($self->{w} - $tex->{w}) * 0.5; glTranslate $x, ($self->{h} - $tex->{h}) * 0.5, 0; $tex->draw_quad (0, 0); glDisable GL_TEXTURE_2D; glDisable GL_BLEND; } ############################################################################# package CFClient::UI::Entry; our @ISA = CFClient::UI::Label::; use SDL; use SDL::OpenGL; sub new { my $class = shift; $class->SUPER::new ( fg => [1, 1, 1], bg => [0, 0, 0, 0.2], active_bg => [1, 1, 1, 0.5], active_fg => [0, 0, 0], @_ ) } sub _set_text { my ($self, $text) = @_; $self->{last_activity} = $::NOW; $self->{text} = $text; $self->{layout}->set_width ($self->{w}); $self->{layout}->set_height (List::Util::min $self->{h} - $self->{padding} * 2, $self->{height}); $text =~ s/./*/g if $self->{hidden}; $self->{layout}->set_markup ($self->escape_text ($text) . " "); $text = substr $text, 0, $self->{cursor}; utf8::encode $text; @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text); } sub size_request { my ($self) = @_; my ($w, $h) = $self->SUPER::size_request; ($w + 1, $h) # add 1 for cursor } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->SUPER::size_allocate ($x, $y, $w, $h); $self->_set_text ($self->{text}); } sub set_text { my ($self, $text) = @_; $self->{cursor} = length $text; $self->_set_text ($text); $self->update; } sub key_down { my ($self, $ev) = @_; my $mod = $ev->key_mod; my $sym = $ev->key_sym; my $uni = $ev->key_unicode; my $text = $self->get_text; if ($sym == SDLK_BACKSPACE) { substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; } elsif ($sym == SDLK_DELETE) { substr $text, $self->{cursor}, 1, ""; } elsif ($sym == SDLK_LEFT) { --$self->{cursor} if $self->{cursor}; } elsif ($sym == SDLK_RIGHT) { ++$self->{cursor} if $self->{cursor} < length $self->{text}; } elsif ($sym == SDLK_HOME) { $self->{cursor} = 0; } elsif ($sym == SDLK_END) { $self->{cursor} = length $text; } elsif ($uni) { substr $text, $self->{cursor}++, 0, chr $uni; } $self->_set_text ($text); $self->update; } sub focus_in { my ($self) = @_; $self->{last_activity} = $::NOW; $self->SUPER::focus_in; } sub button_down { my ($self, $ev, $x, $y) = @_; $self->SUPER::button_down ($ev, $x, $y); my $idx = $self->{layout}->xy_to_index ($x, $y); # byte-index to char-index my $text = $self->{text}; utf8::encode $text; $self->{cursor} = length substr $text, 0, $idx; $self->_set_text ($self->{text}); $self->update; } sub mouse_motion { my ($self, $ev, $x, $y) = @_; # printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# } sub _draw { my ($self) = @_; local $self->{fg} = $self->{fg}; if ($FOCUS == $self) { glColor @{$self->{active_bg}}; $self->{fg} = $self->{active_fg}; } else { glColor @{$self->{bg}}; } glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glBegin GL_QUADS; glVertex 0 , 0; glVertex 0 , $self->{h}; glVertex $self->{w}, $self->{h}; glVertex $self->{w}, 0; glEnd; glDisable GL_BLEND; $self->SUPER::_draw; #TODO: force update every cursor change :( if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) { glColor @{$self->{fg}}; glBegin GL_LINES; glVertex $self->{cur_x}, $self->{cur_y}; glVertex $self->{cur_x}, $self->{cur_y} + $self->{cur_h}; glEnd; } } ############################################################################# package CFClient::UI::Button; our @ISA = CFClient::UI::Label::; use SDL; use SDL::OpenGL; my @tex = map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } qw(b1_button_active.png); sub new { my $class = shift; $class->SUPER::new ( padding => 4, fg => [1, 1, 1], bg => [1, 1, 1, 0.2], active_fg => [1, 1, 0], # active_bg => [0, 0, 0, 0.5], # border_fg => [1, 1, 0], @_ ) } sub button_up { my ($self, $ev, $x, $y) = @_; if ($x >= 0 && $x < $self->{w} && $y >= 0 && $y < $self->{h}) { $self->emit ("activate"); } } sub _draw { my ($self) = @_; local $self->{fg} = $self->{fg}; my $tex = $tex[0]; glEnable GL_BLEND; glEnable GL_TEXTURE_2D; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; if ($GRAB == $self) { $self->{fg} = $self->{active_fg}; } glBindTexture GL_TEXTURE_2D, $tex->{name}; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; $tex->draw_quad (0, 0, $self->{w}, $self->{h}); glDisable GL_TEXTURE_2D; glDisable GL_BLEND; $self->SUPER::_draw; } ############################################################################# package CFClient::UI::CheckBox; our @ISA = CFClient::UI::DrawBG::; use SDL; use SDL::OpenGL; my @tex = map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } qw(b1_button_active.png); sub new { my $class = shift; $class->SUPER::new ( padding => 4, fg => [1, 1, 1], active_fg => [1, 1, 0], state => 0, @_ ) } sub button_down { my ($self, $ev, $x, $y) = @_; if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { $self->{state} = !$self->{state}; $self->emit ("changed"); } } sub _draw { my ($self) = @_; local $self->{fg} = $self->{fg}; my $tex = $tex[0]; glEnable GL_BLEND; glEnable GL_TEXTURE_2D; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; if ($GRAB == $self) { $self->{fg} = $self->{active_fg}; } glBindTexture GL_TEXTURE_2D, $tex->{name}; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; $tex->draw_quad (0, 0, $self->{w}, $self->{h}); glDisable GL_TEXTURE_2D; glDisable GL_BLEND; $self->SUPER::_draw; } ############################################################################# package CFClient::UI::Slider; use strict; use SDL::OpenGL; our @ISA = CFClient::UI::DrawBG::; sub new { my $class = shift; # range [value, low, high, page] my $self = $class->SUPER::new ( fg => [1, 1, 1], active_fg => [0, 0, 0], range => [0, 0, 100, 10], req_w => 40, req_h => 10, vertical => 0, @_ ); $self } sub size_request { my ($self) = @_; my $w = $self->{req_w}; my $h = $self->{req_h}; $self->{vertical} ? ($h, $w) : ($w, $h) } sub button_down { my ($self, $ev, $x, $y) = @_; $self->SUPER::button_down ($ev, $x, $y); $self->mouse_motion ($ev, $x, $y); } sub mouse_motion { my ($self, $ev, $x, $y) = @_; if ($GRAB == $self) { my ($value, $lo, $hi, $page) = @{$self->{range}}; my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); $x = $x * ($hi - $lo) / $w + $lo; $x = $lo if $x < $lo; $x = $hi - $page if $x > $hi - $page; $self->{range}[0] = $x; $self->emit (changed => $x); $self->update; } } sub _draw { my ($self) = @_; $self->SUPER::_draw (); my ($w, $h) = @$self{qw(w h)}; if ($self->{vertical}) { # draw a vertical slider like a rotated horizontal slider glRotate 90, 0, 0, 1; glTranslate 0, -$self->{w}, 0; ($w, $h) = ($h, $w); } my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg}; my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg}; my ($value, $lo, $hi, $page) = @{$self->{range}}; $page = int $page * $w / ($hi - $lo); $value = int +($value - $lo) * $w / ($hi - $lo); $w -= $page; $page &= ~1; glTranslate $page * 0.5, 0, 0; $page ||= 2; glColor @$fg; glBegin GL_LINES; glVertex 0, 0; glVertex 0, $h; glVertex $w - 1, 0; glVertex $w - 1, $h; glVertex 0, $h * 0.5; glVertex $w, $h * 0.5; glEnd; my $knob_a = $value - $page * 0.5; my $knob_b = $value + $page * 0.5; glBegin GL_QUADS; glColor @$fg; glVertex $knob_a, 0; glVertex $knob_a, $h; glVertex $knob_b, $h; glVertex $knob_b, 0; if ($knob_a < $knob_b - 2) { glColor @$bg; glVertex $knob_a + 1, 1; glVertex $knob_a + 1, $h - 1; glVertex $knob_b - 1, $h - 1; glVertex $knob_b - 1, 1; } glEnd; } ############################################################################# package CFClient::UI::MapWidget; use strict; use List::Util qw(min max); use SDL; use SDL::OpenGL; our @ISA = CFClient::UI::Base::; sub new { my $class = shift; $class->SUPER::new ( z => -1, list => (glGenLists 1), @_ ) } sub key_down { print "MAPKEYDOWN\n"; } sub key_up { } sub size_request { ( 1 + 32 * int $::WIDTH / 32, 1 + 32 * int $::HEIGHT / 32, ) } sub update { my ($self) = @_; $self->{need_update} = 1; $self->SUPER::update; } sub draw { my ($self) = @_; if (delete $self->{need_update}) { glNewList $self->{list}, GL_COMPILE; my $mx = $::CONN->{mapx}; my $my = $::CONN->{mapy}; my $map = $::CONN->{map}; my ($xofs, $yofs); my $sw = 1 + int $::WIDTH / 32; my $sh = 1 + int $::HEIGHT / 32; if ($::CONN->{mapw} > $sw) { $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5; } else { $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs}; } if ($::CONN->{maph} > $sh) { $yofs = $my + ($::CONN->{maph} - $sh) * 0.5; } else { $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs}; } glEnable GL_TEXTURE_2D; glEnable GL_BLEND; glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; my $sw4 = ($sw + 3) & ~3; my $darkness = "\x00" x ($sw4 * $sh); for my $x (0 .. $sw - 1) { my $row = $map->[$x + $xofs]; for my $y (0 .. $sh - 1) { my $cell = $row->[$y + $yofs] or next; my $dark = $cell->[0]; if ($dark < 0) { substr $darkness, $y * $sw4 + $x, 1, chr 224; } else { substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark; } for my $num (grep $_, @$cell[1,2,3]) { my $tex = $::CONN->{face}[$num]{texture} || next; my ($w, $h) = @$tex{qw(w h)}; $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h); } } } # if (1) { # higher quality darkness # $lighting =~ s/(.)/$1$1$1/gs; # my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3; # # $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear"); # # $lighting = $pb->get_pixels; # $lighting =~ s/(.)../$1/gs; # } glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; $darkness = new CFClient::Texture w => $sw4, h => $sh, data => $darkness, internalformat => GL_ALPHA, format => GL_ALPHA; glColor 0.45, 0.45, 0.45, 1; $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32); glDisable GL_TEXTURE_2D; glDisable GL_BLEND; glEndList; } glCallList $self->{list}; } my %DIR = ( SDLK_KP8, [1, "north"], SDLK_KP9, [2, "northeast"], SDLK_KP6, [3, "east"], SDLK_KP3, [4, "southeast"], SDLK_KP2, [5, "south"], SDLK_KP1, [6, "southwest"], SDLK_KP4, [7, "west"], SDLK_KP7, [8, "northwest"], SDLK_UP, [1, "north"], SDLK_RIGHT, [3, "east"], SDLK_DOWN, [5, "south"], SDLK_LEFT, [7, "west"], ); sub key_down { my ($self, $ev) = @_; my $mod = $ev->key_mod; my $sym = $ev->key_sym; if ($sym == SDLK_KP5) { $::CONN->send ("command stay fire"); } elsif ($sym == SDLK_a) { $::CONN->send ("command apply"); } elsif (exists $DIR{$sym}) { if ($mod & KMOD_SHIFT) { $self->{shft}++; $::CONN->send ("command fire $DIR{$sym}[0]"); } elsif ($mod & KMOD_CTRL) { $self->{ctrl}++; $::CONN->send ("command run $DIR{$sym}[0]"); } else { $::CONN->send ("command $DIR{$sym}[1]"); } } } sub key_up { my ($self, $ev) = @_; my $mod = $ev->key_mod; my $sym = $ev->key_sym; if (!($mod & KMOD_SHIFT) && delete $self->{shft}) { $::CONN->send ("command fire_stop"); } if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) { $::CONN->send ("command run_stop"); } } ############################################################################# package CFClient::UI::Animator; use SDL::OpenGL; our @ISA = CFClient::UI::Bin::; sub moveto { my ($self, $x, $y) = @_; $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; $self->{speed} = 0.001; $self->{time} = 1; ::animation_start $self; } sub animate { my ($self, $interval) = @_; $self->{time} -= $interval * $self->{speed}; if ($self->{time} <= 0) { $self->{time} = 0; ::animation_stop $self; } my ($x0, $y0, $x1, $y1) = @{$self->{moveto}}; $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time}); $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time}); } sub _draw { my ($self) = @_; glPushMatrix; glRotate $self->{time} * 1000, 0, 1, 0; $self->{children}[0]->draw; glPopMatrix; } ############################################################################# package CFClient::UI::Toplevel; our @ISA = CFClient::UI::Container::; sub size_request { ($::WIDTH, $::HEIGHT) } sub size_allocate { my ($self, $x, $y, $w, $h) = @_; $self->_size_allocate ($x, $y, $w, $h); $_->size_allocate ($_->{x}, $_->{y}, $_->size_request) for @{$self->{children}}; } sub translate { my ($self, $x, $y) = @_; ($x, $y) } sub update { my ($self) = @_; $self->size_allocate (0, 0, $::WIDTH, $::HEIGHT); ::refresh (); } sub add { my ($self, $widget) = @_; $self->SUPER::add ($widget); $widget->size_allocate ($widget->{x}, $widget->{y}, $widget->size_request); } sub draw { my ($self) = @_; $self->_draw; } ############################################################################# package CFClient::UI; $TOPLEVEL = new CFClient::UI::Toplevel; 1