# Games::Construder - A 3D Game written in Perl with an infinite and modifiable world.
# Copyright (C) 2011  Robin Redeker
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
package Games::Construder::Client::Frontend;
use common::sense;
use Carp;
use SDL;
use SDLx::App;
use SDL::Mouse;
use SDL::Video;
use SDL::Events;
use SDLx::Sound;
use SDL::Image;
use SDL::Event;
use OpenGL qw(:all);
use OpenGL::List;
use AnyEvent;
use Math::Trig qw/deg2rad rad2deg pi tan atan/;
use Time::HiRes qw/time/;
use POSIX qw/floor/;
use Games::Construder;
use Games::Construder::Vector;

use Games::Construder::Client::World;
use Games::Construder::Client::Resources;
use Games::Construder::UI;
use Games::Construder::Client::UI;

use base qw/Object::Event/;

=head1 NAME

Games::Construder::Client::Frontend - desc

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 METHODS

=over 4

=item my $obj = Games::Construder::Client::Frontend->new (%args)

=cut

my ($WIDTH, $HEIGHT) = (800, 600);
my $DEPTH = 24;
my $UPDATE_P_FRAME = 25;

my $PL_HEIGHT  = 1.3;
my $PL_RAD     = 0.3;
my $PL_VIS_RAD = 3;
my $FAR_PLANE  = 26;
my $FOG_DEFAULT = "Darkness";
my %FOGS = (
   Darkness    => [0, 0, 0, 1],
   Athmosphere => [0.45, 0.45, 0.65, 1],
);

sub new {
   my $this  = shift;
   my $class = ref ($this) || $this;
   my $self  = { @_ };
   bless $self, $class;

   $self->init_object_events;
   $self->init_app;
   Games::Construder::Renderer::init ();
   Games::Construder::Client::UI::init_ui;
   world_init;

   $self->init_physics;
   $self->setup_event_poller;


   return $self
}

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

   $self->{ghost_mode} = 0;

   $self->{phys_obj}->{player} = {
      pos => [5.5, 3.5, 5.5],#-25, -50, -25),
      vel => [0, 0, 0],
   };

   $self->{box_highlights} = [];
}

sub exit_app {
   my ($self) = @_;
   exit;
}

sub resize_app {
   my ($self, $nw, $nh) = @_;

   $self->{res}->desetup_textures;
   $self->unload_geoms;

   for (values %{$self->{active_uis}}) {
      $_->pre_resize_screen ($nw, $nh);
   }
   for (values %{$self->{inactive_uis}}) {
      $_->pre_resize_screen ($nw, $nh);
   }

   eval {
      $self->{app}->resize ($nw, $nh);
   };
   if ($@) {
      $self->msg ("Can't resize application: $@");
   }

   ($WIDTH, $HEIGHT) = ($nw, $nh);

   $self->init_gl;

   $self->{res}->setup_textures;

   for (values %{$self->{active_uis}}) {
      $_->resize_screen ($nw, $nh);
      $_->update;
   }
   for (values %{$self->{inactive_uis}}) {
      $_->resize_screen ($nw, $nh);
   }

   $self->all_chunks_dirty;

   delete $self->{cached_cam_cone};
   $self->calc_visibility;
}

sub init_app {
   my ($self) = @_;
   $self->{app} = SDLx::App->new (
      title  => "Construder 0.01alpha",
      width  => $WIDTH,
      height => $HEIGHT,
      d      => $DEPTH,
      gl     => 1,
      resizeable => 1
   );

   #d# my $init = SDL::Mixer::init (SDL::Mixer::MIX_INIT_OGG);
   #d# unless ($init & SDL::Mixer::MIX_INIT_OGG) {
   #d#    die "Couldn't initialize SDL Mixer for OGG!\n";
   #d# }

   #d# SDL::Mixer::open_audio( 44100, SDL::Mixer::AUDIO_S16SYS, 2, 4096 );
   #d# SDL::Mixer::Music::volume_music ($self->{res}->{config}->{volume_music});

   $self->set_ambient_light ($self->{res}->{config}->{ambient_light});

   SDL::Events::enable_unicode (1);
   $self->{sdl_event} = SDL::Event->new;
   SDL::Video::GL_set_attribute (SDL::Constants::SDL_GL_SWAP_CONTROL, 1);
   SDL::Video::GL_set_attribute (SDL::Constants::SDL_GL_DOUBLEBUFFER, 1);

   $self->init_gl;
}

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

   glDepthFunc(GL_LESS);
   glEnable (GL_DEPTH_TEST);
   glDisable (GL_DITHER);

   glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
   glEnable (GL_BLEND);
   glEnable (GL_CULL_FACE);
   glCullFace (GL_BACK);

   glHint (GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST);
   glEnable (GL_TEXTURE_2D);
   glEnable (GL_FOG);
   glClearDepth (1.0);
   glShadeModel (GL_FLAT);

   glFogi (GL_FOG_MODE, GL_LINEAR);
   glFogf (GL_FOG_DENSITY, 0.45);
   glHint (GL_FOG_HINT, GL_FASTEST);

   $self->visibility_radius ($PL_VIS_RAD);
   $self->update_fog;

   glViewport (0, 0, $WIDTH, $HEIGHT);
}

sub fog {
   my ($self) = @_;
   $self->{res}->{config}->{fog} eq ''
      ? $FOG_DEFAULT
      : $self->{res}->{config}->{fog}
}

sub update_fog {
   my ($self) = @_;
   my $fog = $FOGS{$self->fog ()} || $FOGS{$FOG_DEFAULT};
   glClearColor (@$fog);
   glFogfv_p (GL_FOG_COLOR, @$fog);
}

