Deliantra-Client/DC/UI.pm

package CFPlus::UI;

use utf8;
use strict;

use List::Util ();
use Event;

use CFPlus;
use CFPlus::Pod;
use CFPlus::Texture;

our ($FOCUS, $HOVER, $GRAB); # various widgets

our $LAYOUT;
our $ROOT;
our $TOOLTIP;
our $BUTTON_STATE;

our %WIDGET; # all widgets, weak-referenced

our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
   if (!$GRAB) {
      for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
         if (length $widget->{tooltip}) {
            if ($TOOLTIP->{owner} != $widget) {
               $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
               $TOOLTIP->hide;

               $TOOLTIP->{owner} = $widget;
               $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};

               return if $ENV{CFPLUS_DEBUG} & 8;

               my $tip = $widget->{tooltip};

               $tip = $tip->($widget) if CODE:: eq ref $tip;
               
               $TOOLTIP->set_tooltip_from ($widget);
               $TOOLTIP->show;
            }

            return;
         }
      }
   }

   $TOOLTIP->hide;
   $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
   delete $TOOLTIP->{owner};
});

sub get_layout {
   my $layout;

   for (grep { $_->{name} } values %WIDGET) {
      my $win = $layout->{$_->{name}} = { };
      
      $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH   if $_->{x} =~ /^[0-9.]+$/;
      $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT  if $_->{y} =~ /^[0-9.]+$/;
      $win->{w} = $_->{w} / $::WIDTH                     if defined $_->{w};
      $win->{h} = $_->{h} / $::HEIGHT                    if defined $_->{h};

      $win->{show} = $_->{visible} && $_->{is_toplevel};
   }

   $layout
}

sub set_layout {
   my ($layout) = @_;

   $LAYOUT = $layout;
}

# class methods for events
sub feed_sdl_key_down_event { 
   $FOCUS->emit (key_down => $_[0])
      if $FOCUS;
}

sub feed_sdl_key_up_event {
   $FOCUS->emit (key_up => $_[0])
      if $FOCUS;
}

sub check_hover {
   my ($widget) = @_;

   if ($widget != $HOVER) {
      my $hover = $HOVER; $HOVER = $widget;

      $hover->update if $hover && $hover->{can_hover};
      $HOVER->update if $HOVER && $HOVER->{can_hover};

      $TOOLTIP_WATCHER->start;
   }
}

sub feed_sdl_button_down_event {
   my ($ev) = @_;
   my ($x, $y) = ($ev->{x}, $ev->{y});

   $BUTTON_STATE |= 1 << ($ev->{button} - 1);

   unless ($GRAB) {
      my $widget = $ROOT->find_widget ($x, $y);

      $GRAB = $widget;
      $GRAB->update if $GRAB;

      $TOOLTIP_WATCHER->cb->();
   }

   if ($GRAB) {
      if ($ev->{button} == 4 || $ev->{button} == 5) {
         # mousewheel
         $ev->{dx} = 0;
         $ev->{dy} = $ev->{button} * 2 - 9;
         $GRAB->emit (mouse_wheel => $ev);
      } else {
         $GRAB->emit (button_down => $ev)
      }
   }
}

sub feed_sdl_button_up_event {
   my ($ev) = @_;

   my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});

   $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));

   $GRAB->emit (button_up => $ev)
      if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;

   unless ($BUTTON_STATE) {
      my $grab = $GRAB; undef $GRAB;
      $grab->update if $grab;
      $GRAB->update if $GRAB;

      check_hover $widget;
      $TOOLTIP_WATCHER->cb->();
   }
}

sub feed_sdl_motion_event {
   my ($ev) = @_;
   my ($x, $y) = ($ev->{x}, $ev->{y});

   my $widget = $GRAB || $ROOT->find_widget ($x, $y);

   check_hover $widget;

   $HOVER->emit (mouse_motion => $ev)
      if $HOVER;
}

# convert position array to integers
sub harmonize {
   my ($vals) = @_;

   my $rem = 0;

   for (@$vals) {
      my $i = int $_ + $rem;
      $rem += $_ - $i;
      $_ = $i;
   }
}

sub full_refresh {
   # make a copy, otherwise for complains about freed values.
   my @widgets = values %WIDGET;

   $_->update
      for @widgets;
}

sub reconfigure_widgets {
   # make a copy, otherwise C<for> complains about freed values.
   my @widgets = values %WIDGET;

   $_->reconfigure
      for @widgets;
}

# call when resolution changes etc.
sub rescale_widgets {
   my ($sx, $sy) = @_;

   for my $widget (values %WIDGET) {
      if ($widget->{is_toplevel}) {
         $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
         $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;

         $widget->{x}       = int 0.5 + $widget->{x}        * $sx if $widget->{x} =~ /^[0-9.]+$/;
         $widget->{w}       = int 0.5 + $widget->{w}        * $sx if exists $widget->{w};
         $widget->{force_w} = int 0.5 + $widget->{force_w}  * $sx if exists $widget->{force_w};
         $widget->{y}       = int 0.5 + $widget->{y}        * $sy if $widget->{y} =~ /^[0-9.]+$/;
         $widget->{h}       = int 0.5 + $widget->{h}        * $sy if exists $widget->{h};
         $widget->{force_h} = int 0.5 + $widget->{force_h}  * $sy if exists $widget->{force_h};

         $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
         $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;

      }
   }

   reconfigure_widgets;
}

#############################################################################

package CFPlus::UI::Event;

sub xy {
   $_[1]->coord2local ($_[0]{x}, $_[0]{y})
}

#############################################################################

package CFPlus::UI::Base;

use strict;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   my $self = bless {
      x          => "center",
      y          => "center",
      z          => 0,
      w          => undef,
      h          => undef,
      can_events => 1,
      @_
   }, $class;

   CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self);

   for (keys %$self) {
      if (/^on_(.*)$/) {
         $self->connect ($1 => delete $self->{$_});
      }
   }

   if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) {
      $self->{x}       = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x};
      $self->{y}       = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y};
      $self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w};
      $self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h};

      $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
      $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};

      $self->show if $layout->{show};
   }

   $self
}

sub destroy {
   my ($self) = @_;

   $self->hide;
   $self->emit ("destroy");
   %$self = ();
}

sub TO_JSON {
   { __widget_ref__ => $_[0]{s_id} }
}

sub show {
   my ($self) = @_;

   return if $self->{parent};

   $CFPlus::UI::ROOT->add ($self);
}

sub set_visible {
   my ($self) = @_;

   return if $self->{visible};

   $self->{root}    = $self->{parent}{root};
   $self->{visible} = $self->{parent}{visible} + 1;

   $self->emit (visibility_change => 1);

   $self->realloc if !exists $self->{req_w};

   $_->set_visible for $self->children;
}

sub set_invisible {
   my ($self) = @_;

   return unless $self->{visible};

   $_->set_invisible for $self->children;

   delete $self->{visible};
   delete $self->{root};

   undef $GRAB  if $GRAB  == $self;
   undef $HOVER if $HOVER == $self;

   $CFPlus::UI::TOOLTIP_WATCHER->cb->()
      if $TOOLTIP->{owner} == $self;

   $self->emit ("focus_out");
   $self->emit (visibility_change => 0);
}

sub set_visibility {
   my ($self, $visible) = @_;

   return if $self->{visible} == $visible;

   $visible ? $self->show
            : $self->hide;
}

sub toggle_visibility {
   my ($self) = @_;

   $self->{visible}
      ? $self->hide
      : $self->show;
}

sub hide {
   my ($self) = @_;

   $self->set_invisible;

   $self->{parent}->remove ($self)
      if $self->{parent};
}

sub move_abs {
   my ($self, $x, $y, $z) = @_;

   $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
   $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
   $self->{z} = $z if defined $z;

   $self->update;
}

sub set_size {
   my ($self, $w, $h) = @_;

   $self->{force_w} = $w;
   $self->{force_h} = $h;

   $self->realloc;
}

sub size_request {
   require Carp;
   Carp::confess "size_request is abstract";
}

sub baseline_shift {
   0
}

sub configure {
   my ($self, $x, $y, $w, $h) = @_;

   if ($self->{aspect}) {
      my ($ow, $oh) = ($w, $h);

      $w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
      $h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};

      # use alignment to adjust x, y

      $x += int 0.5 * ($ow - $w);
      $y += int 0.5 * ($oh - $h);
   }

   if ($self->{x} ne $x || $self->{y} ne $y) {
      $self->{x} = $x;
      $self->{y} = $y;
      $self->update;
   }

   if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
      return unless $self->{visible};

      $self->{alloc_w} = $w;
      $self->{alloc_h} = $h;

      $self->{root}{size_alloc}{$self+0} = $self;
   }
}

sub children {
   # nop
}

sub visible_children {
   $_[0]->children
}

sub set_max_size {
   my ($self, $w, $h) = @_;

   $self->{max_w} = int $w if defined $w;
   $self->{max_h} = int $h if defined $h;

   $self->realloc;
}

sub set_tooltip {
   my ($self, $tooltip) = @_;

   $tooltip =~ s/^\s+//;
   $tooltip =~ s/\s+$//;

   return if $self->{tooltip} eq $tooltip;

   $self->{tooltip} = $tooltip;

   if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
      delete $CFPlus::UI::TOOLTIP->{owner};
      $CFPlus::UI::TOOLTIP_WATCHER->cb->();
   }
}

# translate global coordinates to local coordinate system
sub coord2local {
   my ($self, $x, $y) = @_;

   Carp::confess unless $self->{parent};#d#

   $self->{parent}->coord2local ($x  - $self->{x}, $y - $self->{y})
}

# translate local coordinates to global coordinate system
sub coord2global {
   my ($self, $x, $y) = @_;

   Carp::confess unless $self->{parent};#d#

   $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
}

sub invoke_focus_in {
   my ($self) = @_;

   return if $FOCUS == $self;
   return unless $self->{can_focus};

   $FOCUS = $self;

   $self->update;

   0
}

sub invoke_focus_out {
   my ($self) = @_;

   return unless $FOCUS == $self;

   undef $FOCUS;

   $self->update;

   $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
      unless $FOCUS;

   0
}

sub grab_focus {
   my ($self) = @_;

   $FOCUS->emit ("focus_out") if $FOCUS;
   $self->emit ("focus_in");
}

sub invoke_mouse_motion { 0 }
sub invoke_button_up    { 0 }
sub invoke_key_down     { 0 }
sub invoke_key_up       { 0 }
sub invoke_mouse_wheel  { 0 }

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   $self->grab_focus;

   0
}

sub connect {
   my ($self, $signal, $cb) = @_;

   push @{ $self->{signal_cb}{$signal} }, $cb;

   defined wantarray and CFPlus::guard {
      @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
         @{ $self->{signal_cb}{$signal} };
   }
}

sub disconnect_all {
   my ($self, $signal) = @_;

   delete $self->{signal_cb}{$signal};
}

my %has_coords = (
   button_down  => 1,
   button_up    => 1,
   mouse_motion => 1,
   mouse_wheel  => 1,
);

sub emit {
   my ($self, $signal, @args) = @_;

   # I do not really like this solution, but I do not like duplication
   # and needlessly verbose code, either.
   my @append
      = $has_coords{$signal}
        ? $args[0]->xy ($self)
        : ();

   #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#

   for my $cb (
      @{$self->{signal_cb}{$signal} || []},             # before
      ($self->can ("invoke_$signal") || sub { 1 }),     # closure
   ) {
      return $cb->($self, @args, @append) || next;
   }

   # parent
   $self->{parent} && $self->{parent}->emit ($signal, @args)
}

sub find_widget {
   my ($self, $x, $y) = @_;

   return () unless $self->{can_events};

   return $self
      if $x >= $self->{x} && $x < $self->{x} + $self->{w}
          && $y >= $self->{y} && $y < $self->{y} + $self->{h};

   ()
}

sub set_parent {
   my ($self, $parent) = @_;

   CFPlus::weaken ($self->{parent} = $parent);
   $self->set_visible if $parent->{visible};
}

sub realloc {
   my ($self) = @_;

   if ($self->{visible}) {
      return if $self->{root}{realloc}{$self+0};

      $self->{root}{realloc}{$self+0} = $self;
      $self->{root}->update;
   } else {
      delete $self->{req_w};
      delete $self->{req_h};
   }
}

sub update {
   my ($self) = @_;

   $self->{parent}->update
      if $self->{parent};
}

sub reconfigure {
   my ($self) = @_;

   $self->realloc;
   $self->update;
}

# using global variables seems a bit hacky, but passing through all drawing
# functions seems pointless.
our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn

sub draw {
   my ($self) = @_;

   return unless $self->{h} && $self->{w};

   # update screen rectangle
   local $draw_x = $draw_x + $self->{x};
   local $draw_y = $draw_y + $self->{y};

   # skip widgets that are entirely outside the drawing area
   return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
          || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);

   glPushMatrix;
   glTranslate $self->{x}, $self->{y}, 0;

   if ($self == $HOVER && $self->{can_hover}) {
      glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
      glEnable GL_BLEND;
      glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
      glBegin GL_QUADS;
      glVertex 0         , 0;
      glVertex $self->{w}, 0;
      glVertex $self->{w}, $self->{h};
      glVertex 0         , $self->{h};
      glEnd;
      glDisable GL_BLEND;
   }

   if ($ENV{CFPLUS_DEBUG} & 1) {
      glPushMatrix;
      glColor 1, 1, 0, 1;
      glTranslate 0.375, 0.375;
      glBegin GL_LINE_LOOP;
      glVertex 0             , 0;
      glVertex $self->{w} - 1, 0;
      glVertex $self->{w} - 1, $self->{h} - 1;
      glVertex 0             , $self->{h} - 1;
      glEnd;
      glPopMatrix;
      #CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
   }

   $self->_draw;
   glPopMatrix;
}

sub _draw {
   my ($self) = @_;

   warn "no draw defined for $self\n";
}

my $cntx;#d#
sub DESTROY {
   my ($self) = @_;

   return if CFPlus::in_destruct;

   eval { $self->destroy };
   warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;

   delete $WIDGET{$self+0};
}

#############################################################################

package CFPlus::UI::DrawBG;

our @ISA = CFPlus::UI::Base::;

use strict;
use CFPlus::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 $color = $FOCUS == $self && $self->{active_bg}
             ? $self->{active_bg}
             : $self->{bg};

   if ($color && (@$color < 4 || $color->[3])) {
      my ($w, $h) = @$self{qw(w h)};

      glEnable GL_BLEND;
      glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
      glColor_premultiply @$color;

      glBegin GL_QUADS;
      glVertex 0 , 0;
      glVertex 0 , $h;
      glVertex $w, $h;
      glVertex $w, 0;
      glEnd;

      glDisable GL_BLEND;
   }
}

#############################################################################

package CFPlus::UI::Empty;

our @ISA = CFPlus::UI::Base::;

sub new {
   my ($class, %arg) = @_;
   $class->SUPER::new (can_events => 0, %arg);
}

sub size_request {
   my ($self) = @_;

   ($self->{w} + 0, $self->{h} + 0)
}

sub draw { }

#############################################################################

package CFPlus::UI::Container;

our @ISA = CFPlus::UI::Base::;

sub new {
   my ($class, %arg) = @_;

   my $children = delete $arg{children};

   my $self = $class->SUPER::new (
      children   => [],
      can_events => 0,
      %arg,
   );

   $self->add (@$children)
      if $children;

   $self
}

sub realloc {
   my ($self) = @_;

   $self->{force_realloc} = 1;
   $self->{force_size_alloc} = 1;
   $self->SUPER::realloc;
}

sub add {
   my ($self, @widgets) = @_;

   $_->set_parent ($self)
      for @widgets;

   use sort 'stable';

   $self->{children} = [
      sort { $a->{z} <=> $b->{z} }
         @{$self->{children}}, @widgets
   ];

   $self->realloc;
}

sub children {
   @{ $_[0]{children} }
}

sub remove {
   my ($self, $child) = @_;

   delete $child->{parent};
   $child->hide;

   $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];

   $self->realloc;
}

sub clear {
   my ($self) = @_;

   my $children = delete $self->{children};
   $self->{children} = [];

   for (@$children) {
      delete $_->{parent};
      $_->hide;
   }

   $self->realloc;
}

sub find_widget {
   my ($self, $x, $y) = @_;

   $x -= $self->{x};
   $y -= $self->{y};

   my $res;

   for (reverse $self->visible_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 CFPlus::UI::Bin;

our @ISA = CFPlus::UI::Container::;

sub new {
   my ($class, %arg) = @_;

   my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;

   $class->SUPER::new (children => [$child], %arg)
}

sub add {
   my ($self, $child) = @_;

   $self->SUPER::remove ($_) for @{ $self->{children} };
   $self->SUPER::add ($child);
}

sub remove {
   my ($self, $widget) = @_;

   $self->SUPER::remove ($widget);

   $self->{children} = [new CFPlus::UI::Empty]
      unless @{$self->{children}};
}

sub child { $_[0]->{children}[0] }

sub size_request {
   $_[0]{children}[0]->size_request
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   $self->{children}[0]->configure (0, 0, $w, $h);

   1
}

#############################################################################

# back-buffered drawing area

package CFPlus::UI::Window;

our @ISA = CFPlus::UI::Bin::;

use CFPlus::OpenGL;

sub new {
   my ($class, %arg) = @_;

   my $self = $class->SUPER::new (%arg);
}

sub update {
   my ($self) = @_;

   $ROOT->on_post_alloc ($self => sub { $self->render_child });
   $self->SUPER::update;
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   $self->update;

   $self->SUPER::invoke_size_allocate ($w, $h)
}

sub _render {
   my ($self) = @_;

   $self->{children}[0]->draw;
}

sub render_child {
   my ($self) = @_;

   $self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
      glClearColor 0, 0, 0, 0;
      glClear GL_COLOR_BUFFER_BIT;

      {
         package CFPlus::UI::Base;

         local ($draw_x, $draw_y, $draw_w, $draw_h) =
            (0, 0, $self->{w}, $self->{h});

         $self->_render;
      }
   };
}

sub _draw {
   my ($self) = @_;

   my $tex = $self->{texture}
      or return;

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
   glColor 0, 0, 0, 1;

   $tex->draw_quad_alpha_premultiplied (0, 0);

   glDisable GL_TEXTURE_2D;
}

#############################################################################

package CFPlus::UI::ViewPort;

use List::Util qw(min max);

our @ISA = CFPlus::UI::Window::;

sub new {
   my $class = shift;

   $class->SUPER::new (
      scroll_x => 0,
      scroll_y => 1,
      @_,
   )
}

sub size_request {
   my ($self) = @_;

   my ($w, $h) = @{$self->child}{qw(req_w req_h)};

   $w = 10 if $self->{scroll_x};
   $h = 10 if $self->{scroll_y};

   ($w, $h)
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   my $child = $self->child;

   $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
   $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};

   $self->child->configure (0, 0, $w, $h);
   $self->update;

   1
}

