#!/usr/bin/perl
#*******************************************************
#
# Filename: noteduration_1_0.pl
#
# Description:
#    This Perl script defines a class to generate Schillinger resultants
#    and uses those resultants in other classes to create a MIDI file using 
#    the MIDI-Perl classes. Tk is used to create a user interface to generate 
#    a resultant and start QuickTime Player on Mac OS X to play the MIDI file.
#
# Perl modules required by this script:
#    MIDI-Perl
#    Tk
#
# Using the script
# ================
# 1. Install the MIDI-Perl and Tk modules from http://www.cpan.org if these
#    modules are not in your Perl installation.
# 2. Place this script in a directory where Perl can be accessed.
# 3. Use the command "perl noteduration_1_0.pl" in a terminal window to start the Perl script.
#     A Tk window should open and display two text fields and two buttons.
# 4. To create a MIDI file with pitches and durations based on Schillinger
#    resultants, put two integer numbers in the text fields. The upper text field
#    is for the major generator, and the lower text field is for the minor generator.
#    Usually, the major generator is larger than the minor generator.
# 5. Click on the "Create MIDI File" button to create the MIDI file based
#    on the inputs for the major and minor generators. The file will be
#    written to "schillinger.mid".
# 6. Click on the "Done" button to exit the script. The Tk window will close.
# 7. Use a program that can play MIDI files (Windows Media Player or
#    QuickTime Player) to hear the result.
#
# References
# ==========
# My article "Making Perl Reusable with Modules" (http://www.perl.com/pub/a/2007/08/09/making-perl-modules.html)
# gives a brief overview of how resultants are created and describes an early version of this script.
#
#
# Copyright 2007 Andy Sylvester, all rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#
# Revision History:
#
# Rev 1.0 08/09/2007
#   Initial version released on andysylvester.com
#
#**************************************************************

#####################################################
# Class Name: Resultant
# =====================
#
# Synopsis:
#
# use Resultant;
#
# Class Methods:
#
#   $seq1 = Resultant->new(5, 3)
#
#      Creates a new object with a major generator of 5 and
#      a minor generator of 3. These parameters need to be
#      initialized when a new object is created, as there
#      are no methods to set these elements within the object.
#
#   $seq1->generate()
#
#      Generates a resultant and saves it in the ResultList array
#
# Object Data Methods:
#
#   $major_generator = $seq1->get_major()
#
#      Returns the major generator
#
#   $minor_generator = $seq1->get_minor()
#
#      Returns the minor generator
#####################################################

{ package Resultant;
  use strict;
  sub new {
    my $class = shift;
    my $major_generator = shift;
    my $minor_generator = shift;
    my @result = ();
    my $self = {Major => $major_generator,
                Minor => $minor_generator, 
                ResultantList => []};
    bless ($self, $class);
    return $self;
  }
  sub get_major {
    my $self = shift;
    return $self->{Major};
  }
  sub get_minor {
    my $self = shift;
    return $self->{Minor};
  }

  sub generate {
    my $self = shift;
    my $total_counts = $self->get_major * $self->get_minor;
    my $i;
    my $major_mod;
    my $minor_mod;
    my @result = ();
    my $result_counter = 0;

   while ($i < $total_counts) {
       $i++;
       $result_counter++;
       $major_mod = $i % $self->get_major;
       $minor_mod = $i % $self->get_minor;
       if (($major_mod == 0) || ($minor_mod == 0)) {
          push(@result, $result_counter);
          $result_counter = 0;
       }
   }
   @{$self->{ResultList}} = @result;
  }
}

#####################################################
# Class Name: Note
# ================
#
# Synopsis:
#
# use Note;
#
# Class Methods:
#
#   $note1 = Note->new()
#
#      Creates a new Note object 
#
#   $note1->pitch(5)
#
#      Sets the pitch value of the Note object to 5
#
#   $note1->duration(5)
#
#      Sets the duration value of the Note object to 5
#
#
# Object Data Methods:
#
#   $note1->pitch()
#
#      Gets the pitch value of the Note object
#
#   $note1->duration()
#
#      Gets the duration value of the Note object
#
#####################################################