#  0 front  1 top    2 back   3 left   4 right  5 bottom
my @indices  = (
   qw/ 0 1 2 3 /, # 0 front
   qw/ 1 5 6 2 /, # 1 top
   qw/ 7 6 5 4 /, # 2 back
   qw/ 4 5 1 0 /, # 3 left
   qw/ 3 2 6 7 /, # 4 right
   qw/ 3 7 4 0 /, # 5 bottom
);

my @vertices = (
   [ 0,  0,  0 ],
   [ 0,  1,  0 ],
   [ 1,  1,  0 ],
   [ 1,  0,  0 ],

   [ 0,  0,  1 ],
   [ 0,  1,  1 ],
   [ 1,  1,  1 ],
   [ 1,  0,  1 ],
);

sub _render_quad {
   my ($pos, $scale) = @_;

   $scale ||= 1;

   for my $face (0..5) {
      for my $vertex (0..3) {
         my $index  = $indices[4 * $face + $vertex];
         my $coords = $vertices[$index];

         glVertex3f (
            ($coords->[0] * $scale) + $pos->[0],
            ($coords->[1] * $scale) + $pos->[1],
            ($coords->[2] * $scale) + $pos->[2]
         );
      }
   }
}

sub _render_highlight {
   my ($pos, $color, $rad) = @_;

   $rad ||= 0.08;
   $pos = vsubd ($pos, $rad, $rad, $rad);
   glPushMatrix;
   glBindTexture (GL_TEXTURE_2D, 0);
   glColor4f (@$color);
   glTranslatef (@$pos);
   glScalef (1 + 2*$rad, 1 + 2*$rad, 1+2*$rad);
   glBegin (GL_QUADS);
   _render_quad ([0, 0, 0]);
   glEnd;
   glPopMatrix;
}

sub set_ambient_light {
   my ($self, $l) = @_;
   Games::Construder::Renderer::set_ambient_light ($l);
   $self->all_chunks_dirty;
}

sub all_chunks_dirty {
   my ($self) = @_;
   for my $id (keys %{$self->{compiled_chunks}}) {
      $self->{dirty_chunks}->{$id} = 1;
   }
}

sub free_compiled_chunk {
   my ($self, $cx, $cy, $cz) = @_;
   my $c = [$cx, $cy, $cz];
   my $id = world_pos2id ($c);
   my $l = delete $self->{compiled_chunks}->{$id};
   delete $self->{dirty_chunks}->{$id};
   Games::Construder::Renderer::free_geom ($l) if $l;
   # WARNING FIXME XXX: this might not free up all chunks that were set/initialized by the server!
   Games::Construder::World::purge_chunk (@$c);
}

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

   for (keys %{$self->{compiled_chunks}}) {
      my $geom = delete $self->{compiled_chunks}->{$_};
      Games::Construder::Renderer::free_geom ($geom);
   }
}

sub compile_chunk {
   my ($self, $cx, $cy, $cz) = @_;
   my $id = world_pos2id ([$cx, $cy, $cz]);

   #d# warn "compiling... $cx, $cy, $cz.\n";
   my $geom = $self->{compiled_chunks}->{$id};

   unless ($geom) {
      $geom = $self->{compiled_chunks}->{$id} =
         Games::Construder::Renderer::new_geom ();
   }

   delete $self->{dirty_chunks}->{$id};
   return Games::Construder::Renderer::chunk ($cx, $cy, $cz, $geom);
}

sub step_animations {
   my ($self, $dt) = @_;

   my @next_hl;
   for my $bl (@{$self->{box_highlights}}) {
      my ($pos, $color, $attr) = @$bl;

      if ($attr->{fading}) {
         if ($attr->{fading} > 0) {
            next if $color->[3] <= 0; # remove fade
            $color->[3] -= (1 / $attr->{fading}) * $dt;
         } else {
            next if $color->[3] >= 1; # remove fade
            $color->[3] += (1 / (-1 * $attr->{fading})) * $dt;
         }
      }

      push @next_hl, $bl;
   }
   $self->{box_highlights} = \@next_hl;
}

sub set_player_pos {
   my ($self, $pos) = @_;
   warn "NEW PLAYER POS: @$pos\n";
   $self->{phys_obj}->{player}->{pos} = $pos;
   delete $self->{visible_chunks};
   $self->calc_visibility;
}

sub set_other_poses {
   my ($self, $poses) = @_;
   $self->{other_players} = @$poses;
}

sub get_visible_chunks {
   my ($self) = @_;
   Games::Construder::Util::visible_chunks_at (
      $self->{phys_obj}->{player}->{pos}, $PL_VIS_RAD);
}

# currently used to determine which chunks to keep cached:
sub can_see_chunk {
   my ($self, $cx, $cy, $cz, $range_fact) = @_;
   my $plc = [world_pos2chunk ($self->{phys_obj}->{player}->{pos})];
   vlength (vsub ([$cx, $cy, $cz], $plc)) < $PL_VIS_RAD * ($range_fact || 1);
}

sub dirty_chunk {
   my ($self, $chnk) = @_;
   my $id = world_pos2id ($chnk);
   $self->{dirty_chunks}->{$id} = $chnk;
}

sub clear_chunk {
   my ($self, $chnk) = @_;
   $self->free_compiled_chunk (@$chnk);
}

sub remove_highlight_model {
   my ($self, $id) = @_;
   delete $self->{model_highlights}->{$id};
}

sub add_highlight_model {
   my ($self, $pos, $relposes, $id) = @_;
# FIXME: might need to be rebuilt on init_gl()! (resizes!)
   $self->{model_highlights}->{$id} = OpenGL::List::glpList {
      glPushMatrix;
      glBindTexture (GL_TEXTURE_2D, 0);
      glTranslatef (@$pos);
      for (@$relposes) {
         my ($p, $c) = @$_;
         $p = vaddd ($p, 0.3, 0.3, 0.3);
         glColor4f (@{@$c > 3 ? $c : [@$c, 0.5]});
         glBegin (GL_QUADS);
         _render_quad ($p, 0.3);
         glEnd;
      }
      glPopMatrix;
   };
}