sub set_offset {
   my ($self, $x, $y) = @_;

   my $x = max 0, min $self->child->{w} - $self->{w}, int $x;
   my $y = max 0, min $self->child->{h} - $self->{h}, int $y;

   if ($x != $self->{view_x} or $y != $self->{view_y}) {
      $self->{view_x} = $x;
      $self->{view_y} = $y;

      $self->emit (changed => $x, $y);
      $self->update;
   }
}

# hmm, this does not work for topleft of $self... but we should not ask for that
sub coord2local {
   my ($self, $x, $y) = @_;

   $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
}

sub coord2global {
   my ($self, $x, $y) = @_;

   $x = List::Util::min $self->{w}, $x - $self->{view_x};
   $y = List::Util::min $self->{h}, $y - $self->{view_y};

   $self->SUPER::coord2global ($x, $y)
}

sub find_widget {
   my ($self, $x, $y) = @_;

   if (   $x >= $self->{x} && $x < $self->{x} + $self->{w}
       && $y >= $self->{y} && $y < $self->{y} + $self->{h}
   ) {
       $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
   } else {
      $self->CFPlus::UI::Base::find_widget ($x, $y)
   }
}

sub _render {
   my ($self) = @_;

   local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x};
   local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};

   CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};

   $self->SUPER::_render;
}

#############################################################################

package CFPlus::UI::ScrolledWindow;

our @ISA = CFPlus::UI::Table::;

sub new {
   my ($class, %arg) = @_;

   my $child = delete $arg{child};

   my $self;

   my $hslider = new CFPlus::UI::Slider
      vertical   => 0,
      range      => [0, 0, 1, 0.01], # HACK fix
      on_changed => sub {
         $self->{hpos} = $_[1];
         $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
      },
   ;

   my $vslider = new CFPlus::UI::Slider
      vertical   => 1,
      range      => [0, 0, 1, 0.01], # HACK fix
      on_changed => sub {
         $self->{vpos} = $_[1];
         $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
      },
   ;

   $self = $class->SUPER::new (
      scroll_x   => 0,
      scroll_y   => 1,
      can_events => 1,
      hslider    => $hslider,
      vslider    => $vslider,
      col_expand => [1, 0],
      row_expand => [1, 0],
      %arg,
   );

   $self->{vp} = new CFPlus::UI::ViewPort
      expand     => 1,
      scroll_x   => $self->{scroll_x},
      scroll_y   => $self->{scroll_y},
      on_changed => sub {
         my ($vp, $x, $y) = @_;

         $vp->{parent}{hslider}->set_value ($x);
         $vp->{parent}{vslider}->set_value ($y);

         0
      },
   ;

   $self->SUPER::add_at (0, 0, $self->{vp});

   $self->add ($child) if $child;

   $self
}

#TODO# update range on size_allocate depending on child

sub add {
   my ($self, $widget) = @_;

   $self->{vp}->add ($self->{child} = $widget);
}

sub update_slider {
   my ($self) = @_;

   my $child = ($self->{vp} or return)->child;

   my ($w1, $w2) = ($child->{w}, $self->{vp}{w});
   $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);

   my $visible = $w1 > $w2;
   if ($visible != $self->{hslider}{visible}) {
      $visible ? $self->SUPER::add_at (0, 1, $self->{hslider})
               : $self->{hslider}->hide;
   }

   my ($h1, $h2) = ($child->{h}, $self->{vp}{h});
   $self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);

   my $visible = $h1 > $h2;
   if ($visible != $self->{vslider}{visible}) {
      $visible ? $self->SUPER::add_at (1, 0, $self->{vslider})
#!/opt/bin/perl

my $startup_done = sub { };
our $PANGO = "1.5.0";

# do splash-screen thingy on win32
BEGIN {
   if (%PAR::LibCache && $^O eq "MSWin32") {
      while (my ($filename, $zip) = each %PAR::LibCache) {
         $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
      }

      require Win32::GUI::SplashScreen;

      Win32::GUI::SplashScreen::Show (
         -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
      );

      $startup_done = sub {
         Win32::GUI::SplashScreen::Done (1);
      };
   }
}

use strict;
use utf8;

use Carp 'verbose';

# do things only needed for single-binary version (par)
BEGIN {
   if (%PAR::LibCache) {
      @INC = grep ref, @INC; # weed out all paths except pars loader refs

      my $tmp = $ENV{PAR_TEMP};

      while (my ($filename, $zip) = each %PAR::LibCache) {
         for ($zip->memberNames) {
            next unless /^root\/(.*)/;
            $zip->extractMember ($_, "$tmp/$1")
               unless -e "$tmp/$1";
         }
      }

      if ($^O eq "MSWin32") {
         # relocatable
      } else {
         # unix, need to patch pango rc file
         open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
            or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
         local $/;
         my $rc = <$fh>;
         $rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones

         mkdir "$tmp/pango-modules";
         open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules"
            or die "$tmp/pango-modules/pango.modules: $!";
         print $fh $rc;

         $ENV{PANGO_RC_FILE} = "$tmp/pango.rc";
         open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
            or die "$ENV{PANGO_RC_FILE}: $!";
         print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n";
      }

      unshift @INC, $tmp;
   }
}

# need to do it again because that pile of garbage called PAR nukes it before main
unshift @INC, $ENV{PAR_TEMP}
   if %PAR::LibCache;

use Time::HiRes 'time';
use Event;

use Crossfire;
use Crossfire::Protocol::Constants;

use Compress::LZF;

use CFPlus;
use CFPlus::OpenGL ();
use CFPlus::Protocol;
use CFPlus::DB;
use CFPlus::UI;
use CFPlus::UI::Inventory;
use CFPlus::UI::SpellList;
use CFPlus::Pod;
use CFPlus::MapWidget;
use CFPlus::Macro;

$SIG{QUIT} = sub { Carp::cluck "QUIT" };
$SIG{PIPE} = 'IGNORE';

$Event::Eval = 1;
$Event::DIED = sub {
   CFPlus::fatal Carp::longmess $_[1]
};

my $MAX_FPS = 60;
my $MIN_FPS =  5; # unused as of yet

our $META_SERVER = "http://metaserver.schmorp.de/current.json";

our $LAST_REFRESH;
our $NOW;

our $CFG;
our $CONN;
our $PROFILE; # current profile
our $FAST; # fast, low-quality mode, possibly useful for software-rendering

our $WANT_REFRESH;
our $CAN_REFRESH;

our @SDL_MODES;
our $WIDTH;
our $HEIGHT;
our $FULLSCREEN;
our $FONTSIZE;

our $FONT_PROP;
our $FONT_FIXED;

our $MAP;
our $MAPMAP;
our $MAPWIDGET;
our $BUTTONBAR;
our $LOGVIEW;
our $CONSOLE;
our $METASERVER;
our $LOGIN_BUTTON;
our $QUIT_DIALOG;
our $HOST_ENTRY;
our $FULLSCREEN_ENABLE;
our $PICKUP_ENABLE;
our $SERVER_INFO;

our $SETUP_DIALOG;
our $SETUP_NOTEBOOK;
our $SETUP_SERVER;
our $SETUP_KEYBOARD;

our $PL_NOTEBOOK;
our $PL_WINDOW;

our $INVENTORY_PAGE;
our $STATS_PAGE;
our $SKILL_PAGE;
our $SPELL_PAGE;
our $SPELL_LIST;

our $HELP_WINDOW;
our $MESSAGE_WINDOW;
our $FLOORBOX;
our $GAUGES;
our $STATWIDS;

our $SDL_ACTIVE;
our %SDL_CB;

our $SDL_MIXER;
our $MUSIC_DEFAULT = "in_a_heartbeat.ogg";
our @MUSIC_WANT;
our $MUSIC_START;
our $MUSIC_PLAYING;
our $MUSIC_PLAYER;
our $MUSIC_RESUME = 30; # resume music when players less than these many seconds before
our @SOUNDS;       # event => file mapping
our %AUDIO_CHUNKS; # audio files

our $ALT_ENTER_MESSAGE;
our $STATUSBOX;
our $DEBUG_STATUS;

our $INV;
our $INVR;
our $INV_RIGHT_HB;

our $PICKUP_CFG;

our $IN_BUILD_MODE;
our $BUILD_BUTTON;

sub status {
   $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
}

sub debug {
   $DEBUG_STATUS->set_text ($_[0]);
}

sub message {
   my ($para) = @_;

   my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];

   $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";

   $LOGVIEW->add_paragraph ($para);
   $LOGVIEW->scroll_to_bottom;
}

sub destroy_query_dialog {
   (delete $_[0]{query_dialog})->destroy
      if $_[0]{query_dialog};
}

# FIXME: a very ugly hack to wait for stat update look below! #d#
our $QUERY_TIMER; #d#

# server query dialog
sub server_query {
   my ($conn, $flags, $prompt) = @_;

   # FIXME: a very ugly hack to wait for stat update #d#
   if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
      unless ($QUERY_TIMER) {
         $QUERY_TIMER =
            Event->timer (
               after => 1,
               cb => sub {
                  server_query ($conn, $flags, $prompt, 1);
                  $QUERY_TIMER = undef
               }
           );
         return;
      }
   }

   $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
      x     => "center",
      y     => "center",
      title => "Server Query",
      child => my $vbox = new CFPlus::UI::VBox,
   ;

   my @dialog = my $label = new CFPlus::UI::Label
      max_w     => $::WIDTH * 0.8,
      ellipsise => 0,
      text      => $prompt;

   if ($flags & CS_QUERY_YESNO) {
      push @dialog, my $hbox = new CFPlus::UI::HBox;

      $hbox->add (new CFPlus::UI::Button
         text => "No",
         on_activate => sub {
            $conn->send ("reply n");
            $dialog->destroy;
            0
         }
      );
      $hbox->add (new CFPlus::UI::Button
         text => "Yes",
         on_activate => sub {
            $conn->send ("reply y");
            destroy_query_dialog $conn;
            0
         },
      );

      $dialog->grab_focus;

   } elsif ($flags & CS_QUERY_SINGLECHAR) {
      if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
         $dialog->{tooltip} = "#charcreation_focus";

         unshift @dialog, new CFPlus::UI::Label
            max_w     => $::WIDTH * 0.8,
            ellipsise => 0,
            markup    => "\nOr use your keyboard and the text entry below:\n";

         unshift @dialog, my $table = new CFPlus::UI::Table;

         $table->add_at (0, 0, new CFPlus::UI::Button
             text => "Next Race",
             on_activate => sub {
                $conn->send ("reply n");
                destroy_query_dialog $conn;
                0
             },
         );
         $table->add_at (2, 0, new CFPlus::UI::Button
             text => "Accept",
             on_activate => sub {
                $conn->send ("reply d");
                destroy_query_dialog $conn;
                0
             },
         );

         if ($conn->{chargen_race_description}) {
            unshift @dialog, new CFPlus::UI::Label
               max_w     => $::WIDTH * 0.8,
               ellipsise => 0,
               markup    => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
            ;
         }

         unshift @dialog, new CFPlus::UI::Face
            face  => $conn->{player}{face},
            bg    => [.2, .2, .2, 1],
            min_w => 64,
            min_h => 64,
         ;

         if ($conn->{chargen_race_title}) {
            unshift @dialog, new CFPlus::UI::Label
               allign => 1,
               ellipsise => 0,
               markup    => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
            ;
         }

         unshift @dialog, new CFPlus::UI::Label
            max_w     => $::WIDTH * 0.4,
            ellipsise => 0,
            markup    => (CFPlus::Pod::section_label ui => "chargen_race"),
         ;

      } elsif ($prompt =~ /roll new stats/) {
         if (my $stat = delete $conn->{stat_change_with}) {
            $conn->send ("reply $stat");
            destroy_query_dialog $conn;
            return;
         }

         unshift @dialog, new CFPlus::UI::Label
            max_w     => $::WIDTH * 0.4,
            ellipsise => 0,
            markup    => "\nOr use your keyboard and the text entry below:\n";

         unshift @dialog, my $table = new CFPlus::UI::Table;

         # left: re-roll
         $table->add_at (0, 0, new CFPlus::UI::Button
            text => "Roll Again",
            on_activate => sub {
               $conn->send ("reply y");
               destroy_query_dialog $conn;
               0
            },
         );

         # center: swap stats
         my ($sw1, $sw2) = map +(new CFPlus::UI::Selector
               expand  => 1,
               value   => $_,
               options => [
                  [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
                  [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
                  [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
                  [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
                  [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
                  [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
                  [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
               ],
            ), 1 .. 2;

         $table->add_at (2, 0, new CFPlus::UI::Button
            text => "Swap Stats",
            on_activate => sub {
               $conn->{stat_change_with} = $sw2->{value};
               $conn->send ("reply $sw1->{value}");
               destroy_query_dialog $conn;
               0
            },
         );
         $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]);

         # right: accept
         $table->add_at (4, 0, new CFPlus::UI::Button
            text => "Accept",
            on_activate => sub {
               $conn->send ("reply n");
               $STATS_PAGE->hide;
               destroy_query_dialog $conn;
               0
            },
         );

         unshift @dialog, my $hbox = new CFPlus::UI::HBox;
         for (
            [Str => CS_STAT_STR],
            [Dex => CS_STAT_DEX],
            [Con => CS_STAT_CON],
            [Int => CS_STAT_INT],
            [Wis => CS_STAT_WIS],
            [Pow => CS_STAT_POW],
            [Cha => CS_STAT_CHA],
         ) {
            my ($name, $id) = @$_;
            $hbox->add (new CFPlus::UI::Label
               markup     => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
               align      => 0,
               expand     => 1,
               can_events => 1,
               can_hover  => 1,
               tooltip    => "#stat_$name",
            );
         }

         unshift @dialog, new CFPlus::UI::Label
            max_w     => $::WIDTH * 0.4,
            ellipsise => 0,
            markup    => (CFPlus::Pod::section_label ui => "chargen_stats"),
         ;
      }

      push @dialog, my $entry = new CFPlus::UI::Entry
         on_changed => sub {
            $conn->send ("reply $_[1]");
            destroy_query_dialog $conn;
            0
         },
      ;

      $entry->grab_focus;

   } else {
      $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";

      push @dialog, my $entry = new CFPlus::UI::Entry
         $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
         on_activate => sub {
            $conn->send ("reply $_[1]");
            destroy_query_dialog $conn;
            0
         },
      ;

      $entry->grab_focus;
   }

   $vbox->add (@dialog);
   $dialog->show;
}

sub start_game {
   status "logging in...";

   $LOGIN_BUTTON->set_text ("Logout");
   $SETUP_DIALOG->hide;

   my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;

   my ($host, $port) = split /:/, $PROFILE->{host};

   $MAP = new CFPlus::Map;
   
   $CONN = eval {
      new CFPlus::Protocol
         host => $host,
         port => $port || 13327,
         user => $PROFILE->{user},
         pass => $PROFILE->{password},
         mapw => $mapsize,
         maph => $mapsize,

         client => "cfplus $CFPlus::VERSION $] $^O",

         map_widget => $MAPWIDGET,
         logview    => $LOGVIEW,
         statusbox  => $STATUSBOX,
         map        => $MAP,
         mapmap     => $MAPMAP,
         query      => \&server_query,

         setup_req  => {
            smoothing => $CFG->{map_smoothing}*1,
         },

         sound_play => sub {
            my ($x, $y, $soundnum, $type) = @_;

            $SDL_MIXER
               or return;

            my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
               or return;

            $chunk->play;
         },
   };

   if ($CONN) {
      CFPlus::lowdelay fileno $CONN->{fh};

      status "login successful";
   } else {
      status "unable to connect";
      stop_game();
   }
}

sub stop_game {
   $LOGIN_BUTTON->set_text ("Login");
   $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
   $SETUP_DIALOG->show;
   $PL_WINDOW->hide;
   $SPELL_LIST->clear_spells;
   $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);

   &audio_music_set ([]);

   return unless $CONN;

   status "connection closed";

   destroy_query_dialog $CONN;
   $CONN->destroy;
   $CONN = 0; # false, does not autovivify

   undef $MAP;
}

sub graphics_setup {
   my $vbox = new CFPlus::UI::VBox;

   $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);

   my $row = 0;

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
   $table->add_at (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
                                                 can_events => 1,
                                                 tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");

   my $vidmode_tooltip =
      "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
    . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
   $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);

   $hbox->add (my $mode_slider = new CFPlus::UI::Slider
      force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],
      tooltip => $vidmode_tooltip);
   $hbox->add (my $mode_label = new CFPlus::UI::Label
      align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",
      can_events => 1, tooltip => $vidmode_tooltip);

   $mode_slider->connect (changed => sub {
      my ($self, $value) = @_;

      $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
      $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
   });
   $mode_slider->emit (changed => $mode_slider->{range}[0]);

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
   $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
      state => $CFG->{fullscreen},
      tooltip => "Bring the client into fullscreen mode.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
   $table->add_at (1, $row++, new CFPlus::UI::CheckBox
      state => $CFG->{fast},
      tooltip => "Lower the visual quality considerably to speed up rendering.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
      tooltip => "The base font size used by most GUI elements that do not have their own setting.",
      on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
   );

   $table->add_at (1, $row++, new CFPlus::UI::Button
      expand => 1, align => 0, text => "Apply",
      tooltip => "Apply the video settings above.",
      on_activate => sub {
         video_shutdown ();
         video_init ();
         0
      }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range      => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
      tooltip    => "Enlarge or shrink the displayed map. Changes are instant.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Smoothing");
   $table->add_at (1, $row++, new CFPlus::UI::CheckBox
      state => $CFG->{map_smoothing},
      tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
               . "This increases load on the graphics subsystem and works only with 2.x servers. "
               . "Changes take effect at next connection only.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
   $table->add_at (1, $row++, new CFPlus::UI::CheckBox
      state => $CFG->{fow_enable},
      tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
      tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
      tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
      on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
      tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
      on_changed => sub {
         $CFG->{gauge_fontsize} = $_[1];
         &set_gauge_window_fontsize;
         0
      }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size");
   $table->add_at (1, $row++, new CFPlus::UI::Slider
      range      => [$CFG->{gauge_size}, 0.2, 0.8],
      tooltip    => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
      on_changed => sub {
         $CFG->{gauge_size} = $_[1];
         $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
         0
      }
   );

   $vbox
}

sub audio_setup {
   my $vbox = new CFPlus::UI::VBox;

   $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);

   my $row = 0;

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable");
   $table->add_at (1, $row++, new CFPlus::UI::CheckBox
      state => $CFG->{audio_enable},
      tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
      on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
   );
#   $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume");
#   $table->add_at (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
#      $CFG->{effects_volume} = $_[1];
#   });
   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music");
   $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
   $hbox->add (new CFPlus::UI::CheckBox
      expand => 1, state => $CFG->{bgm_enable},
      tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
      on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
   );
   $hbox->add (new CFPlus::UI::Slider
      expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
      tooltip => "The volume of the background music. Changes are instant.",
      on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFPlus::MixMusic::volume $_[1] * 128; 0 }
   );

   $table->add_at (1, $row++, new CFPlus::UI::Button
      expand => 1, align => 0, text => "Apply",
      tooltip => "Apply the audio settings",
      on_activate => sub {
         audio_shutdown ();
         audio_init ();
         0
      }
   );

   $vbox
}

