#!/usr/bin/perl

use strict;
use warnings;
use constant PI => 4 * atan2(1, 1);

use File::Basename;
use SDL::App;
use SDL::Constants;
use SDL::Event;
use SDL::OpenGL;

START: __PACKAGE__->new->main;


sub new
{
    my $class = shift;
    my $self  = bless {}, $class;

    return $self;
}

sub main
{
    my $self = shift;

    $self->init;
    $self->main_loop;
    $self->cleanup;
}

sub init
{
    my $self = shift;

    $| = 1;

    $self->init_conf;
    $self->init_window;
    $self->init_event_processing;
    $self->init_command_actions;
    $self->init_view;
    $self->init_time;
    $self->init_fonts;
    $self->init_models;
    $self->init_objects;
}

sub init_conf
{
    my $self = shift;

    $self->{conf} = {
        title     => 'Camel 3D',
        width     => 400,
        height    => 400,
        fovy      => 90,
        benchmark => 1,
        bind      => {
            escape => 'quit',
            f4     => 'screenshot',
            a      => '+move_left',
            d      => '+move_right',
            w      => '+move_forward',
            s      => '+move_back',
            left   => '+yaw_left',
            right  => '+yaw_right',
            tab    => '+look_behind',
        }
    };
}

sub init_window
{
    my $self = shift;

    my $title = $self->{conf}{title};
    my $w     = $self->{conf}{width};
    my $h     = $self->{conf}{height};

    $self->{resource}{sdl_app}
        = SDL::App->new(-title  => $title,
                        -width  => $w,
                        -height => $h,
                        -gl     => 1,
                       );
    SDL::ShowCursor(0);
}

sub init_event_processing
{
    my $self = shift;

    $self->{resource}{sdl_event} = SDL::Event->new;
    $self->{lookup}{event_processor} = {
        &SDL_QUIT    => \&process_quit,
        &SDL_KEYUP   => \&process_key,
        &SDL_KEYDOWN => \&process_key,
    };
}

sub init_command_actions
{
    my $self = shift;

    $self->{lookup}{command_action} = {
          quit          => \&action_quit,
          screenshot    => \&action_screenshot,
        '+move_left'    => \&action_move,
        '+move_right'   => \&action_move,
        '+move_forward' => \&action_move,
        '+move_back'    => \&action_move,
        '+yaw_left'     => \&action_move,
        '+yaw_right'    => \&action_move,
        '+look_behind'  => \&action_move,
    };
}

sub init_view
{
    my $self = shift;

    $self->{world}{view} = {
        position    => [6, 2, 10],
        orientation => [0, 0, 1, 0],
        d_yaw       => 0,
        v_yaw       => 0,
        v_forward   => 0,
        v_right     => 0,
        dv_yaw      => 0,
        dv_forward  => 0,
        dv_right    => 0,
    };
}

sub init_time
{
    my $self = shift;

    $self->{world}{time} = now();
}

sub init_fonts
{
    my $self = shift;

    my %fonts = (
        numbers => 'numbers-7x11.txt',
    );

    glPixelStore(GL_UNPACK_ALIGNMENT, 1);

    foreach my $font (keys %fonts) {
        my ($bitmaps, $w, $h) = 
            $self->read_font_file($fonts{$font});

        my @cps    = sort {$a <=> $b} keys %$bitmaps;
        my $max_cp = $cps[-1];
        my $base   = glGenLists($max_cp + 1);

        foreach my $codepoint (@cps) {
            glNewList($base + $codepoint, GL_COMPILE);
            glBitmap($w, $h, 0, 0, $w + 2, 0,
                     $bitmaps->{$codepoint});
            glEndList;
        }

        $self->{fonts}{$font}{base} = $base;
    }
}

sub read_font_file
{
    my $self = shift;

    my $file = shift;

    open my $defs, '<', $file
        or die "Could not open '$file': $!";
    local $/ = '';

    my $header  = <$defs>;
    chomp($header);
    my ($w, $h) = split /x/ => $header;

    my %bitmaps;
    while (my $def = <$defs>) {
        my ($hex, @rows) = grep /\S/ => split /\n/ => $def;

        @rows = map {tr/.0/01/; pack 'B*' => $_} @rows;
        my $bitmap = join '' => reverse @rows;
        my $codepoint = hex $hex;

        $bitmaps{$codepoint} = $bitmap;
    }

    return (\%bitmaps, $w, $h);
}

