#!/usr/bin/perl

##############################################################
#                                                            #
#          Gideon Sound System                               #
#                                                            #
#          - Fast integer operation [ samplerate x 16 bit ]  #
#          - Full spectrum harmonics                         #
#          - All possible chords                             #
#          - Pitch                                           #
#          - Volume                                          #
#          - Decay and attack                                #
#          - All formats                                     #
#                                                            #
#          (C) 2018 Chaosje, Domero                          #
#                                                            #
##############################################################

package gsound;

use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use POSIX qw(fmod);
use Win32::Sound;
use gerr;

$VERSION     = '1.01';
@ISA         = qw(Exporter);
@EXPORT      = qw($FREQ create tone pcm play save);
@EXPORT_OK   = qw();

# standard octave 4
our $FREQ = {
  'A' => 440,
  'AB' => 466.1638,
  'B' => 493.8833,
  'C' => 523.2511,
  'CD' => 554.3653,
  'D' => 587.3295,
  'DE' => 622.2540,
  'E' => 659.2551,
  'F' => 698.4565,
  'FG' => 739.9888,
  'G' => 783.9909,
  'GA' => 830.6094
};

my $PI2 = 6.28318530;

1;

sub create {
  # Create a new piece of music
  my ($name,$samplerate,$bitrate,$channels) = @_;
  my $self = {
    name => $name,
    samplerate => $samplerate,
    bitrate => $bitrate,
    channels => $channels,
    objects => []
  };
  bless($self); 
  $self->calcsintab();
  return $self
}

sub calcsintab {
  my ($self) = @_;
  my $table=[];
  for my $i (0..$self->{samplerate}-1) {
    push @$table,int(32767 * sin($i * $PI2 / $self->{samplerate}));
  }
  $self->{sintab}=$table
}

sub tsin {
  my ($self,$x) = @_;
  #my $y=int(fmod($x,1) * $self->{samplerate});
  return $self->{sintab}[$x % $self->{samplerate}]
}

sub tone {
  my ($self,$start,$duration,$tone,$filters) = @_;
  if (!ref($self)) { error("Forget to incluse Object-reference? \$self->tone :)") }
  if (!$filters) { $filters={} }
  if (defined $filters->{volume}) {
    if ($filters->{volume} =~ /([0-9]+)\%/) {
      $filters->{volume}=$1 / 100
    }
  } else {
    $filters->{volume}=1
  }
  if ($filters->{volume} > 1) { $filters->{volume}=1 }
  if ($filters->{volume} < 0) { $filters->{volume}=0 }
  my $sample=0; my $totsamples=int ($duration * $self->{samplerate});
  $start=int ($start * $self->{samplerate});
  my $object={ start => $start, filters => $filters, notes => [], samples => $totsamples, dataleft => [], dataright => [], normalize => 32767 };
  for (my $n=0;$n<$totsamples;$n++) {
    push @{$object->{dataleft}},0;
    push @{$object->{dataright}},0;
  }
  my $p=0; my $stat=0; my $note; my $doubler=1; my $notation;
  while ($p<length($tone)) {
    my $c=substr($tone,$p,1);
    if ($stat==0) {
      $note=uc($c); $stat=1; $doubler=1; $p++; $notation=""
    } elsif ($stat==1) {
      if ($c =~ /[0-9\-]/) {
        my $nc="";
        if ($p<length($tone)-1) {          
          $nc=substr($tone,$p+1,1);
        }
        if ($c eq '-') {
          $c=-$nc; $p++
        } elsif ($nc =~ /[0-9]/) {
          $c=$c*10+$nc; $p++
        }
        if ($c > 3) { $doubler=$c-3 }
        else { $doubler=(5-$c) ** -1 }
        $notation=$note.$c;
        $stat=2
      } elsif ($c eq ' ') {
        $stat=2
      } elsif ($c eq '#') {
        $note.=uc(chr(ord($note) + 1)); $p++
      } else {
        $note.=uc($c); $p++
      }      
    } elsif ($stat==2) {
      if ($FREQ->{$note}) {
        push @{$object->{notes}},$notation;
        $object->{currentfreq}=$FREQ->{$note}*$doubler;
        $object->{position}=0;
        $self->samples($object,$totsamples);
      }
      $p++; $stat=0
    }
  }
  $object->{normfac} = 32767 / $object->{normalize};
  push @{$self->{objects}},$object;
  bless($object);
  return $object
}