sub set_gauge_window_fontsize {
   for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
      $_->set_fontsize ($::CFG->{gauge_fontsize});
   }
}

sub make_gauge_window {
   my $gh = int $HEIGHT * $CFG->{gauge_size};

   my $win = new CFPlus::UI::Frame (
      force_x => 0,
      force_y => "max",
      force_w => $WIDTH,
      force_h => $gh,
   );

   $win->add (my $hbox = new CFPlus::UI::HBox
      children => [
         (new CFPlus::UI::HBox expand => 1),
         (new CFPlus::UI::VBox children => [
            (new CFPlus::UI::Empty expand => 1),
            (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFPlus::UI::Table)),
         ]),
         (my $vbox = new CFPlus::UI::VBox),
      ],
   );

   $vbox->add (new CFPlus::UI::HBox
      expand => 1,
      children => [
         (new CFPlus::UI::Empty expand => 1),
         (my $hb = new CFPlus::UI::HBox),
      ],
   );

   $hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health");
   $hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana");
   $hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace");
   $hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food");

   $vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
   $vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");

   $GAUGES = {
      exp => $exp, win => $win, range => $rng,
      food => $fg, mana => $mg, hp => $hg, grace => $gg
   };

   &set_gauge_window_fontsize;

   $win
}

sub debug_setup {
   my $table = new CFPlus::UI::Table;

   $table->add_at (0, 0, new CFPlus::UI::Label text => "Widget Borders");
   $table->add_at (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
   $table->add_at (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info");
   $table->add_at (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
   $table->add_at (0, 2, new CFPlus::UI::Label text => "Show FPS");
   $table->add_at (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
   $table->add_at (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
   $table->add_at (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
   $table->add_at (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );

   $table->add_at (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#

   $table
}

sub stats_window {
   my $r = new CFPlus::UI::ScrolledWindow (
      expand => 1,
      scroll_y => 1
   );
   $r->add (my $vb = new CFPlus::UI::VBox);

   $vb->add (new CFPlus::UI::FancyFrame
      label => "Player",
      child => (my $pi = new CFPlus::UI::VBox),
   );

   $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
      can_hover => 1, can_events => 1,
      tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
   $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
      can_hover => 1, can_events => 1,
      tooltip => "The map you are currently on (if supported by the server).");

   $pi->add (my $hb0 = new CFPlus::UI::HBox);
   $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
      can_hover => 1, can_events => 1,
      tooltip => "The weight of the player including all inventory items.");
   $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
      can_hover => 1, can_events => 1,
      tooltip => "The weight limit: you cannot carry more than this.");

   $vb->add (new CFPlus::UI::FancyFrame
      label => "Primary/Secondary Statistics",
      child => (my $hb = new CFPlus::UI::HBox expand => 1),
   );
   $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);

   my $color2 = [1, 1, 0];

   for (
      [0, 0, st_str => "Str", 30],
      [0, 1, st_dex => "Dex", 30],
      [0, 2, st_con => "Con", 30],
      [0, 3, st_int => "Int", 30],
      [0, 4, st_wis => "Wis", 30],
      [0, 5, st_pow => "Pow", 30],
      [0, 6, st_cha => "Cha", 30],

      [2, 0, st_wc   => "Wc", -120],
      [2, 1, st_ac   => "Ac", -120],
      [2, 2, st_dam  => "Dam", 120],
      [2, 3, st_arm  => "Arm", 120],
      [2, 4, st_spd  => "Spd", 10.54],
      [2, 5, st_wspd => "WSp", 10.54],
   ) {
      my ($col, $row, $id, $label, $template) = @$_;

      $tbl->add ($col    , $row, $STATWIDS->{$id} = new CFPlus::UI::Label
         font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,
         align => +1, template => $template, tooltip => "#stat_$label");
      $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
         font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
         align => -1, text => $label, tooltip => "#stat_$label");
   }

   $vb->add (new CFPlus::UI::FancyFrame
      label => "Resistancies",
      child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
   );

   my $row = 0;
   my $col = 0;

   my %resist_names = (
      slow  => ["Slow",
         "<b>Slow</b> (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)"],
      holyw => ["Holy Word",
         "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
      conf  => ["Confusion",
         "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
      fire  => ["Fire",
         "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
      depl  => ["Depletion",
         "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
      magic => ["Magic",
         "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
      drain => ["Draining",
         "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
      acid  => ["Acid",
         "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
      pois  => ["Poison",
         "<b>Poison</b> (resistance to getting poisoned)"],
      para  => ["Paralysation",
         "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
      deat  => ["Death",
         "<b>Death</b> (resistance against death spells)"],
      phys  => ["Physical",
         "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat. The value displayed here is also displayed in the 'Arm' field on the left.)"],
      blind => ["Blind",
         "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
      fear  => ["Fear",
         "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)"],
      tund  => ["Turn undead",
         "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
      elec  => ["Electricity",
         "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
      cold  => ["Cold",
         "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
      ghit  => ["Ghost hit",
         "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
   );
   for (qw/slow holyw conf fire depl magic
           drain acid pois para deat phys
           blind fear tund elec cold ghit/)
   {
      $tbl2->add ($col, $row,
         $STATWIDS->{"res_$_"} =
            new CFPlus::UI::Label
               font       => $FONT_FIXED,
               template   => "-100%",
               align      => +1,
               valign     => 0,
               can_events => 1,
               can_hover  => 1,
               tooltip    => $resist_names{$_}->[1],
      );
      $tbl2->add ($col + 1, $row, new CFPlus::UI::Image
         font       => $FONT_FIXED,
         can_hover  => 1,
         can_events => 1,
         path       => "ui/resist/resist_$_.png",
         tooltip    => $resist_names{$_}->[1],
      );
      $tbl2->add ($col + 2, $row, new CFPlus::UI::Label
         text       => $resist_names{$_}->[0],
         font       => $FONT_FIXED,
         can_hover  => 1,
         can_events => 1,
         tooltip    => $resist_names{$_}->[1],
      );

      $row++;
      if ($row % 6 == 0) {
         $col += 3;
         $row = 0;
      }
   }

   #update_stats_window ({});

   $r
}

sub skill_window {
   my $sw = new CFPlus::UI::ScrolledWindow (expand => 1);
   $sw->add ($STATWIDS->{skill_tbl} = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]);
   $sw
}

sub formsep($) {
   scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
}

my $METASERVER_ATIME;

sub update_metaserver {
   my ($metaserver_dialog) = @_;

   $METASERVER = $metaserver_dialog
      if defined $metaserver_dialog;

   return if $METASERVER_ATIME > time;
   $METASERVER_ATIME = time + 60;

   my $table = $METASERVER->{table};
   $table->clear;
   $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");

   my $ok = 0;

   CFPlus::background {
      my $ua = CFPlus::lwp_useragent;

      CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
   } sub {
      my ($msg) = @_;
      if ($msg) {
         $table->clear;

         my @tip = (
            "The current number of users logged in on the server.",
            "The hostname of the server.",
            "The time this server has been running without being restarted.",
            "The server software version - a '+' indicates a Crossfire+ server.",
            "Short information about this server provided by its admins.",
         );
         my @col = qw(#Users Host Uptime Version Description);
         $table->add_at ($_, 0, new CFPlus::UI::Label
            can_hover => 1, can_events => 1,
            align => 0, fg => [1, 1, 0],
            text => $col[$_], tooltip => $tip[$_])
               for 0 .. $#col;

         my @align = qw(1 0 1 1 -1);

         my $y = 0;
         for my $m (@{ $msg->{servers} }) {
            my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) = 
               @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};

            for ($desc) {
               s/<br>/\n/gi;
               s/<li>/\n· /gi;
               s/<.*?>//sgi;
               s/&amp;/&/g;
               s/&lt;/</g;
               s/&gt;/>/g;
            }

            $uptime = sprintf "%dd %02d:%02d:%02d",
               (int $uptime / 86400),
               (int $uptime / 3600) % 24,
               (int $uptime / 60) % 60,
               $uptime % 60;

            $m = [$users, $host, $uptime, $version, $desc];

            $y++;

            $table->add_at (scalar @$m, $y, new CFPlus::UI::VBox children => [
               (new CFPlus::UI::Button
                  text        => "Use",
                  tooltip     => "Put this server into the <b>Host:Port</b> field",
                  on_activate => sub {
                     $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
                     $METASERVER->hide;
                     0
                  },
               ),
               (new CFPlus::UI::Empty expand => 1),
            ]);
            
            $table->add_at ($_, $y, new CFPlus::UI::Label
                  max_w      => $::WIDTH * 0.4,
                  ellipsise  => 0,
                  align      => $align[$_],
                  text       => $m->[$_],
                  tooltip    => $tip[$_],
                  fg         => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
                  can_hover  => 1,
                  can_events => 1,
                  fontsize   => 0.8)
               for 0 .. $#$m;
         }
      } else {
         $ok or $label->set_text ("error while contacting metaserver");
      }
   };

}

sub metaserver_dialog {
   my $vbox  = new CFPlus::UI::VBox;
   my $table = new CFPlus::UI::Table;
   $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);

   my $dialog = new CFPlus::UI::Toplevel
      title   => "Server List",
      name    => 'metaserver_dialog',
      x       => 'center',
      y       => 'center',
      z       => 3,
      force_w => $::WIDTH  * 0.9,
      force_h => $::HEIGHT * 0.7,
      child   => $vbox,
      has_close_button => 1,
      table   => $table,
      on_visibility_change => sub {
         update_metaserver ($_[0]) if $_[1];
         0
      },
   ;

   $dialog
}

sub server_setup {
   my $vbox = new CFPlus::UI::VBox;

   $vbox->add (new CFPlus::UI::FancyFrame
      label => "Connection Settings",
      child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
   );
   $table->add_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");

   {
      $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox);

      $vbox->add (
         $HOST_ENTRY = new CFPlus::UI::Entry
            expand => 1,
            text => $CFG->{profile}{default}{host},
            tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
            on_changed => sub {
               my ($self, $value) = @_;
               $CFG->{profile}{default}{host} = $value;
               0
            }
      );

      $vbox->add (new CFPlus::UI::Button
         expand  => 1,
         text    => "Server List",
         other   => $METASERVER,
         tooltip => "Show a list of available crossfire servers",
         on_activate => sub { $METASERVER->toggle_visibility; 0 },
         on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
      );
   }

   $table->add_at (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username");
   $table->add_at (1, 4, new CFPlus::UI::Entry
      text => $CFG->{profile}{default}{user},
      tooltip => "The name of your character on the server",
      on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
   );

   $table->add_at (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password");
   $table->add_at (1, 5, new CFPlus::UI::Entry
      text => $CFG->{profile}{default}{password},
      hidden => 1,
      tooltip => "The password for your character",
      on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
   );

   $table->add_at (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size");
   $table->add_at (1, 7, new CFPlus::UI::Slider
      force_w => 100,
      range => [$CFG->{mapsize}, 10, 100, 0, 1],
      tooltip => "This is the size of the portion of the map update the server sends you. "
               . "If you set this to a high value you will be able to see further, "
               . "but you also increase bandwidth requirements and latency. "
               . "This option is only used once at log-in.",
      on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
   );

   $table->add_at (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Face Prefetch");
   $table->add_at (1, 8, new CFPlus::UI::CheckBox
      state => $CFG->{face_prefetch},
      tooltip => "<b>Background Image Prefetch</b>\n\n"
               . "If enabled, the client automatically pre-fetches images from the server. "
               . "This might increase or create lag, but increases the chances "
               . "of faces being ready for display when you encounter them. "
               . "It also uses up server bandwidth on every connect, "
               . "so only set it if you really need to prefetch images. "
               . "This option can be set and unset any time.",
      on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
   );

   $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
   $table->add_at (1, 9, new CFPlus::UI::Entry
      text => $CFG->{output_rate},
      tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
               . "when sending images, to ensure interactiveness. When 0 or unset, the server "
               . "default will be used, which is usually around 100kb/s.",
      on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
   );

   $table->add_at (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
   $table->add_at (1, 10, new CFPlus::UI::Entry
      text => $CFG->{output_count},
      tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
      on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
   );

   $table->add_at (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
   $table->add_at (1, 11, new CFPlus::UI::Entry
      text => $CFG->{output_sync},
      tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
      on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
   );

   $table->add_at (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
      expand => 1,
      align => 0,
      text => "Login",
      on_activate => sub {
         $CONN ? stop_game
               : start_game;
         0
      },
   );

   $vbox->add (new CFPlus::UI::FancyFrame
      label => "Server Info",
      child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
   );

   $vbox
}

sub client_setup {
   my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];

   my $row = 0;

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
   $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
      text    => $CFG->{say_command},
      tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
               . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
               . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
      on_changed => sub {
         my ($self, $value) = @_;
         $CFG->{say_command} = $value;
         0
      }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
   $table->add_at (1, $row++, new CFPlus::UI::CheckBox
      state   => $CFG->{show_tips},
      tooltip => "Show the <b>Tip of the day</b> window at startup?",
      on_changed => sub {
         my ($self, $value) = @_;
         $CFG->{show_tips} = $value;
         0
      }
   );

   $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size");
   $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
      text    => $CFG->{logview_max_par},
      tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
               . "sends more messages than this number, older messages get removed to save memory and "
               . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
      on_changed => sub {
         my ($self, $value) = @_;
         $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1;
         0
      },
   );

   $table
}

sub message_window {
   my $window = new CFPlus::UI::Toplevel
      name      => "message_window",
      title     => "Messages",
      border_bg => [1, 1, 1, 1],
      x         => "max",
      y         => 0,
      force_w   => $::WIDTH  * 0.4,
      force_h   => $::HEIGHT * 0.5,
      child     => (my $vbox = new CFPlus::UI::VBox),
      has_close_button => 1;

   $vbox->add ($LOGVIEW);

   $vbox->add (my $input = new CFPlus::UI::Entry
      tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
               . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
               . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
               . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
      on_focus_in => sub {
         my ($input, $prev_focus) = @_;

         delete $input->{refocus_map};

         if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
            $input->{refocus_map} = 1;
         }
         delete $input->{auto_activated};

         0
      },
      on_activate => sub {
         my ($input, $text) = @_;
         $input->set_text ('');

         if ($text =~ /^\/(.*)/) {
            $::CONN->user_send ($1);
         } else {
            my $say_cmd = $::CFG->{say_command} || 'say';
            $::CONN->user_send ("$say_cmd $text");
         }
         if ($input->{refocus_map}) {
            delete $input->{refocus_map};
            $MAPWIDGET->focus_in
         }

         0
      },
      on_escape => sub {
         $MAPWIDGET->grab_focus;

         0
      },
   );

   $CONSOLE = {
      window => $window,
      input  => $input,
   };

   $window
}

sub autopickup_setup {
   my $r = new CFPlus::UI::ScrolledWindow (
      expand   => 1,
      scroll_y => 1
   );
   $r->add (my $table = new CFPlus::UI::Table
      row_expand => [0],
      col_expand => [0, 1, 0, 1],
   );

   for (
         ["General", 0, 0,
            ["Enable autopickup"       => PICKUP_NEWMODE, \$PICKUP_ENABLE],
            ["Inhibit autopickup"      => PICKUP_INHIBIT],
            ["Stop before pickup"      => PICKUP_STOP],
            ["Debug autopickup"        => PICKUP_DEBUG],
         ],
         ["Weapons", 0, 6,
            ["All weapons"             => PICKUP_ALLWEAPON],
            ["Missile weapons"         => PICKUP_MISSILEWEAPON],
            ["Bows"                    => PICKUP_BOW],
            ["Arrows"                  => PICKUP_ARROW],
         ],
         ["Armour", 0, 12,
            ["Helmets"                 => PICKUP_HELMET],
            ["Shields"                 => PICKUP_SHIELD],
            ["Body Armour"             => PICKUP_ARMOUR],
            ["Boots"                   => PICKUP_BOOTS],
            ["Gloves"                  => PICKUP_GLOVES],
            ["Cloaks"                  => PICKUP_CLOAK],
         ],

         ["Readables", 2, 0,
            ["Spellbooks"              => PICKUP_SPELLBOOK],
            ["Skillscrolls"            => PICKUP_SKILLSCROLL],
            ["Normal Books/Scrolls"    => PICKUP_READABLES],
         ],
         ["Misc", 2, 5,
            ["Food"                    => PICKUP_FOOD],
            ["Drinks"                  => PICKUP_DRINK],
            ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
            ["Keys"                    => PICKUP_KEY],
            ["Magical Items"           => PICKUP_MAGICAL],
            ["Potions"                 => PICKUP_POTION],
            ["Magic Devices"           => PICKUP_MAGIC_DEVICE],
            ["Ignore cursed"           => PICKUP_NOT_CURSED],
            ["Jewelery"                => PICKUP_JEWELS],
            ["Flesh"                   => PICKUP_FLESH],
         ],
         ["Weight/Value ratio", 2, 17]
       )
   {
      my ($title, $x, $y, @bits) = @$_;
      $table->add_at ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]);

      for (@bits) {
         ++$y;

         my $mask = $_->[1];
         $table->add_at ($x  , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1);
         $table->add_at ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox
            state => $::CFG->{pickup} & $mask,
            on_changed => sub {
               my ($box, $value) = @_;

               if ($value) {
                  $::CFG->{pickup} |= $mask;
               } else {
                  $::CFG->{pickup} &= ~$mask;
               }

               $::CONN->send_command ("pickup $::CFG->{pickup}")
                  if defined $::CONN;

               0
            });

         ${$_->[2]} = $checkbox if $_->[2];
      }
   }

   $table->add_at (2, 18, new CFPlus::UI::ValSlider
      range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
      template => ">= 99",
      to_value => sub { ">= " . 5 * $_[0] },
      on_changed => sub {
         my ($slider, $value) = @_;

         $::CFG->{pickup} &= ~0xF;
         $::CFG->{pickup} |= int $value
            if $value;
         1;
      });

   $table->add_at (3, 18, new CFPlus::UI::Button 
      text => "set",
      on_activate => sub {
         $::CONN->send_command ("pickup $::CFG->{pickup}")
            if defined $::CONN;
         0
      });

   $r
}

my %SORT_ORDER = (
   type   => undef,
   mtime  => sub {
                my $NOW = time;
                sort {
                   my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
                   my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;

                   ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
                      or $btime <=> $atime
                      or $a->{type} <=> $b->{type}
                } @_
             },
   weight => sub { sort {
                $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
                   or $a->{type} <=> $b->{type}
             } @_ },
);

sub inventory_widget {
   my $hb = new CFPlus::UI::HBox homogeneous => 1;

   $hb->add (my $vb1 = new CFPlus::UI::VBox);
   $vb1->add (new CFPlus::UI::Label align => 0, text => "Player");

   $vb1->add (my $hb1 = new CFPlus::UI::HBox);

   use sort 'stable';

   $hb1->add (new CFPlus::UI::Selector
      value   => $::CFG->{inv_sort},
      options => [
         [type   => "Type/Name"],
         [mtime  => "Recent/Normal/Locked"],
         [weight => "Weight/Type"],
      ],
      on_changed => sub {
         $::CFG->{inv_sort} = $_[1];
         $INV->set_sort_order ($SORT_ORDER{$_[1]});
      },
   );
   $hb1->add (new CFPlus::UI::Label text => "Weight: ", align => 1, expand => 1);
   #TODO# update to weigh/maxweight
   $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);

   $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
   $sw1->add ($INV = new CFPlus::UI::Inventory);
   $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});

   $hb->add (my $vb2 = new CFPlus::UI::VBox);

   $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);

   $vb2->add (my $sw2 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
   $sw2->add ($INVR = new CFPlus::UI::Inventory);

   # XXX: Call after $INVR = ... because set_opencont sets the items
   CFPlus::Protocol::set_opencont ($::CONN, 0, "Floor");

   $hb
}

sub toggle_player_page {
   my ($widget) = @_;

   if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
      $PL_WINDOW->hide;
   } else {
      $PL_NOTEBOOK->set_current_page ($widget);
      $PL_WINDOW->show;
   }
}

sub player_window {
   my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
      x       => "center",
      y       => "center",
      force_w => $WIDTH  * 9/10,
      force_h => $HEIGHT * 9/10,
      title   => "Player",
      name    => "playerbook",
      has_close_button => 1
   ;

   my $ntb =
      $PL_NOTEBOOK =
         new CFPlus::UI::Notebook expand => 1;

   $ntb->add (
      "Statistics (F2)" => $STATS_PAGE = stats_window,
      "Shows statistics, where all your Stats and Resistances are shown."
   );
   $ntb->add (
      "Skills (F3)" => $SKILL_PAGE = skill_window,
      "Shows all your Skills."
   );

   my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
   $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
   $ntb->add (
      "Spellbook (F4)" => $spellsw,
      "Displays all spells you have and lets you edit keyboard shortcuts for them."
   );
   $ntb->add (
      "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
      "Toggles the inventory window, where you can manage your loot (or treasures :). "
      . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
   );
   $ntb->add (Pickup   => autopickup_setup,
      "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");

   $ntb->set_current_page ($INVENTORY_PAGE);

   $plwin->add ($ntb);
   $plwin
}

sub keyboard_setup {
   CFPlus::Macro::keyboard_setup
}

sub help_window {
   my $win = new CFPlus::UI::Toplevel
      x       => 'center',
      y       => 'center',
      z       => 4,
      name    => 'doc_browser',
      force_w => int $WIDTH  * 7/8,
      force_h => int $HEIGHT * 7/8,
      title   => "Help Browser",
      has_close_button => 1;

   $win->add (my $vbox = new CFPlus::UI::VBox);

   $vbox->add (new CFPlus::UI::FancyFrame
      label => "Navigation",
      child => (my $buttons = new CFPlus::UI::HBox),
   );
   $vbox->add (my $viewer  = new CFPlus::UI::TextScroller
                   expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);

   my @history;
   my @future;
   my $curnode;

   my $load_node; $load_node = sub {
      my ($node, $para) = @_;

      $buttons->clear;

      $buttons->add (new CFPlus::UI::Button
         text        => "⇤",
         tooltip     => "back to the starting page",
         on_activate => sub {
            unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
            unshift @future, @history;
            @history = ();
            $load_node->(@{shift @future});
         },
      );

      if (@history) {
         $buttons->add (new CFPlus::UI::Button
            text        => "⋘",
            tooltip     => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
            on_activate => sub {
               unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
               $load_node->(@{pop @history});
            },
         );
      }

      if (@future) {
         $buttons->add (new CFPlus::UI::Button
            text        => "⋙",
            tooltip     => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
            on_activate => sub {
               push @history, [$curnode, $viewer->current_paragraph];
               $load_node->(@{shift @future});
            },
         );
      }

      $buttons->add (new CFPlus::UI::Label text => " ");

      my @path = CFPlus::Pod::full_path_of $node;
      pop @path; # drop current node

      for my $node (@path) {
         $buttons->add (new CFPlus::UI::Button
            text        => $node->{kw}[0],
            tooltip     => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
            on_activate => sub {
               push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
               $load_node->($node);
            },
         );
         $buttons->add (new CFPlus::UI::Label text => "/");
      }

      $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);

      $curnode = $node;

      $viewer->clear;
      $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
      $viewer->scroll_to ($para);
   };

   $load_node->(CFPlus::Pod::find pod => "mainpage");

   $CFPlus::Pod::goto_document = sub {
      my (@path) = @_;

      push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();

      $load_node->((CFPlus::Pod::find @path)[0]);
      $win->show;
   };

   $win
}

sub open_string_query {
   my ($title, $cb, $txt, $tooltip) = @_;
   my $dialog = new CFPlus::UI::Toplevel
      x => "center",
      y => "center",
      z => 50,
      force_w => $WIDTH * 4/5,
      title => $title;

   $dialog->add (
      my $e = new CFPlus::UI::Entry
         on_activate => sub { $cb->(@_); $dialog->hide; 0 },
         on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
         tooltip => $tooltip
   );

   $e->grab_focus;
   $e->set_text ($txt) if $txt;
   $dialog->show;
}

sub open_quit_dialog {
   unless ($QUIT_DIALOG) {
      $QUIT_DIALOG = new CFPlus::UI::Toplevel
         x     => "center",
         y     => "center",
         z     => 50,
         title => "Really Quit?",
         on_key_down => sub {
            my ($dialog, $ev) = @_;
            $ev->{sym} == 27 and $dialog->hide;
         }
      ;

      $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);

      $vb->add (new CFPlus::UI::Label
         text      => "You should find a savebed and apply it first!",
         max_w     => $WIDTH * 0.25,
         ellipsize => 0,
      );
      $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
      $hb->add (new CFPlus::UI::Button
         text => "Ok",
         expand => 1,
         on_activate => sub { $QUIT_DIALOG->hide; 0 },
      );
      $hb->add (new CFPlus::UI::Button
         text => "Quit anyway",
         expand => 1,
         on_activate => sub { exit },
      );
   }

   $QUIT_DIALOG->show;
   $QUIT_DIALOG->grab_focus;
}

sub show_tip_of_the_day {
   # find all tips
   my @tod = CFPlus::Pod::find tip_of_the_day => "*";

   CFPlus::DB::get state => "tip_of_the_day", sub {
      my ($todindex) = @_;
      $todindex = 0 if $todindex >= @tod;
      CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };

      # create dialog
      my $dialog;

      my $close = sub {
         $dialog->destroy;
      };

      $dialog = new CFPlus::UI::Toplevel
         x => "center",
         y => "center",
         z => 3,
         name    => 'tip_of_the_day',
         force_w => int $WIDTH  * 4/9,
         force_h => int $WIDTH  * 2/9,
         title   => "Tip of the day #" . (1 + $todindex),
         child   => my $vbox = new CFPlus::UI::VBox,
         has_close_button => 1,
         on_delete => $close,
      ;

      $vbox->add (my $viewer  = new CFPlus::UI::TextScroller
                      expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
      $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);

      $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);

      $table->add_at (0, 0, new CFPlus::UI::Button
         text    => "Close",
         tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.",
         on_activate => $close,
      );

      $table->add_at (2, 0, new CFPlus::UI::Button
         text    => "Next",
         tooltip => "Show the next <b>Tip of the day</b>.",
         on_activate => sub {
            $close->();
            &show_tip_of_the_day;
         },
      );

      $dialog->show;
   };
}

sub sdl_init {
   CFPlus::SDL_Init
      and die "SDL::Init failed!\n";
}

sub video_init {
   $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;

   my ($old_w, $old_h) = ($WIDTH, $HEIGHT);

   ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
   $FULLSCREEN = $CFG->{fullscreen};
   $FAST       = $CFG->{fast};

   CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
      or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n";

   $SDL_ACTIVE = 1;
   $LAST_REFRESH = time - 0.01;

   CFPlus::OpenGL::init;

   $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};

   $CFPlus::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#

   #############################################################################

   if ($DEBUG_STATUS) {
      CFPlus::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
   } else {
      # create the widgets

      $DEBUG_STATUS = new CFPlus::UI::Label
         padding => 0,
         z       => 100,
         force_x => "max",
         force_y => 0;
      $DEBUG_STATUS->show;

      $STATUSBOX = new CFPlus::UI::Statusbox;
      $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);

      (new CFPlus::UI::Frame
         bg      => [0, 0, 0, 0.4],
         force_x => 0,
         force_y => "max",
         child   => $STATUSBOX,
      )->show;

      CFPlus::UI::Toplevel->new (
         title     => "Map",
         name      => "mapmap",
         x         => 0,
         y         => $FONTSIZE + 8,
         border_bg => [1, 1, 1, 192/255],
         bg        => [1, 1, 1, 0],
         child     => ($MAPMAP = new CFPlus::MapWidget::MapMap
            tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
         ),
      )->show;

      $MAPWIDGET = new CFPlus::MapWidget;
      $MAPWIDGET->connect (activate_console => sub {
         my ($mapwidget, $preset) = @_;

         if ($CONSOLE) {
            $CONSOLE->{input}->{auto_activated} = 1;
            $CONSOLE->{input}->grab_focus;

            if ($preset && $CONSOLE->{input}->get_text eq '') {
               $CONSOLE->{input}->set_text ($preset);
            }
         }
      });
      $MAPWIDGET->show;
      $MAPWIDGET->grab_focus;

      $LOGVIEW = new CFPlus::UI::TextScroller
         expand     => 1,
         font       => $FONT_FIXED,
         fontsize   => $::CFG->{log_fontsize},
         indent     => -4,
         can_hover  => 1,
         can_events => 1,
         max_par    => $CFG->{logview_max_par},
         tooltip    => "<b>Server Log</b>. This text viewer contains all recent messages sent by the server.",
      ;

      $SETUP_DIALOG = new CFPlus::UI::Toplevel
         title   => "Setup",
         name    => "setup_dialog",
         x       => 'center',
         y       => 'center',
         z       => 2,
         force_w => $::WIDTH  * 0.6,
         force_h => $::HEIGHT * 0.6,
         has_close_button => 1,
      ;

      $METASERVER = metaserver_dialog;

      $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
         filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);

      $SETUP_NOTEBOOK->add (Server   => $SETUP_SERVER = server_setup,
         "Configure the server to play on, your username, password and other server-related options.");
      $SETUP_NOTEBOOK->add (Client   => client_setup,
         "Configure various client-specific settings.");
      $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
         "Configure the video mode, performance, fonts and other graphical aspects of the game.");
      $SETUP_NOTEBOOK->add (Audio    => audio_setup,
         "Configure the use of audio, sound effects and background music.");
      $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
         "Lets you define, edit and delete key bindings."
       . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
       . "with nothing set and the recording started. After doing the actions you "
       . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
       . "After pressing the combo the binding will be saved automatically and the "
       . "binding editor closes");
      $SETUP_NOTEBOOK->add (Debug    => debug_setup,
         "Some debuggin' options. Do not ask.");

      $BUTTONBAR = new CFPlus::UI::Buttonbar x => 0, y => 0, z => 200; # put on top

      $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
         tooltip => "Toggles a dialog where you can configure all aspects of this client.");

      $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
         tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");

      make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D

      $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Playerbook", other => player_window,
         tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");

      $BUTTONBAR->add (new CFPlus::UI::Button
         text             => "Save Config",
         tooltip          => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
         on_activate => sub {
            $::CFG->{layout} = CFPlus::UI::get_layout;
            CFPlus::write_cfg "$Crossfire::VARDIR/cfplusrc";
            status "Configuration Saved";
            0
         },
      );

      $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
         tooltip => "View Documentation");


      $BUTTONBAR->add (new CFPlus::UI::Button
         text        => "Quit",
         tooltip     => "Terminates the program",
         on_activate => sub {
            if ($CONN) {
               open_quit_dialog;
            } else {
               exit;
            }
            0
         },
      );

      $BUTTONBAR->show;
      $SETUP_DIALOG->show;
   }

   $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
}