sub add_highlight {
   my ($self, $pos, $color, $fade, $id) = @_;

   push @$color, 0 if @$color < 4;

   #d# warn "HIGHLIGHt AT " .vstr ($pos) . " $fade > @$color > \n";

   $color->[3] = 1 if $fade > 0;
   push @{$self->{box_highlights}},
      [$pos, $color, { fading => $fade, rad => 0.08 + rand (0.005) }, $id];
}

my $old_pp;

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

   my $play_pos = $self->{phys_obj}->{player}->{pos};
   my $ppf = vfloor ($play_pos);
   return unless
      !$self->{cached_cam_cone}
      || $ppf->[0] != $old_pp->[0]
      || $ppf->[1] != $old_pp->[1]
      || $ppf->[2] != $old_pp->[2];
   $old_pp = $ppf;

   my $cam_pos  = vaddd ($play_pos, 0, $PL_HEIGHT, 0);
   my (@fcone) = $self->cam_cone;
   unshift @fcone, $cam_pos;

   my $vis_chunks =
      Games::Construder::Math::calc_visible_chunks_at_in_cone (
         @$play_pos, $PL_VIS_RAD,
         @{$fcone[0]}, @{$fcone[1]}, $fcone[2],
         $Games::Construder::Client::World::BSPHERE);

   my @chunks;
   my $plchnk = [world_pos2chunk ($ppf)];
   for my $x (-1,0,1) {
      for my $y (-1,0,1) {
         for my $z (-1,0,1) {
            my $c = vaddd ($plchnk, $x, $y, $z);
            push @chunks, $c;
         }
      }
   }

   while (@$vis_chunks) {
      push @chunks, [shift @$vis_chunks, shift @$vis_chunks, shift @$vis_chunks];
   }

   my $old_vis = $self->{visible_chunks};
   my $new_vis = { };
   my (@newv, @oldv, @req);
   for my $c (@chunks) {
      my $cid = world_pos2id ($c);
      if ($old_vis->{$cid}) {
         delete $old_vis->{$cid};

      } elsif (not exists $new_vis->{$cid}) {
         push @newv, $c;
      }
      $new_vis->{$cid} = $c;
      unless (Games::Construder::World::has_chunk (@$c)) {
         push @req, $c;
      }
   }
 #d#  print "VISIBLE CHUNKS: " . join (", ", keys %$new_vis) . " (NEW ".join (", ", map { world_pos2id ($_) } @newv).") (OLD "  . join (", ", map { world_pos2id ($_) } @oldv).")\n";
   (@oldv) = values %$old_vis;
   $self->visible_chunks_changed (\@newv, \@oldv, \@req)
      if @newv || @oldv || @req;
   $self->{visible_chunks} = $new_vis;
}

my $render_cnt;
my $render_time;
sub render_scene {
   my ($self, $frame_time) = @_;

   my $t1 = time;
   my $cc = $self->{compiled_chunks};
   my $pp =  $self->{phys_obj}->{player}->{pos};
    #d#  warn "CHUNK " . vstr ($chunk_pos) . " from " . vstr ($pp) . "\n";

   glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
 #d#  glClear (GL_DEPTH_BUFFER_BIT);

   glMatrixMode(GL_PROJECTION);
   glLoadIdentity;
   gluPerspective (72, $WIDTH / $HEIGHT, 0.1, $FAR_PLANE);

   glMatrixMode(GL_MODELVIEW);
   glLoadIdentity;
   glPushMatrix;

   # move and rotate the world:
   glRotatef ($self->{xrotate}, 1, 0, 0);
   glRotatef ($self->{yrotate}, 0, 1, 0);
   my $cpos;
   glTranslatef (@{vneg ($cpos = vaddd ($pp, 0, $PL_HEIGHT, 0))});

   my ($txtid) = $self->{res}->obj2texture (1);
   glBindTexture (GL_TEXTURE_2D, $txtid);

   #d# warn "FCONE ".vstr ($fcone[0]). ",".vstr ($fcone[1])." : $fcone[2]\n";

   my @compl_end; # are to be compiled at the end of the frame
   for my $id (keys %{$self->{visible_chunks}}) {
      if (!$cc->{$id} || $self->{dirty_chunks}->{$id}) {
         push @compl_end, $self->{visible_chunks}->{$id};
      }
      my $compl = $cc->{$id}
         or next;
      Games::Construder::Renderer::draw_geom ($compl);
   }

   for (@{$self->{box_highlights}}) {
      _render_highlight ($_->[0], $_->[1], $_->[2]->{rad});
   }

   for (values %{$self->{model_highlights}}) {
      glCallList ($_);
   }

   my $qp = $self->{selected_box};
   _render_highlight ($qp, [1, 0, 0, 0.2], 0.04) if $qp;

   glPopMatrix;

   $self->render_hud;

   #glFinish; # what for?

   $self->{app}->sync;

   my $tleft = $frame_time - (time - $t1);

   if (@compl_end) {
      my $plchnk = world_pos2chunk ($pp);
      (@compl_end) = sort {
         vlength (vsub ($plchnk, $a))
         <=>
         vlength (vsub ($plchnk, $b))
      } @compl_end;
      my $tc = time;
      $tleft -= $tleft / 4; # lets don't overdo it
      # we MUST allow at least one per frame, otherwise on
      # other machines maybe none are compiled...
      my $ac = $tleft < 0 ? 0.001 : $tleft;

      my @request;

      my $cnt = 0;
      my $max = 9;
      while ($max-- > 0 && (time - $tc) < $ac) {
         my $chnk = shift @compl_end
            or last;
         unless ($self->compile_chunk (@$chnk)) {
            push @request, $chnk;
         }
         $cnt++;
      }
      my $tok = time - $tc;

#d#      if ($tok > $tleft) {
#d#         warn "compiled $cnt chunks in $tok, but only had $tleft ($ac) left, but "
#d#              . scalar (@compl_end) . " chunks still to compile...\n";
#d#      }

      (@compl_end) = ();

      if (@request) {
#d#         warn "requesting " . scalar (@request) . " chnks\n";
         $self->visible_chunks_changed ([], [], \@request);
      }
   }

   $render_time += time - $t1;
   $render_cnt++;
}

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

   #glDisable (GL_DEPTH_TEST);
   glDisable (GL_FOG);
   glClear (GL_DEPTH_BUFFER_BIT);

   glMatrixMode (GL_PROJECTION);
   glPushMatrix ();
   glLoadIdentity;
   glOrtho (0, $WIDTH, $HEIGHT, 0, -20, 20);

   glMatrixMode (GL_MODELVIEW);
   glPushMatrix ();
   glLoadIdentity;

   # this is the crosshair:
   my ($mw, $mh) = ($WIDTH / 2, $HEIGHT / 2);
   glPushMatrix;
   glTranslatef ($mw, $mh, 0);
   glColor4f (1, 1, 1, 0.3);
   glBindTexture (GL_TEXTURE_2D, 0);
   glBegin (GL_QUADS);

   glVertex3f (-5,  5, -9.99);
   glVertex3f ( 5,  5, -9.99);
   glVertex3f ( 5, -5, -9.99);
   glVertex3f (-5, -5, -9.99);

   glEnd ();
   glPopMatrix;

   #d# warn "ACTIVE UIS: " . join (', ', keys %{$self->{active_uis} || {}}) . "\n";

   for (values %{$self->{active_uis}}) {
      next unless $_->{sticky};
      $_->display;
   }
   if (@{$self->{active_ui_stack}}) {
      $self->{active_ui_stack}->[-1]->[1]->display;
   }

   glPopMatrix;
   glMatrixMode (GL_PROJECTION);
   glPopMatrix;

   glEnable (GL_FOG);

   #glEnable (GL_DEPTH_TEST);
   my $e;
   while (($e = glGetError ()) != GL_NO_ERROR) {
      warn "ERORR ".gluErrorString ($e)."\n";
      exit;
   }
}