sub melody {
  my ($self,$length,$melody) = @_;
  my $tm=0; my $ofs=0; my $stat=0; my $dur=1; my $note="";
  while ($ofs<length($melody)) {
    my $c=uc(substr($melody,$ofs,1));
    if ($stat==0) {
      $dur=$c; $ofs++; $stat=1; $note="";
      print "Dur = $c\n"
    } elsif ($stat==1) {
      if ($c eq 'P') {
        $tm+=$dur*$length; $stat=0; $ofs++
      } elsif ($c eq 'X') {
        $tm-=$dur*$length; $stat=0; $ofs++
      } elsif ($c =~ /[0-9]/) {
        $note.=$c;
        $self->tone($tm,$dur*$length,$note); $ofs++; $stat=0;
        $tm+=$dur*$length
      } else {
        $note.=$c; $ofs++;
      }
    }
  }
  return $self
}

sub samples {
  my ($self,$object,$samples) = @_;
  my $filters=$object->{filters};
  my $volume=$filters->{volume};
  if (!defined $volume) { $volume=1 }
  my $sample=0; my $list=[];
  while ($sample < $samples) {
    if (!$filters->{harmonics} || !$filters->{harmonics}{scheme} || ($filters->{harmonics}{scheme} ne 'none')) {
      $object->{dataleft}[$sample]+=$self->harmony($object,$sample,$filters->{harmonics}) * $volume;
    } else {
      $object->{dataleft}[$sample]+=$self->tsin($sample*$object->{currentfreq}) * $volume
    }

    # !! First demo left == right !! *
    $object->{dataright}[$sample]=$object->{dataleft}[$sample];
    if (abs($object->{dataleft}[$sample]) > $object->{normalize}) { $object->{normalize}=abs($object->{dataleft}[$sample]) }
    if (abs($object->{dataright}[$sample]) > $object->{normalize}) { $object->{normalize}=abs($object->{dataright}[$sample]) }
    $sample++; $object->{position}=$sample
  }
  return $list
}

sub harmony {
  my ($self,$object,$sample,$harmonics) = @_;
  my $freq=$object->{currentfreq};
  my $iter = ($self->{samplerate} >> 1) / $freq;
  if ($harmonics->{maxiter}) {
    if ($iter > $harmonics->{maxiter}) { $iter=$harmonics->{maxiter} }
  } else {
    if ($iter > 20) { $iter=20 }
  }
  my $v=$self->tsin($sample*$freq);
  my $nfreq = $freq;
  for (my $n=2;$n<=$iter;$n++) {
    my $inv=$n ** -1; $nfreq+=$freq;
    #$inv*=(0.55 * (1+sin($hz*($n/3)*$PI2)));
    if ($harmonics->{high}) { $inv *= $harmonics->{high} }
    $v+=$inv * $self->tsin($sample*$nfreq);
  }
  if ($harmonics->{maxiterlow}) { $iter=$harmonics->{maxiterlow} }
  for (my $n=2;$n<=$iter;$n++) {
    my $inv=$n ** -1;
    if ($harmonics->{low}) { $inv *= $harmonics->{low} }
    $v+=$inv * $self->tsin($sample*$freq*$inv);
  }
  if ($harmonics->{fixed}) {
    foreach my $fa (@{$harmonics->{fixed}}) {
      my ($hn,$vol)=@$fa;
      my $tf=$freq;
      if ($hn>0) { $tf*=$hn } else { $tf = $tf / $hn }
      $v+=$vol * $self->tsin($sample*$tf)
    }
  }
  return $v
}

sub volume {
  my ($object,$volume,$volumeright) = @_;
  if (!defined $volume) { return $object }
  if ($volume =~ /[0-9]+\%/) {
    $volume = $1 / 100
  }
  if ($volume > 1) { $volume = 1 }
  if ($volume < 0) { $volume = 0 }
  if (!defined $volumeright) { $volumeright=$volume }
  elsif ($volumeright =~ /[0-9]+\%/) {
    $volumeright = $1 / 100
  }
  if ($volumeright > 1) { $volumeright = 1 }
  if ($volumeright < 0) { $volumeright = 0 }
  for my $i (0..$object->{samples}) {
    $object->{dataleft}[$i] *= $volume;
    $object->{dataright}[$i] *= $volumeright;
  }
  return $object
}