sub setup_build_button {
   my ($enabled) = @_;
   if ($enabled) {
      $BUILD_BUTTON->hide if $BUILD_BUTTON;
      $BUILD_BUTTON ||= new CFPlus::UI::Button
         text        => "Build",
         tooltip     => "Opens the ingame builder",
         on_activate => sub {
            if ($CONN) {
               $CONN->send_ext_req (builder_player_items => sub {
                  open_ingame_editor ($_[0]) if exists $_[0]->{items};
               });
            }
            0
         };
      $BUTTONBAR->add ($BUILD_BUTTON);
   } else {
      $BUILD_BUTTON->hide if $BUILD_BUTTON;
   }
}

sub open_ingame_editor {
   my ($msg) = @_;

   my $win = new CFPlus::UI::Toplevel
      x       => 0,
      y       => 'center',
      z       => 4,
      name    => 'builder_window',
      force_w => int $WIDTH  * 1/4,
      force_h => int $HEIGHT * 3/4,
      title   => "In game builder",
      has_close_button => 1;

   my $r = new CFPlus::UI::ScrolledWindow (
      expand => 1,
      scroll_y => 1
   );
   $r->add (my $vb = new CFPlus::UI::VBox);
   $win->add ($r);


   $vb->add (
      new CFPlus::UI::Button
         text => "Disable build mode",
         on_activate => sub { $::IN_BUILD_MODE = undef }
   );
   $vb->add (
      new CFPlus::UI::Button
         text => "ERASE",
         on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
   );

   for my $itemarchname (
      sort {
         $msg->{items}->{$a}->{build_arch_name}
            cmp $msg->{items}->{$b}->{build_arch_name}
      } keys %{$msg->{items}}
   ) {
      my $info = $msg->{items}->{$itemarchname};
      $vb->add (
         new CFPlus::UI::Button text => $info->{build_arch_name},
         on_activate => sub {
            $::IN_BUILD_MODE = { item => $itemarchname, info => $info };

            if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
               build_mode_query_arch_info ();
            }
         }
      );
   }

   $win->show;
}

sub build_mode_query_arch_info {
   my ($iteminfo) = $::IN_BUILD_MODE;
   my $itemarchname = $iteminfo->{item};
   my $info = $iteminfo->{info};

   my $dialog = new CFPlus::UI::Toplevel
      x     => "center",
      y     => "center",
      z     => 50,
      force_w => int $WIDTH  * 1/2,
      title => "Enter information for placement of '$itemarchname'",
      has_close_button => 1;

   $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);

   $vb->add (my $table = new CFPlus::UI::Table expand => 1);
      my $row = 0;
      if ($info->{has_name}) {
         $table->add_at (0, $row, new CFPlus::UI::Label text => "Name:");
         $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
      }
      if ($info->{has_text}) {
         $table->add_at (0, $row, new CFPlus::UI::Label text => "Text:");
         $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
      }
      if ($info->{has_connection}) {
         $table->add_at (0, $row, new CFPlus::UI::Label text => "Connection ID:");
         $table->add_at (1, $row++,
            new CFPlus::UI::Entry
               expand => 1,
               on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
               tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
         );
      }

   $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
   $hb->add (new CFPlus::UI::Button
      text => "Close",
      expand => 1,
      on_activate => sub { $dialog->hide; 0 },
   );
   $dialog->show;
}