{ package Note;
  use strict;
  sub new {
    my $class = shift;
    my $self = {};
    $self->{PITCH} = undef;
	$self->{DURATION} = undef;
    bless ($self, $class);
    return $self;
  }
  sub pitch {
    my $self = shift;
    if (@_) { $self->{PITCH} = shift }
    return $self->{PITCH};
  }
  sub duration {
    my $self = shift;
    if (@_) { $self->{DURATION} = shift }
    return $self->{DURATION};
  }
}

#####################################################
# Class Name: RelPitch
# ====================
#
# Synopsis:
#
# use RelPitch;
#
# Class Methods:
#
#   $pitch1 = RelPitch->new()
#
#      Creates a new RelPitch object 
#
#   $pitch1->pitch_list(@{$seq4->{ResultList}});
#
#      Sets the list of pitch offsets in the RelPitch object
#      The example code above shows a resultant list used as the input
#
#   $pitch1->starting_pitch(50)
#
#      Sets the starting pitch of the RelPitch object to 50 (a MIDI pitch value)
#
#
# Object Data Methods:
#
#   $pitch1->pitch_list();
#
#      Gets the list of pitch offsets of the RelPitch object
#
#   $pitch1->starting_pitch(50)
#
#      Gets the starting pitch of the RelPitch object (a MIDI pitch value)
#####################################################

{ package RelPitch;
  use strict;
  sub new {
    my $class = shift;
    my $self = {};
    $self->{STARTINGPITCH} = undef;
	$self->{PITCHLIST} = [];
    bless ($self, $class);
    return $self;
  }
  sub starting_pitch {
    my $self = shift;
    if (@_) { $self->{STARTINGPITCH} = shift }
    return $self->{STARTINGPITCH};
  }
  sub pitch_list {
    my $self = shift;
    if (@_) { @{ $self->{PITCHLIST} } = @_ }
    return @{ $self->{PITCHLIST} };
  }

}

#####################################################
# Class Name: RelDuration
# ========================
#
# Synopsis:
#
# use RelDuration;
#
# Class Methods:
#
#   $duration1 = RelDuration->new()
#
#      Creates a new RelDuration object 
#
#   $duration1->duration_list(@{$seq4->{ResultList}});
#      Sets the list of duration multiples in the RelDuration object
#      The example code above shows a resultant list used as the input
#
#   $duration1->duration_unit(4);
#
#      Sets the duration unit of the RelDuration object to 4
#      The following units can be represented:
#         1 - whole note
#         2 - half note
#         4 - quarter note
#         8 - eighth note
#
#
# Object Data Methods:
#
#   $duration1->duration_list();
#
#      Gets the list of duration multiples in the RelDuration object
#
#   $duration1->duration_unit()
#
#      Gets the duration unit of the RelDuration object
#####################################################

{ package RelDuration;
  use strict;
  sub new {
    my $class = shift;
    my $self = {};
    $self->{DURATIONUNIT} = undef;
	$self->{DURATIONLIST} = [];
    bless ($self, $class);
    return $self;
  }
  sub duration_unit {
    my $self = shift;
    if (@_) { $self->{DURATIONUNIT} = shift }
    return $self->{DURATIONUNIT};
  }
  sub duration_list {
    my $self = shift;
    if (@_) { @{ $self->{DURATIONLIST} } = @_ }
    return @{ $self->{DURATIONLIST} };
  }

}

#####################################################
# Class Name: MusicEvents
# =======================
#
# Synopsis:
#
# use MusicEvents;
#
# Class Methods:
#
#   $event1 = MusicEvents->new()
#
#      Creates a new MusicEvents object 
#
#   $event1->create_event_list($pitch1, $duration1);
#      Creates a list of MIDI events based on a RelPitch and RelDuration object
#
# Object Data Methods:
#
#   @eventlist = $event1->get_event_list();
#
#      Gets the list of MIDI events in the MusicEvents object
#####################################################