sub init_models
{
    my $self = shift;

    my %models = (
        cube => \&draw_cube,
    );
    my $count  = keys %models;
    my $base   = glGenLists($count);
    my %display_lists;

    foreach my $model (keys %models) {
        glNewList($base, GL_COMPILE);
        $models{$model}->();
        glEndList;

        $display_lists{$model} = $base++;
    }

    $self->{models}{dls} = \%display_lists;
}

sub init_objects
{
    my $self = shift;

    my @objects = (
        {
            draw        => \&draw_axes,
        },
        {
            lit         => 1,
            color       => [ 1, 1,  1],
            position    => [12, 0, -4],
            scale       => [ 2, 2,  2],
            model       => 'cube',
        },
        {
            lit         => 1,
            color       => [ 1, 1, 0],
            position    => [ 4, 0, 0],
            orientation => [40, 0, 0, 1],
            scale       => [.2, 1, 2],
            model       => 'cube',
        },
    );

    foreach my $num (1 .. 5) {
        my $scale =   $num * $num / 15;
        my $pos   = - $num * 2;
        push @objects, {
            lit         => 1,
            color       => [ 1, 1,  1],
            position    => [$pos, 2.5, 0],
            orientation => [30, 1, 0, 0],
            scale       => [1, 1, $scale],
            model       => 'cube',
        };
    }

    $self->{world}{objects} = \@objects;
}


sub main_loop
{
    my $self = shift;

    while (not $self->{state}{done}) {
        $self->{state}{frame}++;
        $self->update_time;
        $self->do_events;
        $self->update_view;
        $self->do_frame;
    }
}

sub update_time
{
    my $self = shift;

    my $now = now();

    $self->{world}{d_time} = $now - $self->{world}{time};
    $self->{world}{time}   = $now;
}

sub now
{
    return SDL::GetTicks() / 1000;
}

sub do_events
{
    my $self = shift;

    my $queue     = $self->process_events;
    my $triggered = $self->triggered_events;
    push @$queue, @$triggered;
    my $lookup    = $self->{lookup}{command_action};
    my ($command, $action);

    while (not $self->{state}{done} and @$queue) {
        my @args;
        $command = shift @$queue;
        ($command, @args) = @$command if ref $command;

        $action = $lookup->{$command} or next;
        $self->$action($command, @args);
    }
}

sub process_events
{
    my $self = shift;

    my $event  = $self->{resource}{sdl_event};
    my $lookup = $self->{lookup}{event_processor};
    my ($process, $command, @queue);

    $event->pump;
    while (not $self->{state}{done} and $event->poll) {
        $process = $lookup->{$event->type} or next;
        $command = $self->$process($event);
        push @queue, $command if $command;
    }

    return \@queue;
}

sub process_quit
{
    my $self = shift;

    $self->{state}{done} = 1;
    return 'quit';
}

sub process_key
{
    my $self = shift;

    my $event   = shift;
    my $symbol  = $event->key_sym;
    my $name    = SDL::GetKeyName($symbol);
    my $command = $self->{conf}{bind}{$name} || '';
    my $down    = $event->type == SDL_KEYDOWN;

    if ($command =~ /^\+/) {
        return [$command, $down];
    }
    else {
        return $down ? $command : '';
    }
}

sub triggered_events
{
    my $self = shift;

    my @queue;
    push @queue, 'quit' if $self->{conf}{benchmark} and
                           $self->{world}{time} >= 5;
    return \@queue;
}

sub action_quit
{
    my $self = shift;

    $self->{state}{done} = 1;
}

sub action_screenshot
{
    my $self = shift;

    $self->{state}{need_screenshot} = 1;
}