sub video_shutdown {
   CFPlus::OpenGL::shutdown;
   
   undef $SDL_ACTIVE;
}

sub audio_channel_finished {
   my ($channel) = @_;

   #warn "channel $channel finished\n";#d#
}

sub audio_music_set {
   my ($songs) = @_;

   my @want =
      grep $_,
         map $CONN->{music_meta}{$_},
            @$songs;

   if (@want) {
      @MUSIC_WANT = @want;
      &audio_music_changed ();
   }
}

sub audio_music_start {
   my $path = $MUSIC_PLAYING->{path}
      or return;

   CFPlus::DB::prefetch_file $path, 1024_000, sub {
      # music might have changed...
      $path eq $MUSIC_PLAYING->{path}
         or return &audio_music_start ();

      $MUSIC_PLAYER = new_from_file CFPlus::MixMusic $path;

      my $NOW = time;

      if ($MUSIC_PLAYING->{stop_time} > $NOW - $MUSIC_RESUME) {
         my $pos = $MUSIC_PLAYING->{stop_pos};
         $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos);
         $MUSIC_START = time - $pos;
      } else {
         $MUSIC_PLAYER->play (0);
         $MUSIC_START = time;
      }

      delete $MUSIC_PLAYING->{stop_time};
      delete $MUSIC_PLAYING->{stop_pos};
   }
}

sub audio_music_changed {
   return unless $CFG->{bgm_enable};

   # default MUSIC_WANT == MUSIC_DEFAULT
   @MUSIC_WANT = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_WANT;
   
   # if the currently playing song is acceptable, let it continue
   return if $MUSIC_PLAYING
             && grep $MUSIC_PLAYING->{path} eq $_->{path}, @MUSIC_WANT;

   my $NOW = time;

   if ($MUSIC_PLAYING) {
      $MUSIC_PLAYING->{stop_time} = $NOW;
      $MUSIC_PLAYING->{stop_pos}  = $NOW - $MUSIC_START;
      CFPlus::MixMusic::fade_out 1000;
   } else {
      # sort by stop time, oldest first
      @MUSIC_WANT = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_WANT;

      # if the most recently-played piece played very recently,
      # resume it, else choose the oldest piece for rotation.
      $MUSIC_PLAYING =
         $MUSIC_WANT[-1]{stop_time} > $NOW - $MUSIC_RESUME
            ? $MUSIC_WANT[-1]
            : $MUSIC_WANT[0];

      audio_music_start;
   }
}

sub audio_music_finished {
   $MUSIC_PLAYING = undef;
   undef $MUSIC_PLAYER;

   audio_music_changed;
}

sub audio_init {
   if ($CFG->{audio_enable}) {
      if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") {
         $SDL_MIXER = !CFPlus::Mix_OpenAudio;

         unless ($SDL_MIXER) {
            status "Unable to open sound device: there will be no sound";
            return;
         }

         CFPlus::Mix_AllocateChannels 8;
         CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;

         audio_music_finished;

         local $_;
         while (<$fh>) {
            next if /^\s*#/;
            next if /^\s*$/;

            my ($file, $volume, $event) = split /\s+/, $_, 3;

            push @SOUNDS, "$volume,$file";

            $AUDIO_CHUNKS{"$volume,$file"} ||= do {
               my $chunk = new_from_file CFPlus::MixChunk CFPlus::find_rcfile "sounds/$file";
               $chunk->volume ($volume * 128 / 100);
               $chunk
            };
         }
      } else {
         status "unable to open sound config: $!";
      }
   }
}

sub audio_shutdown {
   CFPlus::Mix_CloseAudio if $SDL_MIXER;
   undef $SDL_MIXER;
   @SOUNDS = ();
   %AUDIO_CHUNKS = ();
}

my %animate_object;
my $animate_timer;

my $fps = 9;

my %demo;#d#

sub force_refresh {
   $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
   debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;

   $CFPlus::UI::ROOT->draw;

   $WANT_REFRESH = 0;
   $CAN_REFRESH  = 0;
   $LAST_REFRESH = $NOW;

   CFPlus::SDL_GL_SwapBuffers;
}

my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
   $NOW = time;

   ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
      for CFPlus::poll_events;

   if (%animate_object) {
      $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
      ++$WANT_REFRESH;
   }

   if ($WANT_REFRESH) {
      force_refresh;
   } else {
      $CAN_REFRESH = 1;
   }
});

sub animation_start {
   my ($widget) = @_;
   $animate_object{$widget} = $widget;
}

sub animation_stop {
   my ($widget) = @_;
   delete $animate_object{$widget};
}

# check once/second for faces that need to be prefetched
# this should, of course, only run on demand, but
# SDL forces worse things on us....

Event->timer (after => 1, interval => 0.25, cb => sub {
   $CONN->face_prefetch
      if $CONN;
});

%SDL_CB = (
   CFPlus::SDL_QUIT => sub {
      exit;
   },
   CFPlus::SDL_VIDEORESIZE => sub {
   },
   CFPlus::SDL_VIDEOEXPOSE => sub {
      CFPlus::UI::full_refresh;
   },
   CFPlus::SDL_ACTIVEEVENT => sub {
#      not useful, as APPACTIVE include sonly iconified state, not unmapped
#      printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d#
#      printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d#
#      printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
#      printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
#      printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
   },
   CFPlus::SDL_KEYDOWN => sub {
      if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
         # alt-enter
         $FULLSCREEN_ENABLE->toggle;
         video_shutdown;
         video_init;
      } else {
         CFPlus::UI::feed_sdl_key_down_event ($_[0]);
      }
   },
   CFPlus::SDL_KEYUP           => \&CFPlus::UI::feed_sdl_key_up_event,
   CFPlus::SDL_MOUSEMOTION     => \&CFPlus::UI::feed_sdl_motion_event,
   CFPlus::SDL_MOUSEBUTTONDOWN => \&CFPlus::UI::feed_sdl_button_down_event,
   CFPlus::SDL_MOUSEBUTTONUP   => \&CFPlus::UI::feed_sdl_button_up_event,
   CFPlus::SDL_USEREVENT       => sub {
      if ($_[0]{code} == 1) {
         audio_channel_finished $_[0]{data1};
      } elsif ($_[0]{code} == 0) {
         audio_music_finished;
      }
   },
);

#############################################################################

$SIG{INT} = $SIG{TERM} = sub { exit };

{
   CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
   CFPlus::DB::Server::run;

   CFPlus::UI::set_layout ($::CFG->{layout});

   my %DEF_CFG = (
      sdl_mode        => 0,
      width           => 640,
      height          => 480,
      fullscreen      => 0,
      fast            => 0,
      map_scale       => 1,
      fow_enable      => 1,
      fow_intensity   => 0,
      map_smoothing   => 1,
      gui_fontsize    => 1,
      log_fontsize    => 0.7,
      gauge_fontsize  => 1,
      gauge_size      => 0.35,
      stat_fontsize   => 0.7,
      mapsize         => 100,
      say_command     => 'chat',
      audio_enable    => 1,
      bgm_enable      => 1,
      bgm_volume      => 0.25,
      face_prefetch   => 0,
      output_sync     => 1,
      output_count    => 1,
      output_rate     => "",
      pickup          => 0,
      inv_sort        => "mtime",
      default         => "profile", # default profile
      show_tips       => 1,
      logview_max_par => 1000,
   );
   
   while (my ($k, $v) = each %DEF_CFG) {
      $CFG->{$k} = $v unless exists $CFG->{$k};
   }

   $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
   $PROFILE = $CFG->{profile}{default};

   # convert old bindings (only default profile matters)
   if (my $bindings = delete $PROFILE->{bindings}) {
      while (my ($mod, $syms) = each %$bindings) {
         while (my ($sym, $cmds) = each %$syms) {
            push @{ $PROFILE->{macro} }, {
               accelkey => [$mod*1, $sym*1],
               action   => $cmds,
            };
         }
      }
   }

   sdl_init;

   @SDL_MODES = CFPlus::SDL_ListModes 8, 8;
   @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES;
   @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";

   @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;

   $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;

   {
      my @fonts = map CFPlus::find_rcfile "fonts/$_", qw(
         DejaVuSans.ttf
         DejaVuSansMono.ttf
         DejaVuSans-Bold.ttf
         DejaVuSansMono-Bold.ttf
         DejaVuSans-Oblique.ttf
         DejaVuSansMono-Oblique.ttf
         DejaVuSans-BoldOblique.ttf
         DejaVuSansMono-BoldOblique.ttf
      );

      CFPlus::add_font $_ for @fonts;
      
      CFPlus::pango_init;

      $FONT_PROP  = new_from_file CFPlus::Font $fonts[0];
      $FONT_FIXED = new_from_file CFPlus::Font $fonts[1];

      $FONT_PROP->make_default;
   }

#   compare mono (ft) vs. rgba (cairo)
#   ft - 1.8s, cairo 3s, even in alpha-only mode
#   for my $rgba (0..1) {
#      my $t1 = Time::HiRes::time;
#      for (1..1000) {
#         my $layout = CFPlus::Layout->new ($rgba);
#         $layout->set_text ("hallo" x 100);
#         $layout->render;
#      }
#      my $t2 = Time::HiRes::time;
#      warn $t2-$t1;
#   }

   $startup_done->();

   video_init;
   audio_init;
}

show_tip_of_the_day if $CFG->{show_tips};

Event::loop;
#CFPlus::SDL_Quit;
#CFPlus::_exit 0;

END {
   CFPlus::SDL_Quit;
   CFPlus::DB::Server::stop;
}

=head1 NAME

cfplus - A Crossfire+ and Crossfire game client

=head1 SYNOPSIS

Just run it - no commandline arguments are supported.

=head1 USAGE

cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
fullscreen and interactively.

=head1 DEBUGGING


CFPLUS_DEBUG - environment variable

   1   draw borders around widgets
   2   add low-level widget info to tooltips
   4   show fps
   8   suppress tooltips

=head1 AUTHOR

Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>


               : $self->{vslider}->hide;
   }
}

sub update {
   my ($self) = @_;

   $self->SUPER::update;
   $self->update_slider;
}

sub invoke_mouse_wheel {
   my ($self, $ev) = @_;

   return 0 unless $ev->{dy}; # only vertical movements for now

   $self->{vslider}->emit (mouse_wheel => $ev);

   1
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   if ($ev->{button} == 2) {
      $self->grab_focus;

      my $ox = $self->{vp}{view_x} + $ev->{x};
      my $oy = $self->{vp}{view_y} + $ev->{y};
      
      $self->{motion} = sub {
         my ($ev, $x, $y) = @_;

         $self->{vp}->set_offset ($ox - $ev->{x}, $oy - $ev->{y});
         $self->update;
      };

      return 1;
   }

   0
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   if (delete $self->{motion}) {
      return 1;
   }

   0
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;

   if ($self->{motion}) {
      $self->{motion}->($ev, $x, $y);
      return 1;
   }

   0
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   $self->update_slider;
   $self->SUPER::invoke_size_allocate ($w, $h)
}

#############################################################################

package CFPlus::UI::Frame;

our @ISA = CFPlus::UI::Bin::;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   $class->SUPER::new (
      bg => undef,
      @_,
   )
}

sub _draw {
   my ($self) = @_;

   if ($self->{bg}) {
      my ($w, $h) = @$self{qw(w h)};

      glEnable GL_BLEND;
      glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
      glColor_premultiply @{ $self->{bg} };

      glBegin GL_QUADS;
      glVertex 0 , 0;
      glVertex 0 , $h;
      glVertex $w, $h;
      glVertex $w, 0;
      glEnd;

      glDisable GL_BLEND;
   }

   $self->SUPER::_draw;
}

#############################################################################

package CFPlus::UI::FancyFrame;

our @ISA = CFPlus::UI::Bin::;

use CFPlus::OpenGL;

sub new {
   my ($class, %arg) = @_;

   if ((exists $arg{label}) && !ref $arg{label}) {
      $arg{label} = new CFPlus::UI::Label
         align    => 1,
         valign   => 0,
         text     => $arg{label},
         fontsize => ($arg{border} || 0.8) * 0.75;
   }

   my $self = $class->SUPER::new (
      # label     => "",
      fg          => [0.6, 0.3, 0.1],
      border      => 0.8,
      style       => 'single',
      %arg,
   );

   $self
}

sub add {
   my ($self, @widgets) = @_;

   $self->SUPER::add (@widgets);
   $self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
}

sub border {
   int $_[0]{border} * $::FONTSIZE
}

sub size_request {
   my ($self) = @_;

   ($self->{label_w}, undef) = $self->{label}->size_request
      if $self->{label};

   my ($w, $h) = $self->SUPER::size_request;

   (
      $w + $self->border * 2,
      $h + $self->border * 2,
   )
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   my $border = $self->border;

   $w -= List::Util::max 0, $border * 2;
   $h -= List::Util::max 0, $border * 2;

   if (my $label = $self->{label}) {
      $label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
      $label->{h} = List::Util::min $h, $border;
      $label->invoke_size_allocate ($label->{w}, $label->{h});
   }

   $self->child->configure ($border, $border, $w, $h);

   1
}

sub _draw {
   my ($self) = @_;

   my $child = $self->{children}[0];

   my $border = $self->border;
   my ($w, $h) = ($self->{w}, $self->{h});

   $child->draw;

   glColor @{$self->{fg}};
   glBegin GL_LINE_STRIP;
   glVertex $border * 1.5      , $border * 0.5 + 0.5;
   glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
   glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
   glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
   glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
   glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
   glEnd;

   if ($self->{label}) {
      glTranslate $border * 2, 0;
      $self->{label}->_draw;
   }
}

#############################################################################

package CFPlus::UI::Toplevel;

our @ISA = CFPlus::UI::Bin::;

use CFPlus::OpenGL;

my $bg = 
      new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
         mipmap => 1, wrap => 1;

my @border = 
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);

my @icon =
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw(x1_move.png x1_resize.png);

sub new {
   my ($class, %arg) = @_;

   my $self = $class->SUPER::new (
      bg          => [1, 1, 1, 1],
      border_bg   => [1, 1, 1, 1],
      border      => 0.6,
      can_events  => 1,
      min_w       => 64,
      min_h       => 32,
      %arg,
   );

   $self->{title_widget} = new CFPlus::UI::Label
      align    => 0,
      valign   => 1,
      text     => $self->{title},
      fontsize => $self->{border},
         if exists $self->{title};

   if ($self->{has_close_button}) {
      $self->{close_button} =
         new CFPlus::UI::ImageButton
            path        => 'x1_close.png',
            on_activate => sub { $self->emit ("delete") };

      $self->CFPlus::UI::Container::add ($self->{close_button});
   }

   $self
}

sub add {
   my ($self, @widgets) = @_;

   $self->SUPER::add (@widgets);
   $self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
   $self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
}

sub border {
   int $_[0]{border} * $::FONTSIZE
}

sub size_request {
   my ($self) = @_;

   $self->{title_widget}->size_request
      if $self->{title_widget};

   $self->{close_button}->size_request
      if $self->{close_button};

   my ($w, $h) = $self->SUPER::size_request;

   (
      $w + $self->border * 2,
      $h + $self->border * 2,
   )
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   if ($self->{title_widget}) {
      $self->{title_widget}{w} = $w;
      $self->{title_widget}{h} = $h;
      $self->{title_widget}->invoke_size_allocate ($w, $h);
   }

   my $border = $self->border;

   $h -= List::Util::max 0, $border * 2;
   $w -= List::Util::max 0, $border * 2;

   $self->child->configure ($border, $border, $w, $h);

   $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
      if $self->{close_button};

   1
}

sub invoke_delete {
   my ($self) = @_;

   $self->hide;
   
   1
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   my ($w, $h) = @$self{qw(w h)};
   my $border = $self->border;

   my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
   my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);

   if ($lr & $td) {
      my ($wx, $wy) = ($self->{x}, $self->{y});
      my ($ox, $oy) = ($ev->{x}, $ev->{y});
      my ($bw, $bh) = ($self->{w}, $self->{h});

      my $mx = $x < $border;
      my $my = $y < $border;

      $self->{motion} = sub {
         my ($ev, $x, $y) = @_;

         my $dx = $ev->{x} - $ox;
         my $dy = $ev->{y} - $oy;

         $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
         $self->{force_h} = $bh + $dy * ($my ? -1 : 1);

         $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
         $self->realloc;
      };

   } elsif ($lr ^ $td) {
      my ($ox, $oy) = ($ev->{x}, $ev->{y});
      my ($bx, $by) = ($self->{x}, $self->{y});

      $self->{motion} = sub {
         my ($ev, $x, $y) = @_;

         ($x, $y) = ($ev->{x}, $ev->{y});

         $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
         # HACK: the next line is required to enforce placement
         $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
      };
   } else {
      return 0;
   }

   1
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   ! ! delete $self->{motion}
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;

   $self->{motion}->($ev, $x, $y) if $self->{motion};

   ! ! $self->{motion}
}

sub invoke_visibility_change {
   my ($self, $visible) = @_;

   delete $self->{motion} unless $visible;

   0
}

