Ladění/stupnice-didym.pl

#! /usr/bin/perl
# stupnice-didym.pl  wikitabulka čistého didymického a rovnoměrně temperovaného ladění

use strict; 
use warnings; 

my $class = 'wikitable sortable';
my $label = 'Diatonická stupnice, didymické a rovnoměrně temperované ladění';

my @columns = qw(č. stupeň název poměr násobek půltónů temper dev cent);
my @degree_nr = qw(1 2 3 4 5 6 7 8);
my @degree_nr_lat = qw(I II III IV V VI VII VIII);
my @interval = ('prima', 'v. sekunda', 'v. tercie',  'kvarta', 'kvinta',  'v. sexta',  'v. septima',  'oktáva');
my @ratio = qw(1:1 9:8 5:4 4:3 3:2 5:3 15:8 2:1);
my @mult;	# čím musím násobit frekvenci I. stupně
my @mult_str;
my @halftones = qw(0 2 4 5 7 9 11 12);
my @temper;	# rovnoměrně temperované ladění
my @temper_str;
my @deviation;	# f_temper/f_didym
my @dev_str;
my @dev_cent;	# deviace temper. ladění v centech 
my @dev_cent_str;

my $one_halftone = 2 ** (1/12);
my $cent_mult = 100/log(2);

for (my $i=0; $i<8; $i++){
    $ratio[$i]        =~ /(\d+):(\d+)/;
    $mult[$i]         = $1/$2;
    $mult_str[$i]     = sprintf ("%6.4f", $mult[$i]);
    $temper[$i]       = $one_halftone ** $halftones[$i];
    $temper_str[$i]   = sprintf ("%6.4f", $temper[$i]);
    $deviation[$i]    = $temper[$i]/$mult[$i];
    $dev_str[$i]      = sprintf ("%6.4f", $deviation[$i]);
    $dev_cent[$i]     = $cent_mult * log($deviation[$i]);
    $dev_cent_str[$i] = sprintf ("%5.2f", $dev_cent[$i]);

    #print "$degree_nr[$i]";
    #print "\t$ratio[$i]";
    #printf "\t%16f", $mult[$i];
    #print "\t$temper[$i]\n\n";
}

my @table = (\@degree_nr, \@degree_nr_lat, \@interval, \@ratio, \@mult_str, \@halftones, \@temper_str, \@dev_str, \@dev_cent_str);

print "{| class=\"$class\"\n";
if ($label) { print "|+ $label\n";}

print "|-\n!";
my $sep='';
foreach my $col (@columns) {
    print "$sep$col";
    $sep = '!!';
}
print "\n";

for (my $i=0; $i<8; $i++) {  # řádky které tisknu jsou sloupci původní matice
    print "|-\n|";
    my $sep = '';
    for (my $j=0; $j<scalar @table; $j++) {  # sloupce které tisknu jsou prvky původních polí
        print "$sep$table[$j][$i]";
	$sep = '||';
    }
    print "\n";
}

print "|}\n";