sub handle_sdl_events {
   my ($self) = @_;
   my $sdle = $self->{sdl_event};

   SDL::Events::pump_events();

   while (SDL::Events::poll_event($sdle)) {
      my $type = $sdle->type;
      my $key  = ($type == 2 || $type == 3) ? $sdle->key_sym : "";

      if ($type == 4) {
         $self->input_mouse_motion ($sdle->motion_x, $sdle->motion_y,
                                    $sdle->motion_xrel, $sdle->motion_yrel);

      } elsif ($type == 2) {
         $self->input_key_down ($key, SDL::Events::get_key_name ($key), $sdle->key_unicode);

      } elsif ($type == 3) {
         $self->input_key_up ($key, SDL::Events::get_key_name ($key));

      } elsif ($type == SDL_MOUSEBUTTONUP) {
         $self->input_mouse_button ($sdle->button_button, 0);

      } elsif ($type == SDL_MOUSEBUTTONDOWN) {
         $self->input_mouse_button ($sdle->button_button, 1);

      } elsif ($type == SDL_VIDEORESIZE) {
         $self->resize_app ($sdle->resize_w, $sdle->resize_h);

      } elsif ($type == 12) {
         warn "Exit event!\n";
         exit;
      } else {
         warn "unknown sdl type: $type\n";
      }
   }

}

my $collide_cnt;
my $collide_time;
sub setup_event_poller {
   my ($self) = @_;

   my $fps;
   my $fps_intv = 0.8;
   $self->{fps_w} = AE::timer 0, $fps_intv, sub {
      #printf "%.5f FPS\n", $fps / $fps_intv;
      printf "%.5f secsPcoll\n", $collide_time / $collide_cnt if $collide_cnt;
      printf "%.5f secsPrender\n", $render_time / $render_cnt if $render_cnt;
      $self->activate_ui (hud_fps =>
         ui_hud_window_transparent (
            pos => [left => 'up'],
            [text => {
               color => "#ff0000", align => "center", font => "small"
            }, sprintf ("%.1f FPS", $fps / $fps_intv)]
         )
      );
      $collide_cnt = $collide_time = 0;
      $render_cnt = $render_time = 0;
      $fps = 0;
   };

   $self->{chunk_freeer} = AE::timer 0, 2, sub {
      for my $id (keys %{$self->{compiled_chunks}}) {
         my $p = world_id2pos ($id);
         unless ($self->can_see_chunk (@$p, 1)) {
            $self->free_compiled_chunk (@$p);
            #d# warn "freeed compiled chunk $kx, $ky, $kz\n";
         }
      }
   };

   my $anim_ltime;
   my $anim_dt = 1 / 25;
   my $anim_accum_time = 0;
   $self->{selector_w} = AE::timer 0, 0.1, sub {
      ($self->{selected_box}, $self->{selected_build_box})
         = $self->get_selected_box_pos;

      $anim_ltime = time - 0.02 if not defined $anim_ltime;
      my $ctime = time;
      $anim_accum_time += time - $anim_ltime;
      $anim_ltime = $ctime;

      while ($anim_accum_time > $anim_dt) {
         $self->step_animations ($anim_dt);
         $anim_accum_time -= $anim_dt;
      }
   };
   $self->{ui_timer} = AE::timer 0, 1, sub {
      for ($self->active_uis) {
         $self->{active_uis}->{$_}->animation_step;
      }
   };

   my $ltime;
   my $accum_time = 0;
   my $dt = 1 / 40;
   my $upd_pos = 0;
   my $frame_time = 0.02;
   my $last_frame;
   $self->{poll_w} = AE::timer 0, $frame_time, sub {
      my $start_time = time;
      my $dlta = $start_time - $last_frame;
      if ($dlta > $frame_time) {
         $dlta -= $frame_time;
 #d#        warn "frame too late, delta is $dlta\n";
      }

      $self->handle_sdl_events;

      $ltime = time - $frame_time if not defined $ltime;
      my $ctime = time;
      $accum_time += time - $ltime;
      $ltime = $ctime;

      while ($accum_time > $dt) {
         $self->physics_tick ($dt);
         $accum_time -= $dt;
      }

      $self->calc_visibility;

      if ($upd_pos++ > 8) {
         $self->update_player_pos (
            $self->{phys_obj}->{player}->{pos},
            $self->get_look_vector
         );
         $upd_pos = 0;
      }

      my $used = time - $start_time;
      my $rem = $frame_time - $used;

      $self->render_scene ($rem);
      $fps++;
      $last_frame = time;
   };
}