sub action_move
{
    my $self = shift;

    my ($command, $down) = @_;
    my $sign             = $down ? 1 : -1;
    my $view             = $self->{world}{view};
    my $speed_yaw        = 36;
    my $speed_move       = 5;
    my %move_update      = (
        '+yaw_left'     => [dv_yaw     =>  $speed_yaw ],
        '+yaw_right'    => [dv_yaw     => -$speed_yaw ],
        '+move_right'   => [dv_right   =>  $speed_move],
        '+move_left'    => [dv_right   => -$speed_move],
        '+move_forward' => [dv_forward =>  $speed_move],
        '+move_back'    => [dv_forward => -$speed_move],
        '+look_behind'  => [d_yaw      =>  180        ],
    );
    my $update = $move_update{$command} or return;

    $view->{$update->[0]} += $update->[1] * $sign;
}

sub update_view
{
    my $self = shift;

    my $view   = $self->{world}{view};
    my $d_time = $self->{world}{d_time};

    $view->{orientation}[0] += $view->{d_yaw};
    $view->{d_yaw}           = 0;

    $view->{v_yaw}          += $view->{dv_yaw};
    $view->{dv_yaw}          = 0;
    $view->{orientation}[0] += $view->{v_yaw} * $d_time;

    $view->{v_right}        += $view->{dv_right};
    $view->{dv_right}        = 0;
    $view->{v_forward}      += $view->{dv_forward};
    $view->{dv_forward}      = 0;

    my $vx                   =  $view->{v_right};
    my $vz                   = -$view->{v_forward};
    my $angle                = $view->{orientation}[0];
    ($vx, $vz)               = rotate_xz($angle, $vx, $vz);
    $view->{position}[0]    += $vx * $d_time;
    $view->{position}[2]    += $vz * $d_time;
}

sub rotate_xz
{
    my ($angle, $x, $z) = @_;

    my $radians = $angle * PI / 180;
    my $cos     = cos($radians);
    my $sin     = sin($radians);
    my $rot_x   =  $cos * $x + $sin * $z;
    my $rot_z   = -$sin * $x + $cos * $z;

    return ($rot_x, $rot_z);
}

sub do_frame
{
    my $self = shift;

    $self->prep_frame;
    $self->draw_frame;
    $self->end_frame;
}

sub prep_frame
{
    glClear(GL_COLOR_BUFFER_BIT |
            GL_DEPTH_BUFFER_BIT );

    glEnable(GL_DEPTH_TEST);

    glEnable(GL_COLOR_MATERIAL);

    glEnable(GL_NORMALIZE);
}

sub draw_frame
{
    my $self = shift;

    $self->set_projection_3d;
    $self->set_eye_lights;
    $self->set_view_3d;
    $self->set_world_lights;
    $self->draw_view;
}

sub set_projection_3d
{
    my $self = shift;

    my $fovy   = $self->{conf}{fovy};
    my $w      = $self->{conf}{width};
    my $h      = $self->{conf}{height};
    my $aspect = $w / $h;

    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    gluPerspective($fovy, $aspect, 1, 1000);

    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
}

sub set_eye_lights
{
    glLight(GL_LIGHT1, GL_POSITION, 0.0, 0.0, 0.0, 1.0);
    glLight(GL_LIGHT1, GL_DIFFUSE,  1.0, 1.0, 1.0, 1.0);
    glLight(GL_LIGHT1, GL_LINEAR_ATTENUATION, 0.5);
    glLight(GL_LIGHT1, GL_SPOT_CUTOFF,   30.0);
    glLight(GL_LIGHT1, GL_SPOT_EXPONENT, 80.0);

    glEnable(GL_LIGHT1);
}

sub set_view_3d
{
    my $self = shift;

    my $view           = $self->{world}{view};
    my ($angle, @axis) = @{$view->{orientation}};
    my ($x, $y, $z)    = @{$view->{position}};

    glRotate(-$angle, @axis);
    glTranslate(-$x, -$y, -$z);
}

sub set_world_lights
{
    glLight(GL_LIGHT0, GL_POSITION, 0.0, 0.0, 1.0, 0.0);

    glEnable(GL_LIGHT0);
}

