view release on metacpan or  search on metacpan

eg/70-rolling-balls.pl  view on Meta::CPAN

use warnings;

BEGIN {
    eval { require OpenGL::Modern; OpenGL::Modern->import(':all'); 1 }
        or die "This example requires OpenGL::Modern\n";
    eval { require OpenGL::GLUT; OpenGL::GLUT->import(':all'); 1 }
        or die "This example requires OpenGL::GLUT\n";
    eval { require OpenGL::Array; 1 }
        or die "This example requires OpenGL::Array\n";
}

use Math::SegmentedEnvelope qw(spline env);
use Time::HiRes qw(time);
use POSIX qw(tan floor);

my $W = 900;
my $H = 650;
my $PI = 3.14159265358979323846;

# Slope profiles: different terrains the balls roll on
my @slopes = (
    spline([0, 0.15, 0.3, 0.5, 0.65, 0.8, 1.0],
           [0.9, 0.7, 0.85, 0.4, 0.6, 0.2, 0.05], resolution => 16),
    spline([0, 0.1, 0.25, 0.4, 0.55, 0.7, 0.85, 1.0],
           [0.95, 0.5, 0.8, 0.3, 0.7, 0.15, 0.4, 0.02], resolution => 16),
    env([[1.0, 0.6, 0.8, 0.3, 0.5, 0.1], [0.2, 0.2, 0.2, 0.2, 0.2],
         [-2, 2, -3, 2, -2]], morpher_formula => 'smoothstep'),
);
my $current_slope = 0;
my $slope_switch = 0;

# Physics constants
my $gravity = 2.5;
my $friction = 0.985;
my $bounce = 0.6;
my $ball_radius = 0.015;

# Balls
my $num_balls = 12;
my @balls;

sub spawn_balls {
    @balls = ();
    for my $i (0 .. $num_balls - 1) {
        push @balls, {
            x   => 0.02 + rand() * 0.15,  # start position along slope [0,1]
            vx  => 0.01 + rand() * 0.02,  # initial velocity
            r   => $ball_radius * (0.7 + rand() * 0.6),
            hue => $i / $num_balls,
            trail => [],
        };
    }
}
spawn_balls();

# Pre-compute slope data
my $slope_samples = 200;
my @slope_heights;
my @slope_gradients;

sub update_slope {
    my $e = $slopes[$current_slope];
    my $d = $e->duration;
    my $s = $e->static;
    my $deriv = $e->resample($slope_samples)->derivative->static;
    my $dd = $e->resample($slope_samples)->derivative->duration;
    @slope_heights = ();
    @slope_gradients = ();
    for my $i (0 .. $slope_samples) {
        my $t = $i / $slope_samples;
        push @slope_heights, $s->($t * $d);
        push @slope_gradients, $deriv->($t * $dd);
    }
}
update_slope();

sub slope_at {
    my ($x) = @_;
    $x = 0 if $x < 0; $x = 1 if $x > 1;
    my $fi = $x * $slope_samples;
    my $i = int($fi);
    $i = $slope_samples - 1 if $i >= $slope_samples;
    my $f = $fi - $i;
    my $next = $i < $slope_samples ? $i + 1 : $i;
    return $slope_heights[$i] * (1 - $f) + $slope_heights[$next] * $f;
}

sub gradient_at {
    my ($x) = @_;
    $x = 0 if $x < 0; $x = 1 if $x > 1;
    my $fi = $x * $slope_samples;
    my $i = int($fi);
    $i = $slope_samples - 1 if $i >= $slope_samples;
    my $f = $fi - $i;
    my $next = $i < $slope_samples ? $i + 1 : $i;
    return $slope_gradients[$i] * (1 - $f) + $slope_gradients[$next] * $f;
}

# Shaders
my $vert_src = <<'GLSL';
#version 150
in vec2 aPos;
uniform mat4 uMVP;
void main() { gl_Position = uMVP * vec4(aPos, 0.0, 1.0); }
GLSL

my $frag_src = <<'GLSL';
#version 150
uniform vec4 uColor;
out vec4 outColor;
void main() { outColor = uColor; }
GLSL

my ($prog, $u_mvp, $u_color, $vbo, $vao);
my ($start, $last_time);

sub compile_shader {
    my ($type, $src) = @_;
    my $s = glCreateShader($type);
    glShaderSource_p($s, $src);
    glCompileShader($s);