sub calc_cam_cone {
   my ($nplane, $fplane, $fov, $w, $h, $lv) = @_;
   my $fdepth = ($h / 2) / tan (deg2rad ($fov) * 0.5);
   my $fcorn  = sqrt (($w / 2) ** 2 + ($h / 2) ** 2);
   my $ffov   = atan ($fcorn / $fdepth);
   (vnorm ($lv), $ffov);
}

sub cam_cone {
   my ($self) = @_;
   return @{$self->{cached_cam_cone}} if $self->{cached_cam_cone};
   $self->{cached_cam_cone} = [
      calc_cam_cone (0.1, 30, 72, $WIDTH, $HEIGHT, $self->get_look_vector)
   ];
   @{$self->{cached_cam_cone}}
}

sub get_look_vector {
   my ($self) = @_;
   return $self->{cached_look_vec} if $self->{cached_look_vec};

   my $xd =  sin (deg2rad ($self->{yrotate}));
   my $zd = -cos (deg2rad ($self->{yrotate}));
   my $yd =  cos (deg2rad ($self->{xrotate} + 90));
   my $yl =  sin (deg2rad ($self->{xrotate} + 90));
   $self->{cached_look_vec} = [$yl * $xd, $yd, $yl * $zd];

   delete $self->{cached_cam_cone};
   $self->calc_visibility; # calls ->cam_cone!

   return $self->{cached_look_vec};
}

sub get_selected_box_pos {
   my ($self) = @_;
   my $t1 = time;
   my $pp = $self->{phys_obj}->{player}->{pos};

   my $player_head = vaddd ($pp, 0, $PL_HEIGHT, 0);
   my $foot_box    = vfloor ($pp);
   my $head_box    = vfloor ($player_head);
   my $rayd        = $self->get_look_vector;

   if ($self->{air_select_mode}) {
      # it's soooo much faster, lol :-)
      my $pos = vfloor (vadd ($player_head, vsmul (vnorm ($rayd), 2.7)));
      return ($pos, $pos);
   }

   my ($select_pos);

   my $min_dist = 9999;
   for my $dx (-3..3) {
      for my $dy (-3..3) { # floor and above head?!
         for my $dz (-3..3) {
            # now skip the player boxes
            my $cur_box = vaddd ($head_box, $dx, $dy, $dz);
            #d# next unless $dx == 0 && $dz == 0 && $cur_box->[1] == $foot_box->[1] - 1;
            next if $dx == 0 && $dz == 0
                    && grep { $cur_box->[1] == $_ }
                          $foot_box->[1]..$head_box->[1];

            if (Games::Construder::World::is_solid_at (@$cur_box)) {
               my ($dist, $q) =
                  world_intersect_ray_box (
                     $player_head, $rayd, $cur_box);
               #d#warn "BOX AT " . vstr ($cur_box) . " ".vstr ($rayd)." from "
               #d#               . vstr ($player_head) . "DIST $dist at " . vstr ($q) . "\n";
               if ($dist > 0 && $min_dist > $dist) {
                  $min_dist   = $dist;
                  $select_pos = $cur_box;
               }
            }
         }
      }
   }

   my $build_box;
   if ($select_pos) {
      my $box_center    = vaddd ($select_pos, 0.5, 0.5, 0.5);
      my $intersect_pos = vadd ($player_head, vsmul ($rayd, $min_dist));
      my $norm_dir = vsub ($intersect_pos, $box_center);

      my $max_coord;
      my $cv = 0;
      for (0..2) {
         if (abs ($cv) < abs ($norm_dir->[$_])) {
            $cv = $norm_dir->[$_];
            $max_coord = $_;
         }
      }
      my $norm = [0, 0, 0];
      $norm->[$max_coord] = $cv < 0 ? -1 : 1;
      #d# warn "Normal direction: " . vstr ($nn) . ", ". vstr ($norm) . "\n";

      $build_box = vfloor (vadd ($box_center, $norm));
      if (grep {
               $foot_box->[0] == $build_box->[0]
            && $_ == $build_box->[1]
            && $foot_box->[2] == $build_box->[2]
          } $foot_box->[1]..$head_box->[1]
      ) {
         $build_box = undef;
      }
   }


#d# warn sprintf "%.5f selection\n", time - $t1;

   ($select_pos, $build_box)
}

sub _calc_movement {
   my ($movement, $rot) = @_;

   my ($forw, $strafe) = (0, 0);
   if ($movement->{forward} > $movement->{backward}) {
      $forw = +3;
   } elsif ($movement->{backward} > $movement->{forward}) {
      $forw = -3;
   }

   if ($movement->{left} > $movement->{right}) {
      $strafe = -3;
   } elsif ($movement->{right} > $movement->{left}) {
      $strafe = +3;
   }

   my $xd =  sin (deg2rad ($rot));
   my $yd = -cos (deg2rad ($rot));
   my $forw = vsmul ([$xd, 0, $yd], $forw);

   $xd =  sin (deg2rad ($rot + 90));
   $yd = -cos (deg2rad ($rot + 90));
   viadd ($forw, vsmul ([$xd, 0, $yd], $strafe));
   $forw
}