sub draw_view
{
    my $self = shift;

    my $objects = $self->{world}{objects};

    foreach my $o (@$objects) {
        $o->{lit} ? glEnable (GL_LIGHTING)
                  : glDisable(GL_LIGHTING);

        glColor(@{$o->{color}})        if $o->{color};

        glPushMatrix;

        glTranslate(@{$o->{position}}) if $o->{position};
        glRotate(@{$o->{orientation}}) if $o->{orientation};
        glScale(@{$o->{scale}})        if $o->{scale};

        if ($o->{model}) {
            my $dl = $self->{models}{dls}{$o->{model}};
            glCallList($dl);
        }
        else {
            $o->{draw}->();
        }

        glPopMatrix;
    }
}

sub draw_axes
{
    # Lines from origin along positive axes, for orientation
    # X axis = red, Y axis = green, Z axis = blue
    glBegin(GL_LINES);
    glColor(1, 0, 0);
    glVertex(0, 0, 0);
    glVertex(1, 0, 0);

    glColor(0, 1, 0);
    glVertex(0, 0, 0);
    glVertex(0, 1, 0);

    glColor(0, 0, 1);
    glVertex(0, 0, 0);
    glVertex(0, 0, 1);
    glEnd;
}

sub draw_cube
{
    # A simple cube
    my @indices = qw( 4 5 6 7   1 2 6 5   0 1 5 4
                      0 3 2 1   0 4 7 3   2 3 7 6 );
    my @vertices = ([-1, -1, -1], [ 1, -1, -1],
                    [ 1,  1, -1], [-1,  1, -1],
                    [-1, -1,  1], [ 1, -1,  1],
                    [ 1,  1,  1], [-1,  1,  1]);
    my @normals = ([0, 0,  1], [ 1, 0, 0], [0, -1, 0],
                   [0, 0, -1], [-1, 0, 0], [0,  1, 0]);

    foreach my $face (0 .. 5) {
        my $normal = $normals[$face];
        my @corners;
        foreach my $vertex (0 .. 3) {
            my $index  = $indices[4 * $face + $vertex];
            my $coords = $vertices[$index];
            push @corners, $coords;
        }
        draw_quad_face(normal    => $normal,
                       corners   => \@corners);
    }
}

sub draw_quad_face
{
    my %args = @_;
    my $normal  = $args{normal};
    my $corners = $args{corners};
    my $div     = $args{divisions} || 10;
    my ($a, $b, $c, $d) = @$corners;

    # NOTE: ASSUMES FACE IS A PARALLELOGRAM

    my $s_ab = calc_vector_step($a, $b, $div);
    my $s_ad = calc_vector_step($a, $d, $div);

    glNormal(@$normal);

    for my $strip (0 .. $div - 1) {
        my @v = ($a->[0] + $strip * $s_ab->[0],
                 $a->[1] + $strip * $s_ab->[1],
                 $a->[2] + $strip * $s_ab->[2]);

        glBegin(GL_QUAD_STRIP);
        for my $quad (0 .. $div) {
            glVertex(@v);
            glVertex($v[0] + $s_ab->[0],
                     $v[1] + $s_ab->[1],
                     $v[2] + $s_ab->[2]);

            $v[0] += $s_ad->[0];
            $v[1] += $s_ad->[1];
            $v[2] += $s_ad->[2];
        }
        glEnd;
    }
}

sub calc_vector_step
{
    my ($v1, $v2, $div) = @_;

    return [($v2->[0] - $v1->[0]) / $div,
            ($v2->[1] - $v1->[1]) / $div,
            ($v2->[2] - $v1->[2]) / $div];
}

sub delay
{
    my $seconds = shift;

    SDL::Delay($seconds * 1000);
}

sub end_frame
{
    my $self = shift;

    $self->{resource}{sdl_app}->sync;
    $self->screenshot if $self->{state}{need_screenshot};
}

sub screenshot
{
    my $self = shift;

    my $file = basename($0) . '.bmp';
    my $w    = $self->{conf}{width};
    my $h    = $self->{conf}{height};

    glReadBuffer(GL_FRONT);
    my $data = glReadPixels(0, 0, $w, $h, GL_BGR,
                            GL_UNSIGNED_BYTE);
    SDL::OpenGL::SaveBMP($file, $w, $h, 24, $data);

    $self->{state}{need_screenshot} = 0;
}

sub cleanup
{
    print "\nDone.\n"
}