sub _draw {
   my ($self) = @_;

   my $child = $self->{children}[0];

   my ($w,  $h ) = ($self->{w}, $self->{h});
   my ($cw, $ch) = ($child->{w}, $child->{h});

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;

   my $border = $self->border;

   glColor @{ $self->{border_bg} };
   $border[0]->draw_quad_alpha (           0,            0, $w, $border);
   $border[1]->draw_quad_alpha (           0,      $border, $border, $ch);
   $border[2]->draw_quad_alpha ($w - $border,      $border, $border, $ch);
   $border[3]->draw_quad_alpha (           0, $h - $border, $w, $border);

   # move
   my $w2 = ($w - $border) * .5;
   my $h2 = ($h - $border) * .5;
   $icon[0]->draw_quad_alpha (           0,          $h2, $border, $border);
   $icon[0]->draw_quad_alpha ($w - $border,          $h2, $border, $border);
   $icon[0]->draw_quad_alpha ($w2         , $h - $border, $border, $border);

   # resize
   $icon[1]->draw_quad_alpha (           0,            0, $border, $border);
   $icon[1]->draw_quad_alpha ($w - $border,            0, $border, $border)
      unless $self->{has_close_button};
   $icon[1]->draw_quad_alpha (           0, $h - $border, $border, $border);
   $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border);

   if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
      glColor @{ $self->{bg} };

      # TODO: repeat texture not scale
      # solve this better(?)
      $bg->{s} = $cw / $bg->{w};
      $bg->{t} = $ch / $bg->{h};
      $bg->draw_quad_alpha ($border, $border, $cw, $ch);
   }

   glDisable GL_TEXTURE_2D;

   $child->draw;

   if ($self->{title_widget}) {
      glTranslate 0, $border - $self->{h};
      $self->{title_widget}->_draw;

      glTranslate 0, - ($border - $self->{h});
   }

   $self->{close_button}->draw
      if $self->{close_button};
}

#############################################################################

package CFPlus::UI::Table;

our @ISA = CFPlus::UI::Base::;

use List::Util qw(max sum);

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   $class->SUPER::new (
      children   => [],
      col_expand => [],
      row_expand => [],
      @_,
   )
}

sub children {
   grep $_, map @$_, grep $_, @{ $_[0]{children} }
}

# TODO: store row/col info in child widget and use standard add/del
sub add {
   my $self = shift;

   Carp::cluck "please use the add_at method instead of calling add, thank you.\n";#d#
   $self->add_at (@_);
}

sub add_at {
   my $self = shift;

   while (@_) {
      my ($col, $row, $child) = splice @_, 0, 3, ();

      $child->set_parent ($self);
      $self->{children}[$row][$col] = $child;
   }

   $self->{force_realloc}    = 1;
   $self->{force_size_alloc} = 1;
   $self->realloc;
}

sub remove {
   my ($self, $child) = @_;

   for (@{ $self->{children} }) {
      for (@{ $_ || [] }) {
         $_ = undef if $_ == $child;
      }
   }
}

# TODO: move to container class maybe? send children a signal on removal?
sub clear {
   my ($self) = @_;

   my @children = $self->children;
   delete $self->{children};
   
   for (@children) {
      delete $_->{parent};
      $_->hide;
   }

   $self->realloc;
}

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{qw(req_w req_h)};

         $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 invoke_size_allocate {
   my ($self, $w, $h) = @_;

   my ($ws, $hs) = $self->get_wh;

   my $req_w = (sum @$ws) || 1;
   my $req_h = (sum @$hs) || 1;

   # TODO: nicer code
   my @col_expand = @{$self->{col_expand}};
   @col_expand = (1) x @$ws unless @col_expand;
   my $col_expand = (sum @col_expand) || 1;

   $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;

   CFPlus::UI::harmonize $ws;

   my @row_expand = @{$self->{row_expand}};
   @row_expand = (1) x @$ws unless @row_expand;
   my $row_expand = (sum @row_expand) || 1;

   $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;

   CFPlus::UI::harmonize $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->configure ($x, $y, $col_w, $row_h);
         }

         $x += $col_w;
      }

      $y += $row_h;
   }

   1
}

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 CFPlus::UI::Fixed;

use List::Util qw(min max);

our @ISA = CFPlus::UI::Container::;

sub add {
   my ($self, $child, $posmode, $x, $y, $sizemode, $w, $h) = @_;

   $child->{_fixed} = [$posmode, $x, $y, $sizemode, $w, $h];
   $self->SUPER::add ($child);
}

sub _scale($$$) {
   my ($mode, $val, $max) = @_;

   $mode eq "abs"   ? $val
   : $mode eq "rel" ? $val * $max
   :                  0
}

sub size_request {
   my ($self) = @_;

   my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);

   # determine overall size by querying abs widgets
   for my $child ($self->visible_children) {
      my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };

      if ($pos eq "abs") {
         $w = _scale $size, $w, $child->{req_w};
         $h = _scale $size, $h, $child->{req_h};

         $x1 = min $x1, $x; $x2 = max $x2, $x + $w;
         $y1 = min $y1, $y; $y2 = max $y2, $y + $h;
      }
   }

   my $W = $x2 - $x1;
   my $H = $y2 - $y1;

   # now layout remaining widgets
   for my $child ($self->visible_children) {
      my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };

      if ($pos ne "abs") {
         $x = _scale $pos,  $x, $W;
         $y = _scale $pos,  $x, $H;
         $w = _scale $size, $w, $child->{req_w};
         $h = _scale $size, $h, $child->{req_h};

         $x1 = min $x1, $x; $x2 = max $x2, $x + $w;
         $y1 = min $y1, $y; $y2 = max $y2, $y + $h;
      }
   }

   my $W = $x2 - $x1;
   my $H = $y2 - $y1;

   ($W, $H)
}

sub invoke_size_allocate {
   my ($self, $W, $H) = @_;

   for my $child ($self->visible_children) {
      my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };

      $x = _scale $pos,  $x, $W;
      $y = _scale $pos,  $x, $H;
      $w = _scale $size, $w, $child->{req_w};
      $h = _scale $size, $h, $child->{req_h};

      $child->configure ($x, $y, $w, $h);
   }

   1
}

#############################################################################

package CFPlus::UI::Box;

our @ISA = CFPlus::UI::Container::;

sub size_request {
   my ($self) = @_;

   $self->{vertical}
      ?  (
            (List::Util::max map $_->{req_w}, @{$self->{children}}),
            (List::Util::sum map $_->{req_h}, @{$self->{children}}),
         )
      :  (
            (List::Util::sum map $_->{req_w}, @{$self->{children}}),
            (List::Util::max map $_->{req_h}, @{$self->{children}}),
         )
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   my $space = $self->{vertical} ? $h : $w;
   my @children = $self->visible_children;

   my @req;

   if ($self->{homogeneous}) {
      @req = ($space / (@children || 1)) x @children;
   } else {
      @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
      my $req = List::Util::sum @req;

      if ($req > $space) {
         # ah well, not enough space
         $_ *= $space / $req for @req;
      } else {
         my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
         
         $space = ($space - $req) / $expand; # remaining space to give away

         $req[$_] += $space * $children[$_]{expand}
            for 0 .. $#children;
      }
   }

   CFPlus::UI::harmonize \@req;

   my $pos = 0;
   for (0 .. $#children) {
      my $alloc = $req[$_];
      $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));

      $pos += $alloc;
   }

   1
}

#############################################################################

package CFPlus::UI::HBox;

our @ISA = CFPlus::UI::Box::;

sub new {
   my $class = shift;

   $class->SUPER::new (
      vertical => 0,
      @_,
   )
}

#############################################################################

package CFPlus::UI::VBox;

our @ISA = CFPlus::UI::Box::;

sub new {
   my $class = shift;

   $class->SUPER::new (
      vertical => 1,
      @_,
   )
}

#############################################################################

package CFPlus::UI::Label;

our @ISA = CFPlus::UI::DrawBG::;

use CFPlus::OpenGL;

sub new {
   my ($class, %arg) = @_;

   my $self = $class->SUPER::new (
      fg         => [1, 1, 1],
      #bg        => none
      #active_bg => none
      #font      => default_font
      #text      => initial text
      #markup    => initial narkup
      #max_w     => maximum pixel width
      #style     => 0, # render flags
      ellipsise  => 3, # end
      layout     => (new CFPlus::Layout),
      fontsize   => 1,
      align      => -1,
      valign     => -1,
      padding_x  => 2,
      padding_y  => 2,
      can_events => 0,
      %arg
   );

   if (exists $self->{template}) {
      my $layout = new CFPlus::Layout;
      $layout->set_text (delete $self->{template});
      $self->{template} = $layout;
   }

   if (exists $self->{markup}) {
      $self->set_markup (delete $self->{markup});
   } else {
      $self->set_text (delete $self->{text});
   }

   $self
}

sub update {
   my ($self) = @_;

   delete $self->{texture};
   $self->SUPER::update;
}

sub realloc {
   my ($self) = @_;

   delete $self->{ox};
   $self->SUPER::realloc;
}

sub set_text {
   my ($self, $text) = @_;

   return if $self->{text} eq "T$text";
   $self->{text} = "T$text";

   $self->{layout}->set_text ($text);

   delete $self->{size_req};
   $self->realloc;
   $self->update;
}

sub set_markup {
   my ($self, $markup) = @_;

   return if $self->{text} eq "M$markup";
   $self->{text} = "M$markup";

   my $rgba = $markup =~ /span.*(?:foreground|background)/;

   $self->{layout}->set_markup ($markup);

   delete $self->{size_req};
   $self->realloc;
   $self->update;
}

sub size_request {
   my ($self) = @_;

   $self->{size_req} ||= do {
      $self->{layout}->set_font ($self->{font}) if $self->{font};
      $self->{layout}->set_width ($self->{max_w} || -1);
      $self->{layout}->set_ellipsise ($self->{ellipsise});
      $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
      $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);

      my ($w, $h) = $self->{layout}->size;

      if (exists $self->{template}) {
         $self->{template}->set_font ($self->{font}) if $self->{font};
         $self->{template}->set_width ($self->{max_w} || -1);
         $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);

         my ($w2, $h2) = $self->{template}->size;

         $w = List::Util::max $w, $w2;
         $h = List::Util::max $h, $h2;
      }

      [$w, $h]
   };

   @{ $self->{size_req} }
}

sub baseline_shift {
   $_[0]{layout}->descent
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   delete $self->{ox};

   delete $self->{texture}
      unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};

   1
}

sub set_fontsize {
   my ($self, $fontsize) = @_;

   $self->{fontsize} = $fontsize;
   delete $self->{size_req};
   delete $self->{texture};

   $self->realloc;
}

sub reconfigure {
   my ($self) = @_;

   delete $self->{size_req};
   delete $self->{texture};

   $self->SUPER::reconfigure;
}

sub _draw {
   my ($self) = @_;

   $self->SUPER::_draw; # draw background, if applicable

   my $size = $self->{texture} ||= do {
      $self->{layout}->set_foreground (@{$self->{fg}});
      $self->{layout}->set_font ($self->{font}) if $self->{font};
      $self->{layout}->set_width ($self->{w});
      $self->{layout}->set_ellipsise ($self->{ellipsise});
      $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
      $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);

      [$self->{layout}->size]
   };

   unless (exists $self->{ox}) {
      $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
                       : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
                       :                      ($self->{w} - $size->[0]) * 0.5);

      $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
                       : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
                       :                       ($self->{h} - $size->[1]) * 0.5);
   };

   my $w = List::Util::min $self->{w} + 4, $size->[0];
   my $h = List::Util::min $self->{h} + 2, $size->[1];

   $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
}

#############################################################################

package CFPlus::UI::EntryBase;

our @ISA = CFPlus::UI::Label::;

use CFPlus::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],
      can_hover  => 1,
      can_focus  => 1,
      valign     => 0,
      can_events => 1,
      ellipsise  => 0,
      #text      => ...
      #hidden    => "*",
      @_
   )
}