sub physics_tick : event_cb {
   my ($self, $dt) = @_;

   my $player = $self->{phys_obj}->{player};
   my $below_feet_chnk =
      Games::Construder::World::has_chunk (world_pos2chunk (vsubd ($player->{pos}, 0, 1, 0)));
   my $feet_chnk =
      Games::Construder::World::has_chunk (world_pos2chunk ($player->{pos}));
   my $head_chnk =
      Games::Construder::World::has_chunk (
         world_pos2chunk (vaddd ($player->{pos}, 0, $PL_HEIGHT, 0)));
   return unless $self->{ghost_mode} || $below_feet_chnk && $feet_chnk && $head_chnk;

   my $bx = Games::Construder::World::at (@{vaddd ($player->{pos}, 0, -1, 0)});

   my $gforce = [0, -9.5, 0];
   #d#if ($bx->[0] == 15) {
   #d#   $gforce = [0, 9.5, 0];
   #d#}
   $gforce = [0,0,0] if $self->{ghost_mode};

   if ($self->{ghost_mode}) {
      $player->{vel} = [0, 0, 0];
   } else {
      viadd ($player->{vel}, vsmul ($gforce, $dt));
   }

   if ((vlength ($player->{vel}) * $dt) > $PL_RAD) {
      $player->{vel} = vsmul (vnorm ($player->{vel}), ($PL_RAD - 0.02) / $dt);
   }
   viadd ($player->{pos}, vsmul ($player->{vel}, $dt));

   my $movement = _calc_movement ($self->{movement}, $self->{yrotate});
   $movement = vsmul ($movement, $self->{movement}->{speed} ? 2.2 : 1);
   viadd ($player->{pos}, vsmul ($movement, $dt));

   #d#warn "check player at $player->{pos}\n";
   #    my ($pos) = $chunk->collide ($player->{pos}, 0.3, \$collided);

   my $t1 = time;

   my $collide_normal;
   #d#warn "check player pos " . vstr ($player->{pos}) . "\n";

   my ($pos) =
      world_collide (
         $player->{pos},
         $PL_RAD,
         $PL_HEIGHT,
         \$collide_normal);

   #d# warn "new pos : ".vstr ($pos)." norm " . vstr ($collide_normal || []). "\n";
   unless ($self->{ghost_mode}) {
      $player->{pos} = $pos;

      if (ref $collide_normal) {
          # figure out how much downward velocity is removed:
          my $down_part;
          my $coll_depth = vlength ($collide_normal);
          if ($coll_depth == 0) {
             #d#warn "collidedd vector == 0, set vel = 0\n";
             $down_part = 0;

          } else {
             vinorm ($collide_normal, $coll_depth);

             my $vn = vnorm ($player->{vel});
             $down_part = 1 - abs (vdot ($collide_normal, $vn));
             #d# warn "down part $cn . $vn => $down_part * $player->{vel}\n";
          }
          #d# warn "downpart $down_part\n";
          vismul ($player->{vel}, $down_part);
      } elsif ($collide_normal == 1) {
         $self->msg ("Emergency Teleport Activated. You were teleported to a free spot so you are not intermixed with something solid!");
      }
   }

   $collide_time += time - $t1;
   $collide_cnt++;
}

sub change_look_lock : event_cb {
   my ($self, $enabled) = @_;

   $self->{look_lock} = $enabled;
   delete $self->{cached_look_vec};

   if ($enabled) {
      $self->{app}->grab_input (SDL_GRAB_ON);
      SDL::Mouse::show_cursor (SDL_DISABLE);
   } else {
      $self->{app}->grab_input (SDL_GRAB_OFF);
      SDL::Mouse::show_cursor (SDL_ENABLE);
   }
}

