tecla

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use 5.01000;

use threads;
use threads::shared;

use SDL 2.3;
use SDL::Audio;
use SDL::AudioSpec;
use SDL::Color;
use SDL::App;
use SDL::Event;
use SDL::Events;
use SDL::Mouse;
use SDL::Time;

our $FPS :shared;
our $width :shared;
our $height :shared;

$FPS = 40;
$width = 1280;
$height = 800;

my $time_acc = 0;
my $time_acc_ctrl = 0;

# these are the message-passing arrays
our @timer_to_audio :shared;
our @event_to_timer :shared;

our $app = SDL::App->new
  ( -width => $width,
    -height => $height,
    -depth => 16,
    -resizeable => 1,
    -title => 'Tecla',
  #  -fullscreen => 1
  );

our $bg_color = SDL::Video::map_RGB($app->format(), 0, 0, 0);

SDL::Mouse::show_cursor(0);

our $time = $app->ticks;

our @objects;
sub timer_callback {
  my $oldtime = $time;
  my $now = $app->ticks;

  my @newobjects;
  {
    lock @event_to_timer;
    while (shift @event_to_timer) {
      my $x = int(rand($width));
      my $y = int(rand($height));
      my $r = int(rand(255));
      my $g = int(rand(255));
      my $b = int(rand(255));
      my $s = int(rand(20))+20;
      my $t = int(rand(1700))+300;

      my $tone = int(rand(24))-24;   # produce one octave higher and
      # one lower than the base
      my $freq = 440 *               # start on A4
        ((2 ** (1/12)) ** $tone);    # formula took from:
      # http://www.phy.mtu.edu/~suits/NoteFreqCalcs.html

      push @newobjects, Tecla::Object->new
        ({ rect => SDL::Rect->new($x, $y, $s, $s),
           start_color => SDL::Color->new($r, $g, $b),
           started => $time,
           duration => $t,
           freq => $freq });
    }
  };

  lock $width;
  lock $height;

  my $rect = SDL::Rect->new(0, 0, $width, $height);

  SDL::Video::fill_rect($app, $rect, $bg_color);

  @objects = grep { $_->time_lapse($oldtime,$now) && $_->draw() } @objects, @newobjects;

  SDL::Video::update_rects($app, map { $_->rect } @objects );


  $time = $app->ticks;

  $time_acc += $time - $now;
  if (++$time_acc_ctrl == 100) {
    my $avg = $time_acc / 100;
    print "Average time is $avg\n";
    $time_acc = 0;
    $time_acc_ctrl = 0;
  }

  return int(1000/$FPS);
}

our $timer = SDL::Time::add_timer(int(1000/$FPS),'main::timer_callback');

our @sequencer;
sub audio_callback {
  my ($int_size, $len, $streamref) = @_;

  my $now = $app->ticks;

  while (my $message = shift @timer_to_audio) {
    # get rid of shared object...
    my %local_message = %{$message};
    my $wave_duration = 1 / $local_message{freq};
    $local_message{wave_samples} = (11025 * ($wave_duration));
    $local_message{played_samples} = 0;
    push @sequencer, \%local_message;
  }

  @sequencer =
    grep { $_ }
    (sort { $b->{started} <=> $a->{started} }
     grep { $_->{started} + $_->{duration} > $now } @sequencer)[0..10];


  return unless @sequencer;
  my $count = scalar @sequencer;

  for (my $i = 0; $i < $len; $i++) {
    use bytes;

    my $val = 0;

    for my $self (@sequencer) {

      my $offset =  $self->{played_samples} -
        (int($self->{played_samples} / $self->{wave_samples})*$self->{wave_samples});


      my $amp = 1;
      if ($now - $self->{started} < 30) {
        $amp = ($now - $self->{started})/30;
      } elsif ($self->{duration} - ($now - $self->{started}) < 30) {
        $amp = ($self->{duration} - ($now - $self->{started})) / 30;
      }

      my $this = $amp * sin(($offset / $self->{wave_samples}) * 360 / 180);
      $val += $this;


      $self->{played_samples} += $len;

    }

    $val = int($val * 10) + 0x80; # this is the center...
    $val = 0 if $val < 0;
    $val = 255 if $val > 255;

    substr($$streamref, $i, 1, chr($val));

  }

}

sub setup_audio {
  my $desired = SDL::AudioSpec->new;
  my $obtained = SDL::AudioSpec->new;
  $desired->callback( 'main::audio_callback'); #canno
  $desired->freq ( 11025 );
  $desired->format ( AUDIO_U8 );
  $desired->samples ( 2048 );
  $desired->channels( 1 );

  die('AudioMixer, Unable to open audio: '.SDL::get_error."\n" ) if ( SDL::Audio::open($desired, $obtained) < 0 );

  SDL::Audio::pause(0);
}

setup_audio();

our $sevent = SDL::Event->new;
while (SDL::Events::wait_event($sevent)) {
  my $type = $sevent->type;
  if ($type == SDL_QUIT()) {
    exit;
  } elsif ($type == SDL_KEYDOWN() &&
           $sevent->key_sym() == SDLK_ESCAPE) {
    exit;
  } elsif ($type == SDL_KEYDOWN() &&
           $sevent->key_sym() == SDLK_F11) {
    SDL::Video::wm_toggle_fullscreen($app);
  } elsif ($type == SDL_VIDEORESIZE()) {
    lock $width;
    lock $height;
    $app->resize($sevent->resize_w, $sevent->resize_h);
    $height = $app->h;
    $width = $app->w;
  } else {
    lock @event_to_timer;
    push @event_to_timer, 1;
  }
}

package Tecla::Object;
use strict;
use warnings;
use base 'Class::Accessor';

BEGIN {
  __PACKAGE__->mk_accessors(qw(rect started duration time_to_live
                               start_color color freq));
}

sub new {
  my $self = shift;
  $self = $self->SUPER::new(@_);

  my %message :shared;
  $message{started} = $self->started;
  $message{duration} = $self->duration / 2;
  $message{freq} = $self->freq;
  push @timer_to_audio, \%message;

  return $self;
}

sub time_lapse {
  my ($self, $oldtime, $now) = @_;
  $self->time_to_live(($self->started + $self->duration) - $now);
  if ($self->time_to_live > 0) {
    my $percent = $self->time_to_live / $self->duration;
    $self->color
      ( SDL::Video::map_RGB($app->format(),
        ( $self->start_color->r * $percent,
          $self->start_color->g * $percent,
          $self->start_color->b * $percent )));
    return 1;
  } else {
    return 0;
  }
}

sub draw {
  my $self = shift;
  SDL::Video::fill_rect($app, $self->rect, $self->color);
  return 1;
}

1;