sub pcm {
  # Create PCM data sample by sample, normalizing mixed samples per sample
  my ($self) = @_;  
  my $last=0;
  foreach my $b (@{$self->{objects}}) {
    my $end=$b->{start}+$b->{samples};
    if ($end>$last) { $last=$end }
  }
  my $startpoints={};
  foreach my $b (@{$self->{objects}}) {
    my $start=$b->{start};
    if (!defined $startpoints->{$start}) {
      $startpoints->{$start}=[ $b ]
    } else {
      push @{$startpoints->{$start}},$b
    }
  }
  my $playing=[];
  my $blocklen=[];
  my @spl=sort { $a <=> $b } keys %$startpoints;
  my $counter=0; my $pcm="";
  # initial white silence
  for my $counter (1..$spl[0]) {
    $pcm.=pack('v',0); if ($self->{channels} > 1) { $pcm.=pack('v',0) }
  }
  for my $pp (0..$#spl) {
    my $samples;
    foreach my $obj (@{$startpoints->{$spl[$pp]}}) {
      $obj->{pcmpos}=0;
      push @$playing,$obj
    }
    if ($pp == $#spl) { $samples=$last-$spl[$pp] }
    else { $samples=$spl[$pp+1]-$spl[$pp] }
    my $maxleft=0; my $maxright=0; my $dataleft=[]; my $dataright=[];
    for my $scnt (0..$samples-1) {
      my $left=0; my $right=0; my $numplaying=$#{$playing}+1;
      if (!$numplaying) {
        $pcm.=pack('v',0); if ($self->{channels} > 1) { $pcm.=pack('v',0) }
      } else {
        my $playcnt=0;
        while ($playcnt < $numplaying) {
          my $obj=$playing->[$playcnt];
          if ($obj->{pcmpos} >= $obj->{samples}) {
            splice(@$playing,$playcnt,1); $numplaying--
          } else {
            $playcnt++
          }
        }
        for my $playcnt (0..$numplaying-1) {
          my $obj=$playing->[$playcnt];
          $left+=$obj->{dataleft}[$obj->{pcmpos}] * $obj->{normfac};
          $right+=$obj->{dataright}[$obj->{pcmpos}] * $obj->{normfac};
          $obj->{pcmpos}++
        }
      }
      push @$dataleft,$left;
      push @$dataright,$right;
      if (abs($left) > $maxleft) { $maxleft=abs($left) }
      if (abs($right) > $maxright) { $maxright=abs($right) }
      $counter++
    }
    my $facleft=1; my $facright=1;
    if ($maxleft>32767) { $facleft=32767 / $maxleft }
    if ($maxright>32767) { $facright=32767 / $maxright }
    for my $scnt (0..$samples-1) {
      $pcm.=pack('v',$dataleft->[$scnt] * $facleft);
      if ($self->{channels} > 1) {
        $pcm.=pack('v',$dataright->[$scnt] * $facright);
      }
    }
  }
  return $pcm
}

sub play {
  my ($self,$pcm) = @_;
  if (!defined $pcm) { error("Cannot play undefined data.") }
  my $player=new Win32::Sound::WaveOut($self->{samplerate}, $self->{bitrate}, $self->{channels});
  $player->Load($pcm);
  $player->Write();
  1 until $player->Status();
  $player->Save($self->{name}.".wav");
  $player->Unload();
}

sub save {
  my ($self,$pcm) = @_;
  my $player=new Win32::Sound::WaveOut($self->{samplerate}, $self->{bitrate}, $self->{channels});
  $player->Load($pcm);
  $player->Save($self->{name}.".wav");
}

sub mix {
  # mix harmonic tones to accords.
  my ($self,$object,$samples) = @_;
  my $biasleft=0; my $biasright=0; my $pos=0;
  my $left=[]; my $right=[];
  foreach my $sample (@$samples) {
    $biasleft = $object->{dataleft}[$pos] + $sample;
    $biasright = $object->{dataright}[$pos] + $sample;
    push @$left,$biasleft;
    push @$right,$biasright;
    $pos++;
  };
  $object->{dataleft} = $left;
  $object->{dataright} = $right;
}

# EOF gsound.pm (C) 2018 Chaosje, Domero