sub input_key_up : event_cb {
   my ($self, $key, $name) = @_;

   my $handled = 0;
   for ($self->active_uis) {
      if (delete $self->{active_uis}->{$_}->{key_repeat}) {
         $handled = 1;
         last;
      }
   }
   return if $handled;


   if ($name eq 'w') {
      delete $self->{movement}->{forward};
   } elsif ($name eq 's') {
      delete $self->{movement}->{backward};
   } elsif ($name eq 'a') {
      delete $self->{movement}->{left};
   } elsif ($name eq 'd') {
      delete $self->{movement}->{right};

   } elsif ($name eq 'left shift') {
      $self->{movement}->{speed} = 0;
   } elsif ($name eq 'left ctrl') {
      $self->{air_select_mode} = 0;
   }

}

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

   my $win = ui_window ("Video Settings",
      ui_pad_box (hor =>
         ui_desc ("Ambien light: "),
         ui_subdesc (sprintf "%0.2f", $self->{res}->{config}->{ambient_light}),
         ui_range (ambl => 0.0, 0.3, 0.05, "%0.2f",
                   $self->{res}->{config}->{ambient_light}),
      ),
      ui_pad_box (hor =>
         ui_desc ("Fog: "),
         ui_subdesc ($self->fog),
      ),
      (
         map {
            ui_select_item (fog => $_, ui_desc ("$_"))
         } sort keys %FOGS
      )
   );

   $self->activate_ui (video_settings => {
      %$win,
      commands => {
         default_keys => { return => "change" }
      },
      command_cb => sub {
         my ($cmd, $arg, $need_selection) = @_;

         if ($cmd eq 'change') {
            $self->{res}->{config}->{ambient_light} = $arg->{ambl};
            $self->set_ambient_light ($self->{res}->{config}->{ambient_light});

            if ($arg->{fog} ne '') {
               $self->{res}->{config}->{fog} = $arg->{fog};
               $self->update_fog;
            }

            $self->{res}->save_config;
            $self->show_video_settings;
            return 1;
         }
      }
   });
}
sub show_mouse_settings {
   my ($self) = @_;

   my $win = ui_window ("Mouse Settings",
      ui_pad_box (hor =>
         ui_desc ("Mouse sensitivity: "),
         ui_subdesc (sprintf "%0.2f", $self->{res}->{config}->{mouse_sens}),
         ui_range (sens => 0.05, 20, 0.05, "%0.2f",
                   $self->{res}->{config}->{mouse_sens}),
      )
   );

   $self->activate_ui (mouse_settings => {
      %$win,
      commands => {
         default_keys => { return => "change" }
      },
      command_cb => sub {
         my ($cmd, $arg, $need_selection) = @_;

         if ($cmd eq 'change') {
            $self->{res}->{config}->{mouse_sens} = $arg->{sens};
            $self->{res}->save_config;
            $self->show_mouse_settings;
            return 1;
         }
      }
   });
}

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

   my $win = ui_window ("Audio Settings",
      ui_pad_box (hor =>
         ui_desc ("Music Volume: "),
         ui_subdesc (SDL::Mixer::Music::volume_music (-1)),
         ui_range (music => 0, SDL::Mixer::MIX_MAX_VOLUME, 5, "%d",
                   SDL::Mixer::Music::volume_music (-1))
      )
   );

   $self->activate_ui (audio_settings => {
      %$win,
      commands => {
         default_keys => { return => "change" }
      },
      command_cb => sub {
         my ($cmd, $arg, $need_selection) = @_;

         if ($cmd eq 'change') {
            SDL::Mixer::Music::volume_music ($arg->{music});
            $self->{res}->{config}->{volume_music} = $arg->{music};
            $self->{res}->save_config;
            $self->show_audio_settings;
            return 1;
         }
      }
   });
}

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

   $self->activate_ui (key_help =>
      ui_window ("Client Key Bindings",
         ui_desc (
            "These key bindings work globally "
            . "when not in any dialog in the client."),
         ui_subdesc (
            "(For more key bindings hit [F2] to bring up the server menu!)"),
         ui_key_explain (
            [qw/w s a d/], "Move forward / backward / left / right."),
         ui_key_explain (
            "left shift",  "Hold to speedup [w/s/a/d] movement."),
         ui_key_explain (
            "space",
            "Jump / Give upward boost (you can fly by repeatedly hitting this)."),
         ui_key_explain (
            "f",
            "Toggle mouse look."),
         ui_key_explain (
            "left ctrl",
            "Hold to move highlight into the free air (for building for example)."),
         ui_key_explain ("g",         "Toggle ghost mode (developer stuff)."),
         ui_key_explain ([qw/F5 F6/], "De-/Increase visibility radius."),
      )
   );
}

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

   my $si = $self->{server_info};

   $self->activate_ui (credits => ui_window ("About / Credits",
      ui_caption (sprintf "Client: G::C::Client %s", $Games::Construder::VERSION),
      ui_subdesc ("Code: Robin Redeker"),
      ui_caption (sprintf "Server: %s", $si->{version}),
      map {
         ref $_
            ? (ui_subdesc ("* $_->[0]", font => "small"),
               ui_small_text ($_->[1], align => "center"))
            : ui_subdesc ($_, font => "small")
      } @{$si->{credits}}
   ));
}

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

   my $ui =
      ui_window ("Construder Client",
         ui_subdesc (
            "(To activate the menu item, press the key in the square brackets)"),
         ui_key_explain (F1 => "Keybindings Help (Client)"),
 # not yet implemented:
 #        ui_key_explain (s  => "Connection Settings"),
 #        ui_key_explain (d  => "Disconnect"),
 #        ui_key_explain (c  => "Connect"),
 #        ui_key_explain (a  => "Audio Options"),
         ui_key_explain (m  => "Mouse Options"),
         ui_key_explain (v  => "Video Options"),
         ui_key_explain (f  => "Toggle Fullscreen"),
         ui_key_explain (t  => "About"),
         ui_key_explain (q  => "Exit (Press the 'q' key)"),
      );

   $self->activate_ui (esc_menu => {
      %$ui,
      commands => {
         default_keys => {
            q => "exit",
            t => "credits",
            f => "fullscreen",
            m => "mouse",
            v => "video",
            a => "audio",
         }
      },
      command_cb => sub {
         my ($cmd, $arg, $need_selection) = @_;

         if ($cmd eq 'exit') {
            $self->exit_app;
            return 1;

         } elsif ($cmd eq 'credits') {
            $self->deactivate_ui ('esc_menu');
            $self->show_credits;
            return 1;

         } elsif ($cmd eq 'audio') {
            $self->deactivate_ui ('esc_menu');
            $self->show_audio_settings;
            return 1;

         } elsif ($cmd eq 'mouse') {
            $self->deactivate_ui ('esc_menu');
            $self->show_mouse_settings;
            return 1;

         } elsif ($cmd eq 'video') {
            $self->deactivate_ui ('esc_menu');
            $self->show_video_settings;
            return 1;

         } elsif ($cmd eq 'fullscreen') {
            $self->{app}->fullscreen;
         }
      }
   });
}

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

   unless (defined $msg) {
      $self->deactivate_ui ('cl_msgbox');
      return;
   }

   $self->activate_ui (cl_msgbox => ui_window ("Client Message", ui_desc ($msg)));
}