{ package MusicEvents;
  use strict;
  sub new {
    my $class = shift;
    my $self = {};
    $self->{STARTINGPITCH} = undef;
    $self->{DURATIONUNIT} = undef;
	$self->{EVENTLIST} = [];
    bless ($self, $class);
    return $self;
  }
  sub create_event_list {
    my $self = shift;
    my $pitches = shift;
    my $durations = shift;
    my $note = undef;
    my $duration = undef;
	my @event1 = [];
	my @event2 = [];
    my @pitchlist = $pitches->pitch_list();
    my @durationlist = $durations->duration_list();
	my $index = undef;

    $self->{STARTINGPITCH} = $pitches->starting_pitch();
    $self->{DURATIONUNIT} = $durations->duration_unit();
    for ($index = 0; $index < @pitchlist; $index++) {
       $note = @pitchlist[$index];
       $duration = @durationlist[$index];
       @event1 = ['note_on', 0, 8, $note + $self->{STARTINGPITCH}, 127];
       @event2 = ['note_off', $duration * 96, 8, $note + $self->{STARTINGPITCH}, 127];
       push @{$self->{EVENTLIST}}, @event1;
       push @{$self->{EVENTLIST}}, @event2;
    }
    if (@_) { @{ $self->{EVENTLIST} } = @_ }
    return @{ $self->{EVENTLIST} };
  }
  sub get_event_list {
    my $self = shift;
    return @{ $self->{EVENTLIST} };
  }
}

#####################################################
#
# Tk application to use the above classes
#
#####################################################
use Tk;
use MIDI;
use strict;
use warnings;

# Provide initial values for major generator and minor generator text fields
my $major_test = 2;
my $minor_test = 1;

# Set up Tk window, buttons, and text entry fields
my $mw = MainWindow->new;
$mw->title("Schillinger Music Tool");
$mw->Button(-text => "Create MIDI File", -command => [\&create_file])->pack;
$mw->Button(-text => "Done", -command => sub {exit})->pack;
my $e1 = $mw->Entry(-textvariable => \$major_test)->pack;
my $e2 = $mw->Entry(-textvariable => \$minor_test)->pack;

# Begin program loop
MainLoop;

# Subroutine for generating the resultant and creating a
# MIDI file from the resultant. This executes when the "Create MIDI File"
# button is pressed and uses the values of the major generator
# and minor generator from the Tk application.
#

sub create_file {

my $i;
my $j;

# Get inputs for Resultant object
  my $major_gen = $e1->get();
  my $minor_gen = $e2->get();

# Create a resultant
my $seq4 = Resultant->new($major_gen, $minor_gen);
$seq4->generate();
# Use the resultant to define a pitch series
my $pitch3 = RelPitch->new();
$pitch3->pitch_list(@{$seq4->{ResultList}});
$pitch3->starting_pitch(50);
# Use the resultant to define a duration series
my $duration3 = RelDuration->new();
$duration3->duration_list(@{$seq4->{ResultList}});
$duration3->duration_unit(4);
# Use the pitch and duration series as inputs to create a set of music 
# suitable for use in MIDI-Perl modules
my $event1 = MusicEvents->new();
$event1->create_event_list($pitch3, $duration3);
# Check event lists to confirm that the music events were created correctly
my @eventlist = $event1->get_event_list();
my @music_result;

# Now, let us see if we can use the Music Events object to create
# a MIDI file 

# Do initial MIDI patch setup and create events array

  my @events = (
     ['text_event',0, 'SCHILLINGER'],
     ['set_tempo', 0, 450_000], # 1qn = .45 seconds
     ['patch_change', 0, 8, 1],
   );

# Add note events based on event list from MusicEvents object
# Note that there is a set of brackets around each instance of the @music_result
# list pushed onto the @events list. This was required so that the MIDI::Event
# class would not give an error

for ($i = 0; $i < $#eventlist + 1; $i++) {
   # Debug code to look at contents of eventlist array
   # print $i, "  ", @{$eventlist[$i]}, "\n";
   @music_result = @{$eventlist[$i]};
   push @events, [@music_result] ;
}

# Create MIDI file from events array
my $my_track = MIDI::Track->new({ 'events' => \@events });
my $opus = MIDI::Opus->new(
 { 'format' => 0, 'ticks' => 96, 'tracks' => [ $my_track ] } );
$opus->write_to_file( 'schillinger.mid' );

}