sub _set_text {
   my ($self, $text) = @_;

   delete $self->{cur_h};

   return if $self->{text} eq $text;

   $self->{last_activity} = $::NOW;
   $self->{text} = $text;

   $text =~ s/./*/g if $self->{hidden};
   $self->{layout}->set_text ("$text ");
   delete $self->{size_req};

   $self->emit (changed => $self->{text});

   $self->realloc;
   $self->update;
}

sub set_text {
   my ($self, $text) = @_;

   $self->{cursor} = length $text;
   $self->_set_text ($text);
}

sub get_text {
   $_[0]{text}
}

sub size_request {
   my ($self) = @_;

   my ($w, $h) = $self->SUPER::size_request;

   ($w + 1, $h) # add 1 for cursor
}

sub invoke_key_down {
   my ($self, $ev) = @_;

   my $mod = $ev->{mod};
   my $sym = $ev->{sym};
   my $uni = $ev->{unicode};

   my $text = $self->get_text;

   $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;

   if ($uni == 8) {
      substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
   } elsif ($uni == 127) {
      substr $text, $self->{cursor}, 1, "";
   } elsif ($sym == CFPlus::SDLK_LEFT) {
      --$self->{cursor} if $self->{cursor};
   } elsif ($sym == CFPlus::SDLK_RIGHT) {
      ++$self->{cursor} if $self->{cursor} < length $self->{text};
   } elsif ($sym == CFPlus::SDLK_HOME) {
      # what a hack
      $self->{cursor} =
         (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
            ? length $1
            : 0;
   } elsif ($sym == CFPlus::SDLK_END) {
      # uh, again
      $self->{cursor} =
         (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
            ? $self->{cursor} + length $1
            : length $self->{text};
   } elsif ($uni == 21) { # ctrl-u
      $text = "";
      $self->{cursor} = 0;
   } elsif ($uni == 27) {
      $self->emit ('escape');
   } elsif ($uni == 0x0d) {
      substr $text, $self->{cursor}++, 0, "\012";
   } elsif ($uni >= 0x20) {
      substr $text, $self->{cursor}++, 0, chr $uni;
   } else {
      return 0;
   }

   $self->_set_text ($text);

   $self->realloc;
   $self->update;

   1
}

sub invoke_focus_in {
   my ($self) = @_;

   $self->{last_activity} = $::NOW;

   $self->SUPER::invoke_focus_in
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   $self->SUPER::invoke_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; $text = substr $text, 0, $idx; utf8::decode $text;
   $self->{cursor} = length $text;

   $self->_set_text ($self->{text});
   $self->update;
   
   1
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;
#   printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#

   1
}

sub _draw {
   my ($self) = @_;

   local $self->{fg} = $self->{fg};

   if ($FOCUS == $self) {
      glColor_premultiply @{$self->{active_bg}};
      $self->{fg} = $self->{active_fg};
   } else {
      glColor_premultiply @{$self->{bg}};
   }

   glEnable GL_BLEND;
   glBlendFunc GL_ONE, 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) {

      unless (exists $self->{cur_h}) {
         my $text = substr $self->{text}, 0, $self->{cursor};
         utf8::encode $text;

         @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
      }

      glBegin GL_LINES;
      glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
      glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
      glEnd;
   }
}

#############################################################################

package CFPlus::UI::Entry;

our @ISA = CFPlus::UI::EntryBase::;

use CFPlus::OpenGL;

sub invoke_key_down {
   my ($self, $ev) = @_;

   my $sym = $ev->{sym};

   if ($ev->{uni} == 0x0d || $sym == 13) {
      unshift @{$self->{history}},
         my $txt = $self->get_text;

      $self->{history_pointer} = -1;
      $self->{history_saveback} = '';
      $self->emit (activate => $txt);
      $self->update;

   } elsif ($sym == CFPlus::SDLK_UP) {
      if ($self->{history_pointer} < 0) {
         $self->{history_saveback} = $self->get_text;
      }
      if (@{$self->{history} || []} > 0) {
         $self->{history_pointer}++;
         if ($self->{history_pointer} >= @{$self->{history} || []}) {
            $self->{history_pointer} = @{$self->{history} || []} - 1;
         }
         $self->set_text ($self->{history}->[$self->{history_pointer}]);
      }

   } elsif ($sym == CFPlus::SDLK_DOWN) {
      $self->{history_pointer}--;
      $self->{history_pointer} = -1 if $self->{history_pointer} < 0;

      if ($self->{history_pointer} >= 0) {
         $self->set_text ($self->{history}->[$self->{history_pointer}]);
      } else {
         $self->set_text ($self->{history_saveback});
      }

   } else {
      return $self->SUPER::invoke_key_down ($ev)
   }

   1
}

#############################################################################

package CFPlus::UI::TextEdit;

our @ISA = CFPlus::UI::EntryBase::;

use CFPlus::OpenGL;

sub move_cursor_ver {
   my ($self, $dy) = @_;

   my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});

   $y += $dy;

   if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
      $self->{cursor} = $index;
      delete $self->{cur_h};
      $self->update;
      return;
   }
}

sub invoke_key_down {
   my ($self, $ev) = @_;

   my $sym = $ev->{sym};

   if ($sym == CFPlus::SDLK_UP) {
      $self->move_cursor_ver (-1);
   } elsif ($sym == CFPlus::SDLK_DOWN) {
      $self->move_cursor_ver (+1);
   } else {
      return $self->SUPER::invoke_key_down ($ev)
   }

   1
}

#############################################################################

package CFPlus::UI::Button;

our @ISA = CFPlus::UI::Label::;

use CFPlus::OpenGL;

my @tex =
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw(b1_button_inactive.png b1_button_active.png);

sub new {
   my $class = shift;

   $class->SUPER::new (
      padding_x  => 4,
      padding_y  => 4,
      fg         => [1.0, 1.0, 1.0],
      active_fg  => [0.8, 0.8, 0.8],
      can_hover  => 1,
      align      => 0,
      valign     => 0,
      can_events => 1,
      @_
   )
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   $self->emit ("activate")
      if $x >= 0 && $x < $self->{w}
         && $y >= 0 && $y < $self->{h};

   1
}

sub _draw {
   my ($self) = @_;

   local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
   glColor 0, 0, 0, 1;

   my $tex = $tex[$GRAB == $self];
   $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});

   glDisable GL_TEXTURE_2D;

   $self->SUPER::_draw;
}

#############################################################################

package CFPlus::UI::CheckBox;

our @ISA = CFPlus::UI::DrawBG::;

my @tex =
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw(c1_checkbox_bg.png c1_checkbox_active.png);

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   $class->SUPER::new (
      padding_x => 2,
      padding_y => 2,
      fg        => [1, 1, 1],
      active_fg => [1, 1, 0],
      bg        => [0, 0, 0, 0.2],
      active_bg => [1, 1, 1, 0.5],
      state     => 0,
      can_hover => 1,
      @_
   )
}

sub size_request {
   my ($self) = @_;

   (6) x 2
}

sub toggle {
   my ($self) = @_;

   $self->{state} = !$self->{state};
   $self->emit (changed => $self->{state});
   $self->update;
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
       && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
      $self->toggle;
   } else {
      return 0
   }

   1
}

sub _draw {
   my ($self) = @_;

   $self->SUPER::_draw;

   glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;

   my ($w, $h) = @$self{qw(w h)};

   my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;

   glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };

   my $tex = $self->{state} ? $tex[1] : $tex[0];

   glEnable GL_TEXTURE_2D;
   $tex->draw_quad_alpha (0, 0, $s, $s);
   glDisable GL_TEXTURE_2D;
}

#############################################################################

package CFPlus::UI::Image;

our @ISA = CFPlus::UI::Base::;

use CFPlus::OpenGL;

our %texture_cache;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      can_events => 0,
      @_,
   );

   $self->{path} || $self->{tex}
      or Carp::croak "'path' or 'tex' attributes required";

   $self->{tex} ||= $texture_cache{$self->{path}} ||=
      new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;

   CFPlus::weaken $texture_cache{$self->{path}};

   $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};

   $self
}

sub STORABLE_freeze {
   my ($self, $cloning) = @_;

   $self->{path}
      or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";

   $self->{path}
}

sub STORABLE_attach {
   my ($self, $cloning, $path) = @_;

   $self->new (path => $path)
}

sub size_request {
   my ($self) = @_;

   ($self->{tex}{w}, $self->{tex}{h})
}

sub _draw {
   my ($self) = @_;

   my $tex = $self->{tex};

   my ($w, $h) = ($self->{w}, $self->{h});

   if ($self->{rot90}) {
      glRotate 90, 0, 0, 1;
      glTranslate 0, -$self->{w}, 0;

      ($w, $h) = ($h, $w);
   }

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;

   $tex->draw_quad (0, 0, $w, $h);

   glDisable GL_TEXTURE_2D;
}

#############################################################################

package CFPlus::UI::ImageButton;

our @ISA = CFPlus::UI::Image::;

use CFPlus::OpenGL;

my %textures;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      padding_x  => 4,
      padding_y  => 4,
      fg         => [1, 1, 1],
      active_fg  => [0, 0, 1],
      can_hover  => 1,
      align      => 0,
      valign     => 0,
      can_events => 1,
      @_
   );
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   $self->emit ("activate")
      if $x >= 0 && $x < $self->{w}
         && $y >= 0 && $y < $self->{h};

   1
}

#############################################################################

package CFPlus::UI::VGauge;

our @ISA = CFPlus::UI::Base::;

use List::Util qw(min max);

use CFPlus::OpenGL;

my %tex = (
   food => [
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
   ],
   grace => [
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
   ],
   hp => [
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
   ],
   mana => [
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
         qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
   ],
);

# eg. VGauge->new (gauge => 'food'), default gauge: food
sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      type  => 'food',
      @_
   );

   $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};

   $self
}

sub size_request {
   my ($self) = @_;

   #my $tex = $tex{$self->{type}}[0];
   #@$tex{qw(w h)}
   (0, 0)
}

sub set_max {
   my ($self, $max) = @_;

   return if $self->{max_val} == $max;

   $self->{max_val} = $max;
   $self->update;
}

sub set_value {
   my ($self, $val, $max) = @_;

   $self->set_max ($max)
      if defined $max;

   return if $self->{val} == $val;

   $self->{val} = $val;
   $self->update;
}

sub _draw {
   my ($self) = @_;

   my $tex = $tex{$self->{type}};
   my ($t1, $t2, $t3) = @$tex;

   my ($w, $h) = ($self->{w}, $self->{h});

   if ($self->{vertical}) {
      glRotate 90, 0, 0, 1;
      glTranslate 0, -$self->{w}, 0;

      ($w, $h) = ($h, $w);
   }

   my $ycut = $self->{val} / ($self->{max_val} || 1);

   my $ycut1 = max 0, min 1, $ycut;
   my $ycut2 = max 0, min 1, $ycut - 1;

   my $h1 = $self->{h} * (1 - $ycut1);
   my $h2 = $self->{h} * (1 - $ycut2);
   my $h3 = $self->{h};

   $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);

   glEnable GL_BLEND;
   glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
                       GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;

   glBindTexture GL_TEXTURE_2D, $t1->{name};
   glBegin GL_QUADS;
   glTexCoord 0       , 0;                       glVertex 0 , 0;
   glTexCoord 0       , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
   glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
   glTexCoord $t1->{s}, 0;                       glVertex $w, 0;
   glEnd;

   my $ycut1 = List::Util::min 1, $ycut;
   glBindTexture GL_TEXTURE_2D, $t2->{name};
   glBegin GL_QUADS;
   glTexCoord 0       , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
   glTexCoord 0       , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
   glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
   glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
   glEnd;

   if ($t3) {
      glBindTexture GL_TEXTURE_2D, $t3->{name};
      glBegin GL_QUADS;
      glTexCoord 0       , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
      glTexCoord 0       , $t3->{t};                glVertex 0 , $h3;
      glTexCoord $t3->{s}, $t3->{t};                glVertex $w, $h3;
      glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
      glEnd;
   }

   glDisable GL_BLEND;
   glDisable GL_TEXTURE_2D;
}

#############################################################################

package CFPlus::UI::Gauge;

our @ISA = CFPlus::UI::VBox::;

sub new {
   my ($class, %arg) = @_;

   my $self = $class->SUPER::new (
      tooltip    => $arg{type},
      can_hover  => 1,
      can_events => 1,
      %arg,
   );

   $self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
   $self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
   $self->add ($self->{max}   = new CFPlus::UI::Label valign => -1, align => 0, template => "999");

   $self
}

sub set_fontsize {
   my ($self, $fsize) = @_;

   $self->{value}->set_fontsize ($fsize);
   $self->{max}  ->set_fontsize ($fsize);
}

sub set_max {
   my ($self, $max) = @_;

   $self->{gauge}->set_max ($max);
   $self->{max}->set_text ($max);
}

sub set_value {
   my ($self, $val, $max) = @_;

   $self->set_max ($max)
      if defined $max;

   $self->{gauge}->set_value ($val, $max);
   $self->{value}->set_text ($val);
}

#############################################################################

package CFPlus::UI::Slider;

use strict;

use CFPlus::OpenGL;

our @ISA = CFPlus::UI::DrawBG::;

my @tex =
      map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
         qw(s1_slider.png s1_slider_bg.png);

sub new {
   my $class = shift;

   # range [value, low, high, page, unit]

   # TODO: 0-width page
   # TODO: req_w/h are wrong with vertical
   # TODO: calculations are off
   my $self = $class->SUPER::new (
      fg        => [1, 1, 1],
      active_fg => [0, 0, 0],
      bg        => [0, 0, 0, 0.2],
      active_bg => [1, 1, 1, 0.5],
      range     => [0, 0, 100, 10, 0],
      min_w     => $::WIDTH / 80,
      min_h     => $::WIDTH / 80,
      vertical  => 0,
      can_hover => 1,
      inner_pad => 0.02,
      @_
   );

   $self->set_value ($self->{range}[0]);
   $self->update;

   $self
}

sub set_range {
   my ($self, $range) = @_;

   ($range, $self->{range}) = ($self->{range}, $range);

   if ("@$range" ne "@{$self->{range}}") {
      $self->update;
      $self->set_value ($self->{range}[0]);
   }
}

sub set_value {
   my ($self, $value) = @_;

   my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};

   $hi = $lo + 1 if $hi <= $lo;

   $page = $hi - $lo if $page > $hi - $lo;

   $value = $lo         if $value < $lo;
   $value = $hi - $page if $value > $hi - $page;

   $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
      if $unit;

   @{$self->{range}} = ($value, $lo, $hi, $page, $unit);

   if ($value != $old_value) {
      $self->emit (changed => $value);
      $self->update;
   }
}

sub size_request {
   my ($self) = @_;

   ($self->{req_w}, $self->{req_h})
}

sub invoke_button_down {
   my ($self, $ev, $x, $y) = @_;

   $self->SUPER::invoke_button_down ($ev, $x, $y);

   $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
   
   $self->invoke_mouse_motion ($ev, $x, $y)
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;

   if ($GRAB == $self) {
      my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});

      my (undef, $lo, $hi, $page) = @{$self->{range}};

      $x = ($x - $self->{click}[1]) / ($w * $self->{scale});

      $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
   } else {
      return 0;
   }

   1
}

sub invoke_mouse_wheel {
   my ($self, $ev) = @_;

   my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};

   my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;

   $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);

   ! ! $delta
}

sub update {
   my ($self) = @_;

   delete $self->{knob_w};
   $self->SUPER::update;
}

sub _draw {
   my ($self) = @_;

   unless ($self->{knob_w}) {
      $self->set_value ($self->{range}[0]);

      my ($value, $lo, $hi, $page) = @{$self->{range}};
      my $range = ($hi - $page - $lo) || 1e-100;

      my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;

      $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
      $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;

      $value = ($value - $lo) / $range;
      $value = $value * $self->{scale} + $self->{offset};

      $self->{knob_x} = $value - $knob_w * 0.5;
      $self->{knob_w} = $knob_w;
   }

   $self->SUPER::_draw ();

   glScale $self->{w}, $self->{h};

   if ($self->{vertical}) {
      # draw a vertical slider like a rotated horizontal slider
 
      glTranslate 1, 0, 0;
      glRotate 90, 0, 0, 1;
   }

   my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
   my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;

   # draw background
   $tex[1]->draw_quad_alpha (0, 0, 1, 1);

   # draw handle
   $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);

   glDisable GL_TEXTURE_2D;
}

#############################################################################

package CFPlus::UI::ValSlider;

our @ISA = CFPlus::UI::HBox::;

sub new {
   my ($class, %arg) = @_;

   my $range = delete $arg{range};

   my $self = $class->SUPER::new (
      slider     => (new CFPlus::UI::Slider expand => 1, range => $range),
      entry      => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
      to_value   => sub { shift },
      from_value => sub { shift },
      %arg,
   );

   $self->{slider}->connect (changed => sub {
      my ($self, $value) = @_;
      $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
      $self->{parent}->emit (changed => $value);
   });

#   $self->{entry}->connect (changed => sub {
#      my ($self, $value) = @_;
#      $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
#      $self->{parent}->emit (changed => $value);
#   });

   $self->add ($self->{slider}, $self->{entry});

   $self->{slider}->emit (changed => $self->{slider}{range}[0]);

   $self
}

sub set_range { shift->{slider}->set_range (@_) }
sub set_value { shift->{slider}->set_value (@_) }

#############################################################################

package CFPlus::UI::TextScroller;

our @ISA = CFPlus::UI::HBox::;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      fontsize   => 1,
      can_events => 1,
      indent     => 0,
      #font      => default_font
      @_,
                 
      layout     => (new CFPlus::Layout),
      par        => [],
      max_par    => 0,
      height     => 0,
      children   => [
         (new CFPlus::UI::Empty expand => 1),
         (new CFPlus::UI::Slider vertical => 1),
      ],
   );

   $self->{children}[1]->connect (changed => sub { $self->update });

   $self
}

sub set_fontsize {
   my ($self, $fontsize) = @_;

   $self->{fontsize} = $fontsize;
   $self->reflow;
}

sub size_request {
   my ($self) = @_;

   my ($empty, $slider) = @{ $self->{children} };

   local $self->{children} = [$empty, $slider];
   $self->SUPER::size_request
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   my ($empty, $slider, @other) = @{ $self->{children} };
   $_->configure (@$_{qw(x y req_w req_h)}) for @other;

   $self->{layout}->set_font ($self->{font}) if $self->{font};
   $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
   $self->{layout}->set_width ($empty->{w});
   $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});

   $self->reflow;

   local $self->{children} = [$empty, $slider];
   $self->SUPER::invoke_size_allocate ($w, $h)
}

sub invoke_mouse_wheel {
   my ($self, $ev) = @_;

   return 0 unless $ev->{dy}; # only vertical movements

   $self->{children}[1]->emit (mouse_wheel => $ev);

   1
}

sub get_layout {
   my ($self, $para) = @_;

   my $layout = $self->{layout};

   $layout->set_font ($self->{font}) if $self->{font};
   $layout->set_foreground (@{$para->{fg}});
   $layout->set_height ($self->{fontsize} * $::FONTSIZE);
   $layout->set_width ($self->{children}[0]{w} - $para->{indent});
   $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
   $layout->set_markup ($para->{markup});

   $layout->set_shapes (
      map
         +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
         @{$para->{widget}}
   );

   $layout
}

sub reflow {
   my ($self) = @_;

   $self->{need_reflow}++;
   $self->update;
}

sub set_offset {
   my ($self, $offset) = @_;

   # todo: base offset on lines or so, not on pixels
   $self->{children}[1]->set_value ($offset);
}

sub current_paragraph {
   my ($self) = @_;

   $self->{top_paragraph} - 1
}

sub scroll_to {
   my ($self, $para) = @_;

   $para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;

   $self->{scroll_to} = $para;
   $self->update;
}

sub clear {
   my ($self) = @_;

   my (undef, undef, @other) = @{ $self->{children} };
   $self->remove ($_) for @other;

   $self->{par} = [];
   $self->{height} = 0;
   $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
}

sub add_paragraph {
   my $self = shift;

   for my $para (@_) {
      $para = {
         fg      => [1, 1, 1, 1],
         indent  => 0,
         markup  => "",
         widget  => [],
         ref $para ? %$para : (markup => $para),
         w       => 1e10,
         wrapped => 1,
      };

      $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
      push @{$self->{par}}, $para;
   }

   if (my $max = $self->{max_par}) {
      shift @{$self->{par}} while @{$self->{par}} > $max;
   }

   $self->{need_reflow}++;
   $self->update;
}

sub scroll_to_bottom {
   my ($self) = @_;

   $self->{scroll_to} = $#{$self->{par}};
   $self->update;
}

sub force_uptodate {
   my ($self) = @_;

   if (delete $self->{need_reflow}) {
      my ($W, $H) = @{$self->{children}[0]}{qw(w h)};

      my $height = 0;

      for my $para (@{$self->{par}}) {
         if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
            my $layout = $self->get_layout ($para);
            my ($w, $h) = $layout->size;

            $para->{w}       = $w + $para->{indent};
            $para->{h}       = $h;
            $para->{wrapped} = $layout->has_wrapped;
         }

         $para->{y} = $height;
         $height += $para->{h};
      }

      $self->{height} = $height;
      $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);

      delete $self->{texture};
   }

   if (my $paridx = delete $self->{scroll_to}) {
      $self->{children}[1]->set_value ($self->{par}[$paridx]{y});
   }
}

sub update {
   my ($self) = @_;

   $self->SUPER::update;

   return unless $self->{h} > 0;

   delete $self->{texture};

   $ROOT->on_post_alloc ($self => sub {
      $self->force_uptodate;

      my ($W, $H) = @{$self->{children}[0]}{qw(w h)};

      $self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
         glClearColor 0, 0, 0, 0;
         glClear GL_COLOR_BUFFER_BIT;

         package CFPlus::UI::Base;
         local ($draw_x, $draw_y, $draw_w, $draw_h) =
            (0, 0, $self->{w}, $self->{h});

         my $top = int $self->{children}[1]{range}[0];

         my $paridx = 0;
         my $top_paragraph;
         my $top = int $self->{children}[1]{range}[0];

         my $y0 = $top;
         my $y1 = $top + $H;

         for my $para (@{$self->{par}}) {
            my $h = $para->{h};
            my $y = $para->{y};

            if ($y0 < $y + $h && $y < $y1) {
               my $layout = $self->get_layout ($para);

               $layout->render ($para->{indent}, $y - $y0);

               if (my @w = @{ $para->{widget} }) {
                  my @s = $layout->get_shapes;

                  for (@w) {
                     my ($dx, $dy) = splice @s, 0, 2, ();

                     $_->{x} = $dx + $para->{indent};
                     $_->{y} = $dy + $y - $y0;

                     $_->draw;
                  }
               }
            }

            $paridx++;
            $top_paragraph ||= $paridx if $y >= $top;
         }

         $self->{top_paragraph} = $top_paragraph;
      };
   });
}

sub reconfigure {
   my ($self) = @_;

   $self->SUPER::reconfigure;

   $_->{w} = 1e10 for @{ $self->{par} };
   $self->reflow;
}

sub _draw {
   my ($self) = @_;

   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
   glColor 0, 0, 0, 1;
   $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
   glDisable GL_TEXTURE_2D;

   $self->{children}[1]->draw;
}

#############################################################################

package CFPlus::UI::Animator;

use CFPlus::OpenGL;

our @ISA = CFPlus::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 CFPlus::UI::Flopper;

our @ISA = CFPlus::UI::Button::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      state       => 0,
      on_activate => \&toggle_flopper,
      @_
   );

   $self
}

sub toggle_flopper {
   my ($self) = @_;

   $self->{other}->toggle_visibility;
}

#############################################################################

package CFPlus::UI::Tooltip;

our @ISA = CFPlus::UI::Bin::;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   $class->SUPER::new (
      @_,
      can_events => 0,
   )
}

sub set_tooltip_from {
   my ($self, $widget) = @_;

   $widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
      if $widget->{tooltip} =~ /^#(.*)$/;

   my $tooltip = $widget->{tooltip};

   if ($ENV{CFPLUS_DEBUG} & 2) {
      $tooltip .= "\n\n" . (ref $widget) . "\n"
                . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
                . "req $widget->{req_w} $widget->{req_h}\n"
                . "visible $widget->{visible}";
   }

   $tooltip =~ s/^\n+//;
   $tooltip =~ s/\n+$//;

   $self->add (new CFPlus::UI::Label
      markup    => $tooltip,
      max_w     => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
      fontsize  => 0.8,
      style     => 1, # FLAG_INVERSE
      ellipsise => 0,
      font      => ($widget->{tooltip_font} || $::FONT_PROP),
   );
}

sub size_request {
   my ($self) = @_;

   my ($w, $h) = @{$self->child}{qw(req_w req_h)};

   ($w + 4, $h + 4)
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
}

sub invoke_visibility_change {
   my ($self, $visible) = @_;

   return unless $visible;

   $self->{root}->on_post_alloc ("move_$self" => sub {
      my $widget = $self->{owner}
         or return;

      if ($widget->{visible}) {
         my ($x, $y) = $widget->coord2global ($widget->{w}, 0);

         ($x, $y) = $widget->coord2global (-$self->{w}, 0)
            if $x + $self->{w} > $self->{root}{w};

         $self->move_abs ($x, $y);
      } else {
         $self->hide;
      }
   });
}

sub _draw {
   my ($self) = @_;

   glTranslate 0.375, 0.375;

   my ($w, $h) = @$self{qw(w h)};

   glColor 1, 0.8, 0.4;
   glBegin GL_QUADS;
   glVertex 0 , 0;
   glVertex 0 , $h;
   glVertex $w, $h;
   glVertex $w, 0;
   glEnd;
   
   glColor 0, 0, 0;
   glBegin GL_LINE_LOOP;
   glVertex 0 , 0;
   glVertex 0 , $h;
   glVertex $w, $h;
   glVertex $w, 0;
   glEnd;
   
   glTranslate 2 - 0.375, 2 - 0.375;

   $self->SUPER::_draw;
}

#############################################################################

package CFPlus::UI::Face;

our @ISA = CFPlus::UI::DrawBG::;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      size_w     => 32,
      size_h     => 8,
      aspect     => 1,
      can_events => 0,
      @_,
   );

   if ($self->{anim} && $self->{animspeed}) {
      CFPlus::weaken (my $widget = $self);

      $widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed};
      $widget->{anim_start} = $self->{animspeed} * Event::time / $self->{animspeed};
      $self->{timer} = Event->timer (
         parked   => 1,
         cb       => sub {
            return unless $::CONN && $widget;

            ++$widget->{frame};
            $widget->update_face;
            $widget->update;

            $widget->update_timer;
         },
      );

      $self->update_face;
      $self->update_timer;
   }
   
   $self
}

sub update_timer {
   my ($self) = @_;

   return unless $self->{timer};

   if ($self->{visible}) {
      $self->{timer}->at (
         $self->{anim_start}
         + $self->{animspeed}
           * int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
      );
      $self->{timer}->start;
   } else {
      $self->{timer}->stop;
   }
}

sub update_face {
   my ($self) = @_;

   return unless $::CONN;

   if (my $anim = $::CONN->{anim}[$self->{anim}]) {
      if ($anim && @$anim) {
         delete $self->{wait_face};
         $self->{face} = $anim->[ $self->{frame} % @$anim ];
      }
   }
}

sub size_request {
   my ($self) = @_;

   if ($::CONN) {
      if (my $faceid = $::CONN->{faceid}[$self->{face}]) {
         if (my $tex = $::CONN->{texture}[$faceid]) {
            return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
         } else {
            $self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub {
               $self->realloc;
            });
         }
      }
   }

   ($self->{size_w} || 8, $self->{size_h} || 8)
}

sub update {
   my ($self) = @_;

   return unless $self->{visible};

   $self->SUPER::update;
}

sub invoke_visibility_change {
   my ($self) = @_;

   $self->update_timer;

   0
}

sub _draw {
   my ($self) = @_;

   return unless $::CONN;

   $self->SUPER::_draw;

   my $faceid = $::CONN->{faceid}[$self->{face}]
      or return;
   
   my $tex = $::CONN->{texture}[$faceid];

   if ($tex) {
      glEnable GL_TEXTURE_2D;
      glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
      glColor 0, 0, 0, 1;
      $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
      glDisable GL_TEXTURE_2D;
   }
}

sub destroy {
   my ($self) = @_;

   (delete $self->{timer})->cancel
      if $self->{timer};

   $self->SUPER::destroy;
}

#############################################################################

package CFPlus::UI::Buttonbar;

our @ISA = CFPlus::UI::HBox::;

# TODO: should actually wrap buttons and other goodies.

#############################################################################

package CFPlus::UI::Menu;

our @ISA = CFPlus::UI::Toplevel::;

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      items => [],
      z     => 100,
      @_,
   );

   $self->add ($self->{vbox} = new CFPlus::UI::VBox);

   for my $item (@{ $self->{items} }) {
      my ($widget, $cb, $tooltip) = @$item;

      # handle various types of items, only text for now
      if (!ref $widget) {
         if ($widget =~ /\t/) {
            my ($left, $right) = split /\t/, $widget, 2;

            $widget = new CFPlus::UI::HBox
               can_hover  => 1,
               can_events => 1,
               tooltip    => $tooltip,
               children   => [
                  (new CFPlus::UI::Label markup => $left, expand => 1),
                  (new CFPlus::UI::Label markup => $right, align => +1),
               ],
            ;
               
         } else {
            $widget = new CFPlus::UI::Label
               can_hover  => 1,
               can_events => 1,
               markup     => $widget,
               tooltip    => $tooltip;
         }
      }

      $self->{item}{$widget} = $item;

      $self->{vbox}->add ($widget);
   }

   $self
}

# popup given the event (must be a mouse button down event currently)
sub popup {
   my ($self, $ev) = @_;

   $self->emit ("popdown");

   # maybe save $GRAB? must be careful about events...
   $GRAB = $self;
   $self->{button} = $ev->{button};

   $self->show;
   $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;

   # TODO: should use vbox->find_widget or so
   $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
   $self->{hover} = $self->{item}{$HOVER};

   0
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   if ($ev->{button} == $self->{button}) {
      undef $GRAB;
      $self->hide;

      $self->emit ("popdown");
      $self->{hover}[1]->() if $self->{hover};
   } else {
      return 0
   }

   1
}

#############################################################################

package CFPlus::UI::Multiplexer;

our @ISA = CFPlus::UI::Container::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      @_,
   );

   $self->{current} = $self->{children}[0]
      if @{ $self->{children} };

   $self
}

sub add {
   my ($self, @widgets) = @_;

   $self->SUPER::add (@widgets);

   $self->{current} = $self->{children}[0]
      if @{ $self->{children} };
}

sub get_current_page {
   my ($self) = @_;

   $self->{current}
}

sub set_current_page {
   my ($self, $page_or_widget) = @_;

   my $widget = ref $page_or_widget
                   ? $page_or_widget
                   : $self->{children}[$page_or_widget];

   $self->{current} = $widget;
   $self->{current}->configure (0, 0, $self->{w}, $self->{h});

   $self->emit (page_changed => $self->{current});

   $self->realloc;
}

sub visible_children {
   $_[0]{current}
}

sub size_request {
   my ($self) = @_;

   $self->{current}->size_request
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   $self->{current}->configure (0, 0, $w, $h);

   1
}

sub _draw {
   my ($self) = @_;

   $self->{current}->draw;
}

#############################################################################

package CFPlus::UI::Notebook;

our @ISA = CFPlus::UI::VBox::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      buttonbar   => (new CFPlus::UI::Buttonbar),
      multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
      # filter => # will be put between multiplexer and $self
      @_,
   );
   
   $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
   $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});

   $self
}

sub add {
   my ($self, $title, $widget, $tooltip) = @_;

   CFPlus::weaken $self;

   $self->{buttonbar}->add (new CFPlus::UI::Button
      markup      => $title,
      tooltip     => $tooltip,
      on_activate => sub { $self->set_current_page ($widget) },
   );

   $self->{multiplexer}->add ($widget);
}

sub get_current_page {
   my ($self) = @_;

   $self->{multiplexer}->get_current_page
}

sub set_current_page {
   my ($self, $page) = @_;

   $self->{multiplexer}->set_current_page ($page);
   $self->emit (page_changed => $self->{multiplexer}{current});
}

#############################################################################

package CFPlus::UI::Selector;

use utf8;

our @ISA = CFPlus::UI::Button::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      options => [], # [value, title, longdesc], ...
      value   => undef,
      @_,
   );

   $self->_set_value ($self->{value});

   $self
}

sub invoke_button_down {
   my ($self, $ev) = @_;

   my @menu_items;

   for (@{ $self->{options} }) {
      my ($value, $title, $tooltip) = @$_;

      push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
   }

   CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
}

sub _set_value {
   my ($self, $value) = @_;

   my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
      or return;

   $self->{value} = $item->[0];
   $self->set_markup ("$item->[1] ⇓");
   $self->set_tooltip ($item->[2]);
}

sub set_value {
   my ($self, $value) = @_;

   return unless $self->{value} ne $value;

   $self->_set_value ($value);
   $self->emit (changed => $value);
}

#############################################################################

package CFPlus::UI::Statusbox;

our @ISA = CFPlus::UI::VBox::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      fontsize => 0.8,
      @_,
   );

   CFPlus::weaken (my $this = $self);

   $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });

   $self
}

sub reorder {
   my ($self) = @_;
   my $NOW = Time::HiRes::time;

   # freeze display when hovering over any label
   return if $CFPlus::UI::TOOLTIP->{owner}
             && grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
                   values %{ $self->{item} };

   while (my ($k, $v) = each %{ $self->{item} }) {
      delete $self->{item}{$k} if $v->{timeout} < $NOW;
   }

   my @widgets;

   my @items = sort {
                  $a->{pri} <=> $b->{pri}
                     or $b->{id} <=> $a->{id}
               } values %{ $self->{item} };

   $self->{timer}->interval (1);

   my $count = 10 + 1;
   for my $item (@items) {
      last unless --$count;

      my $label = $item->{label} ||= do {
         # TODO: doesn't handle markup well (read as: at all)
         my $short = $item->{count} > 1
                     ? "<b>$item->{count} ×</b> $item->{text}"
                     : $item->{text};

         for ($short) {
            s/^\s+//;
            s/\s+/ /g;
         }

         new CFPlus::UI::Label
            markup        => $short,
            tooltip       => $item->{tooltip},
            tooltip_font  => $::FONT_PROP,
            tooltip_width => 0.67,
            fontsize      => $item->{fontsize} || $self->{fontsize},
            max_w         => $::WIDTH * 0.44,
            fg            => [@{ $item->{fg} }],
            can_events    => 1,
            can_hover     => 1
      };

      if ((my $diff = $item->{timeout} - $NOW) < 2) {
         $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
         $label->update;
         $label->set_max_size (undef, $label->{req_h} * $diff)
            if $diff < 1;
         $self->{timer}->interval (1/30);
      } else {
         $label->{fg}[3] = $item->{fg}[3] || 1;
      }

      push @widgets, $label;
   }

   $self->clear;
   $self->SUPER::add (reverse @widgets);
}

sub add {
   my ($self, $text, %arg) = @_;

   $text =~ s/^\s+//;
   $text =~ s/\s+$//;

   return unless $text;

   my $timeout = (int time) + ((delete $arg{timeout}) || 60);

   my $group = exists $arg{group} ? $arg{group} : ++$self->{id};

   if (my $item = $self->{item}{$group}) {
      if ($item->{text} eq $text) {
         $item->{count}++;
      } else {
         $item->{count} = 1;
         $item->{text} = $item->{tooltip} = $text;
      }
      $item->{id} += 0.2;#d#
      $item->{timeout} = $timeout;
      delete $item->{label};
   } else {
      $self->{item}{$group} = {
         id       => ++$self->{id},
         text     => $text,
         timeout  => $timeout,
         tooltip  => $text,
         fg       => [0.8, 0.8, 0.8, 0.8],
         pri      => 0,
         count    => 1,
         %arg,
      };
   }

   $ROOT->on_refresh (reorder => sub {
      $self->reorder;
   });
}

sub reconfigure {
   my ($self) = @_;

   delete $_->{label}
      for values %{ $self->{item} || {} };

   $self->reorder;
   $self->SUPER::reconfigure;
}

sub destroy {
   my ($self) = @_;

   $self->{timer}->cancel;

   $self->SUPER::destroy;
}

#############################################################################

package CFPlus::UI::Root;

our @ISA = CFPlus::UI::Container::;

use List::Util qw(min max);

use CFPlus::OpenGL;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      visible => 1,
      @_,
   );

   CFPlus::weaken ($self->{root} = $self);

   $self
}

sub size_request {
   my ($self) = @_;

   ($self->{w}, $self->{h})
}

sub _to_pixel {
   my ($coord, $size, $max) = @_;

   $coord =
      $coord eq "center" ? ($max - $size) * 0.5
    : $coord eq "max"    ? $max
    :                      $coord;

   $coord = 0            if $coord < 0;
   $coord = $max - $size if $coord > $max - $size;

   int $coord + 0.5
}

sub invoke_size_allocate {
   my ($self, $w, $h) = @_;

   for my $child ($self->children) {
      my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};

      $X = $child->{force_x} if exists $child->{force_x};
      $Y = $child->{force_y} if exists $child->{force_y};

      $X = _to_pixel $X, $W, $self->{w};
      $Y = _to_pixel $Y, $H, $self->{h};

      $child->configure ($X, $Y, $W, $H);
   }

   1
}

sub coord2local {
   my ($self, $x, $y) = @_;

   ($x, $y)
}

sub coord2global {
   my ($self, $x, $y) = @_;

   ($x, $y)
}

sub update {
   my ($self) = @_;

   $::WANT_REFRESH++;
}

sub add {
   my ($self, @children) = @_;

   $_->{is_toplevel} = 1
      for @children;

   $self->SUPER::add (@children);
}

sub remove {
   my ($self, @children) = @_;

   $self->SUPER::remove (@children);

   delete $self->{is_toplevel}
      for @children;

   while (@children) {
      my $w = pop @children;
      push @children, $w->children;
      $w->set_invisible;
   }
}

sub on_refresh {
   my ($self, $id, $cb) = @_;

   $self->{refresh_hook}{$id} = $cb;
}

sub on_post_alloc {
   my ($self, $id, $cb) = @_;

   $self->{post_alloc_hook}{$id} = $cb;
}

sub draw {
   my ($self) = @_;

   while ($self->{refresh_hook}) {
      $_->()
         for values %{delete $self->{refresh_hook}};
   }

   if ($self->{realloc}) {
      my %queue;
      my @queue;
      my $widget;

      outer:
      while () {
         if (my $realloc = delete $self->{realloc}) {
            for $widget (values %$realloc) {
               $widget->{visible} or next; # do not resize invisible widgets

               $queue{$widget+0}++ and next; # duplicates are common

               push @{ $queue[$widget->{visible}] }, $widget;
            }
         }

         while () {
            @queue or last outer;

            $widget = pop @{ $queue[-1] || [] }
               and last;
            
            pop @queue;
         }

         delete $queue{$widget+0};

         my ($w, $h) = $widget->size_request;

         $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
         $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;

         $w = min $widget->{max_w}, $w if exists $widget->{max_w};
         $h = min $widget->{max_h}, $h if exists $widget->{max_h};

         $w = $widget->{force_w} if exists $widget->{force_w};
         $h = $widget->{force_h} if exists $widget->{force_h};

         if ($widget->{req_w} != $w || $widget->{req_h} != $h
             || delete $widget->{force_realloc}) {
            $widget->{req_w} = $w;
            $widget->{req_h} = $h;

            $self->{size_alloc}{$widget+0} = $widget;

            if (my $parent = $widget->{parent}) {
               $self->{realloc}{$parent+0} = $parent
                  unless $queue{$parent+0};

               $parent->{force_size_alloc} = 1;
               $self->{size_alloc}{$parent+0} = $parent;
            }
         }

         delete $self->{realloc}{$widget+0};
       }
   }

   while (my $size_alloc = delete $self->{size_alloc}) {
      my @queue = sort { $b->{visible} <=> $a->{visible} }
                       values %$size_alloc;

      while () {
         my $widget = pop @queue || last;

         my ($w, $h) = @$widget{qw(alloc_w alloc_h)};

         $w = 0 if $w < 0;
         $h = 0 if $h < 0;

         $w = max $widget->{min_w}, $w;
         $h = max $widget->{min_h}, $h;

#         $w = min $self->{w} - $widget->{x}, $w if $self->{w};
#         $h = min $self->{h} - $widget->{y}, $h if $self->{h};

         $w = min $widget->{max_w}, $w if exists $widget->{max_w};
         $h = min $widget->{max_h}, $h if exists $widget->{max_h};

         $w = int $w + 0.5;
         $h = int $h + 0.5;

         if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
            $widget->{old_w} = $widget->{w};
            $widget->{old_h} = $widget->{h};

            $widget->{w} = $w;
            $widget->{h} = $h;

            $widget->emit (size_allocate => $w, $h);
         }
      }
   }

   while ($self->{post_alloc_hook}) {
      $_->()
         for values %{delete $self->{post_alloc_hook}};
   }

   glViewport 0, 0, $::WIDTH, $::HEIGHT;
   glClearColor +($::CFG->{fow_intensity}) x 3, 1;
   glClear GL_COLOR_BUFFER_BIT;

   glMatrixMode GL_PROJECTION;
   glLoadIdentity;
   glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
   glMatrixMode GL_MODELVIEW;
   glLoadIdentity;

   {
      package CFPlus::UI::Base;

      local ($draw_x, $draw_y, $draw_w, $draw_h) =
         (0, 0, $self->{w}, $self->{h});

      $self->_draw;
   }
}

#############################################################################

package CFPlus::UI;

$ROOT = new CFPlus::UI::Root;
$TOOLTIP = new CFPlus::UI::Tooltip z => 900;

1

Revision:	1.384
Committed:	Fri Jul 20 16:32:11 2007 UTC (16 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.383:	+2376 -0 lines
Log Message:	change Table->add to add_at method and deprecate add method (to be replaced by a container-compliant one)