sub activate_ui {
   my ($self, $ui, $desc) = @_;

   if (my $obj = $self->{active_uis}->{$ui}) {
      ctr_prof ("act_ui($ui)", sub {
         $obj->update ($desc);
      });
      return;
   }

   my $obj = delete $self->{inactive_uis}->{$ui};

   $obj ||=
      Games::Construder::Client::UI->new (
         W => $WIDTH, H => $HEIGHT, res => $self->{res}, name => $ui);

   ctr_prof ("act_ui($ui)", sub {
      $obj->update ($desc);
   });

   my $oobj = delete $self->{active_uis}->{$ui};
   $oobj->active (0) if $oobj;
   $self->{active_uis}->{$ui} = $obj;
   $obj->active (1);

   unless ($obj->{sticky}) {
      push @{$self->{active_ui_stack}}, [$ui, $obj]
   }
}

sub deactivate_ui {
   my ($self, $ui) = @_;
   @{$self->{active_ui_stack}} = grep {
      $_->[0] ne $ui
   } @{$self->{active_ui_stack}};

   my $obj = delete $self->{active_uis}->{$ui};
   if ($obj) {
      $obj->active (0);
      $self->{inactive_uis}->{$ui} = $obj;
   }
}

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

   my (@active_uis) = grep {
      $self->{active_uis}->{$_}->{sticky}
   } (keys %{$self->{active_uis}});

   if (@{$self->{active_ui_stack}}) {
      unshift @active_uis, $self->{active_ui_stack}->[-1]->[0];
   }

   @active_uis
}

sub input_key_down : event_cb {
   my ($self, $key, $name, $unicode) = @_;

   my $handled = 0;

   for ($self->active_uis) {
      my $obj = $self->{active_uis}->{$_};
      $obj->input_key_press ($key, $name, chr ($unicode), \$handled);
      $self->deactivate_ui ($_) if $handled == 2;
      if ($handled == 1 && $obj->{active}) {
         $obj->{key_repeat} = AE::timer 0.2, 0.1, sub {
            my $handled;
            $obj->input_key_press ($key, $name, chr ($unicode), \$handled);
         };
      }
      last if $handled;
   }
   return if $handled;

   if ($name eq 'escape') {
      $self->esc_menu;
      return;

   } elsif ($name eq 'f1') {
      $self->show_key_help;
      return;
   }

   warn "Key down $key ($name)\n";

   my $move_x;

   if ($name eq 'space') {
      viaddd ($self->{phys_obj}->{player}->{vel}, 0, 5, 0);
   } elsif ($name eq 'g') {
      $self->{ghost_mode} = not $self->{ghost_mode};
   } elsif ($name eq 'f') {
      $self->change_look_lock (not $self->{look_lock});
   } elsif ($name eq 'left ctrl') {
      $self->{air_select_mode} = 1;
   } elsif ($name eq 'left shift') {
      $self->{movement}->{speed} = 1;
   } elsif ($name eq 'w') {
      $self->{movement}->{forward} =
         $self->{movement}->{backward} + 1;
   } elsif ($name eq 's') {
      $self->{movement}->{backward} =
         $self->{movement}->{forward} + 1;
   } elsif ($name eq 'a') {
      $self->{movement}->{left} =
         $self->{movement}->{right} + 1;
   } elsif ($name eq 'd') {
      $self->{movement}->{right} =
         $self->{movement}->{left} + 1;
   } elsif ($name eq 'f5') {
      $self->visibility_radius ($PL_VIS_RAD - 1);
   } elsif ($name eq 'f6') {
      $self->visibility_radius ($PL_VIS_RAD + 1);
   }
   $self->{change} = 1;
}

sub input_mouse_motion : event_cb {
   my ($self, $mx, $my, $xr, $yr) = @_;
   # FIXME: someone ought to fix relativ mouse positions... it's in twos complement here
   #        the SDL module has a bug => motion_yrel returns Uint16 and not Sint16.

   if ($self->{look_lock}) {
      my ($xc, $yc) = ($WIDTH / 2, $HEIGHT / 2);
      my ($xr, $yr) = (($mx - $xc), ($my - $yc));
      my $sens = $self->{res}->{config}->{mouse_sens};
      $self->{yrotate} += ($xr / $WIDTH) * 15 * $sens;
      $self->{xrotate} += ($yr / $HEIGHT) * 15 * $sens;
      $self->{xrotate} = Math::Trig::deg2deg ($self->{xrotate});
      $self->{xrotate} = -90 if $self->{xrotate} < -90;
      $self->{xrotate} = 90 if $self->{xrotate} > 90;
      $self->{yrotate} = Math::Trig::deg2deg ($self->{yrotate});
      delete $self->{cached_look_vec};
      $self->{change} = 1;
      #d# warn "rot ($xr,$yr) ($self->{xrotate},$self->{yrotate})\n";
      SDL::Mouse::warp_mouse ($xc, $yc);
   }
}

sub position_action : event_cb {
}

sub input_mouse_button : event_cb {
   my ($self, $btn, $down) = @_;
   return unless $down;

   my $sbp = $self->{selected_box};
   my $sbbp = $self->{selected_build_box};
   $self->position_action ($sbp, $sbbp, $btn);
}

sub update_player_pos : event_cb {
   my ($self, $pos) = @_;
}

sub visible_chunks_changed : event_cb {
   my ($self, $new, $old, $req) = @_;
   # TODO: $req might be issued again and again with the same chunks,
   #       we should mabye rate limit that for more bandwidth friendly
   #       behaviour
}

sub visibility_radius : event_cb {
   my ($self, $radius) = @_;
   $radius = 6 if $radius > 6; # limit, or it usuall kills server :-/
   $PL_VIS_RAD = $radius;
   $FAR_PLANE = ($radius * 12) * 0.7;
   glFogf (GL_FOG_START, $FAR_PLANE - 20);
   glFogf (GL_FOG_END,   $FAR_PLANE - 1);
   warn "RADIUS $PL_VIS_RAD\n";
}

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 SEE ALSO

=head1 COPYRIGHT & LICENSE

Copyright 2011 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Affero General Public License.

=cut

1;

