#!/usr/bin/perl

@modes     = qw(Ionian Dorian Phygian Lydian Myxolydian Aeolian Locrian);
@intervals = qw(0 2 4 5 7 9 11);
@notes     = qw(C D E F G A B);
%nextlet   = (
  'A' => 'B', 'B' => 'C', 'C' => 'D', 'D' => 'E',
  'E' => 'F', 'F' => 'G', 'G' => 'A',
);
@chords = (
  [ "",         0, 4, 7 ],
  [ "m",        0, 3, 7 ],
  [ "+",        0, 4, 8 ],
  [ "mb5",      0, 3, 6 ],
  [ "7",        0, 4, 7, 10 ],
  [ "maj7",     0, 4, 7, 11 ],
  [ "m7",       0, 3, 7, 10 ],
  [ "m(maj7)",  0, 3, 7, 11 ],
  [ "m7b5",     0, 3, 6, 10 ],
  [ "dim",      0, 3, 6, 9 ],
  [ "sus",      0, 5, 7 ],
);

# fill out the intervals array
for (@intervals)
{
  push @intervals, $_+12;
  last if $#intervals > 50;
}

# fill in the %notes hash
@noteval{qw(C D E F G A B)} = @intervals;
for $_ (qw(C D E F G A B))
{
  push @notes, $_.'#'; push @notes, $_.'b';
  $noteval{$_.'#'}   = $noteval{$_}+1;
  $noteval{$_.'b'}   = $noteval{$_}-1;
  $noteval{$_.'##'}  = $noteval{$_}+2;
  $noteval{$_.'bb'}  = $noteval{$_}-2;
  $noteval{$_.'###'} = $noteval{$_}+3;
  $noteval{$_.'bbb'} = $noteval{$_}-3;
}
for (keys %noteval)
{
  $noteval{$_} += 12 while $noteval{$_} < 0;
  $noteval{$_} -= 12 while $noteval{$_} > 11;
}

for $mode (@modes)
{
  for $key (@notes)
  {
    $keyval = $noteval{$key}; $let = substr $key, 0, 1;
    @scale = ();
    for $degree (0..7)
    {
      $val = $keyval+$intervals[$degree];
      $val += 12 while $val < 0;
      $val -= 12 while $val > 11;
      if ($noteval{$note = $let} != $val)
      {
	for $acc (qw(b # bb ## bbb ###))
	{
	  if ($noteval{$note.$acc} == $val)
	    { $note .= $acc; last; }
	}
      }
      push @scale, $note;
      for $ch (@chords)
      {
	@ch = @$ch;
	$name = shift @ch
	for $civ (@ch)
	{
	}
      }
    }
    continue
    {
      $let = $nextlet{$let};
    }
    print "$mode: @scale\n";
  }
}
continue
{
  # adjust @intervals for next mode
  shift @intervals;
  $d = $intervals[0];
  for (@intervals) { $_ -= $d; }
}

__END__

for each mode
  for each each key
    for each letter
      assign appr #, b
      dum letter

@ivs = qw(2  4  5  7  9 11 12 14 16 17 19 21 23 24);

for (1..7)
{
  print "0 @ivs[0..6]\n";
  $min = shift @ivs;
  for $v (@ivs) { $v -= $min; }
}

I    0 2 4 5 7 9 11 12
II   0 2 3 5 7 9 10 12
III  0 1 3 5 7 8 10 12
IV   0 2 4 6 7 9 11 12
V    0 2 4 5 7 9 10 12
VI   0 2 3 5 7 8 10 12
VII  0 1 3 5 6 8 10 12

Qmb5      0 3 6      VII
Qm7b5     0 3 6 10   VII
Qm        0 3 7      II III VI
Qm7       0 3 7 10   II III VI
Q         0 4 7      I IV V
Q7        0 4 7 10   V
Qmaj7     0 4 7 11   I IV
Qsus      0 5 7      I II III V VI

Q         0 4 7
Qm        0 3 7
Q+        0 4 8
Qmb5      0 3 6
Q7        0 4 7 10
Qmaj7     0 4 7 11
Qm7       0 3 7 10
Qm(maj7)  0 3 7 11
Qm7b5     0 3 6 10
Qdim      0 3 6 9
Qsus      0 5 7

I, Imaj7, Isus
IIm, IIm7, IIsus
IIIm IIIm7, IIIsus
IV, IVmaj7
V, V7, Vsus
VIm, VIm7, VIsus
VIImb5, VIIm7b5

@lines = split /\n/, <<EOF;
Q, Qmaj7, Qsus
Qm, Qm7, Qsus
Qm Qm7, Qsus
Q, Qmaj7
Q, Q7, Qsus
Qm, Qm7, Qsus
Qmb5, Qm7b5
EOF

@modes=qw(Ionian Dorian Phrygian Lydian Myxolydian Aeolian Locrian);
@trs = qw(I II III IV V VI VII);

for $m (@modes)
{
  print "$m\n";
  for $i (0..6)
  {
    $s = $lines[$i];
    $s =~ s/Q/$trs[$i]/g;
    print "$s\n";
  }
  print "\n";
  push @lines, shift @lines;
}