Vergessen zu entsorgen ...
Heute stand noch ein bisserl Fräsen, Entgraten, Ab-/Anfeilen und Feinschliff an, justieren, tarieren, honen und tolerierschraubentzieren und andere Kleinigkeiten an.
Letzte Ergebnisse
mmmb-17_123
mmmb-17
mmmb-17_full-house
Und die Ergebnisse davor, chronologisch aufsteigende mmmb-Nummerierung ( bei Interesse bitte selbst nachsehen! )
Hier bloß die Links, unsortiert ( wie Gott sie schuf ):
https://drive.google.com/file/d/1xUf0mSFUEPYt3R4H8iIhQcEE1pqEy7mR/view?usp=sharing
https://drive.google.com/file/d/15jxAEt6pmsHB6JvW6T8hSlCue3ubjlC5/view?usp=sharing
https://drive.google.com/file/d/1NTS-dC4Ncdi_09k7v6mUAIz8_CY2FOHL/view?usp=sharing
https://drive.google.com/file/d/1GXBN3FEjD7i7w4m_cYkNztp5AGgqgjsX/view?usp=sharing
https://drive.google.com/file/d/1GIqpd0kaNYU0PRU5ALx2J5S7N4jR0IFG/view?usp=sharing
https://drive.google.com/file/d/1IGNi4if0nZMY_kX9gN7bqhRy7LQQ0asz/view?usp=sharing
https://drive.google.com/file/d/1LNOF0HaMSpqMguS568PrRK_e1TnXprD7/view?usp=sharing
https://drive.google.com/file/d/1njtqtxzABlnk0XCKXe7LzaRuFjIRReua/view?usp=sharing
https://drive.google.com/file/d/1VSJlbVWVyxiAprqdzSutU5rOkrn6IAGK/view?usp=sharing
https://drive.google.com/file/d/1Kjbq7R1HuKXx7dgdJmLnVCmmmF99kgZ6/view?usp=sharing
https://drive.google.com/file/d/1uWwfcYjj51M40ZGLctRlxEbjBBSFtztw/view?usp=sharing
https://drive.google.com/file/d/13Q5K3R4IpohEl7jHbVHTX8W6-lmeubCb/view?usp=sharing
https://drive.google.com/file/d/1RECFAKJLvs1AeNQOWiIj0DxYkS1kgFi6/view?usp=sharing
https://drive.google.com/file/d/1gblbZ0Alo0CnwwCE3aWNbdLriWeErqIt/view?usp=sharing
https://drive.google.com/file/d/1sC9IV0VBnQsa6bKEwKTsNdMINR83Rj1G/view?usp=sharing
https://drive.google.com/file/d/1jsdyRzusl_PdliGHgw22FClPnky1iSK5/view?usp=sharing
https://drive.google.com/file/d/10n_KpXEE567cRdV06HO1awu-v5W7XP_2/view?usp=sharing
https://drive.google.com/file/d/1WmLEM9XWSuTbZm1OGLl7PQcy_NiGYons/view?usp=sharing
https://drive.google.com/file/d/1XdSyfjWAoldDny0ib0spx5ZQiMqqD1Te/view?usp=sharing
https://drive.google.com/file/d/1dB6TDOcv1PZHCiPU6tMfaO8RvUtJaPyt/view?usp=sharing
https://drive.google.com/file/d/1mhFIslKuChXGL_Vz9sMapp-_bSpmIePd/view?usp=sharing
https://drive.google.com/file/d/1BrbdC26VvwItxfNOquCQIbLdZyPQQqpV/view?usp=sharing
https://drive.google.com/file/d/1SrZJeGw2RM2BE6c1bL-PTpkxCbe03PZB/view?usp=sharing
Ich wäre selbst lieber netter und würde das hier ordentlicher einstellen. Aber ich bin ein wenig überfordert mit dem zeitnahen Xperimentieren und Dokumentieren. Am Ende ist mir das Probieren und Herumcodieren natürlich mehr Herzensangelegenheit, tut mir leid.
Wir nähern uns der Brauchbarkeit, der praktischen Einsatzfähigkeit.
##############################################
Restsperrmüll entdeckt
Hier habe ich noch einen Teil gefunden, der - dem Himmel sei Dank! - dito überflüssig geworden ist ( wie die ganzen anderen Teile, die ich bereits weggeworfen habe ).
Just 4 a little demonstration & 4 fun & 4 laughing & - von mir aus - 4 loving (what- or whoever):
Code-Shit:
# Subroutine progcreate7steps
sub progcreate7steps {
# Meldung
print "Hier bin ich! Die Subroutine progcreate7steps!\n\n";
# Übernahmen
my $grundton_7stp = shift;
my $akkord_7stp = shift;
my $mode_7stp = shift;
my $modenotesstring_7stp = shift;
my $matchchords_7stp_ref = shift;
my @matchchords_7stp = @$matchchords_7stp_ref;
my $modesteps_7stp_ref = shift;
my @modesteps_7stp = @$modesteps_7stp_ref;
my $m1muster = shift;
my $muster_parts_7stp_ref = shift;
my %muster_parts_7stp = %$muster_parts_7stp_ref;
my $muster_parts_rev_7stp_ref = shift;
my %muster_parts_rev_7stp = %$muster_parts_rev_7stp_ref;
# Variablen
my $modenote = $mode_7stp;
$modenote =~ s/^"(.*)"-.*$/$1/;
my %muster_parts_chords_7stp;
my %muster_parts_chords_strings_7stp;
my %sevensteps;
my %sevensteps_addo;
my $wishchordstepval;
my $wishchordstep;
# Programm
print "Die sieben Stufen von $mode_7stp sind die folgenden:\n\n";
print map { $_, "\n" } @modesteps_7stp;
## Hash mit sieben Stufen erstellen ( Hash of Arrays )
foreach my $step ( 1..7 ) {
my $modestepnr = $step-1;
my $intval = $modesteps_7stp[$modestepnr];
if ( not exists $sevensteps{$step} ) {
$sevensteps{$step} = $intval
}
}
foreach my $step ( 1..7 ) {
my $modestepnr = $step-1;
my $intval = $modesteps_7stp[$modestepnr];
if ( not exists $sevensteps_addo{$step} ) {
$sevensteps_addo{$step} = $intval
}
}
## Kontrolldruck + Wunschakkordstufe ermitteln
print "Grundton: $grundton_7stp\n";
print "Chrome Grundton_7stp: $chroma{$grundton_7stp}\n";
print "Mode-Note: $modenote\n";
print "Chrome Mode-Note: $chroma{$modenote}\n";
$wishchordstepval = $chroma{$grundton_7stp} - $chroma{$modenote};
if ( $wishchordstepval < 0 ) { $wishchordstepval = $wishchordstepval + 12 }
print "Wischiwaschi-Cord-Stepp-Wal: $wishchordstepval\n";
foreach ( sort { $a cmp $b } keys %sevensteps ) {
print "Stufe: $_ => Intervall zum Grundton: $sevensteps{$_}\n";
if ( $sevensteps{$_} == $wishchordstepval ) {
$wishchordstep = $_;
}
}
print "\nDer Wunschakkord ist: '$grundton_7stp'-$akkord_7stp\n";
# Wenn der Wunschakkord keiner Stufe zugehört, wird als Ersatz die Stufe '2' gesetzt (experimentell)
if ( not defined $wishchordstep ) {
print "ERROR, ERROR, ERROR!!!\n";
print "Stufe $wishchordstep kommt in $mode_7stp nicht vor. Stufe '2' wird gesetzt!\n";
$wishchordstep = '2';
}
print "\nDie Stufe des Wunschakkords '$grundton_7stp'-$akkord_7stp ist: $wishchordstep!";
print "\n\n";
### Hash of Array erstellen, das alle Akkorde pro Stufe einsammelt
my %stepchords;
my %stepchords_addo;
foreach ( @matchchords_7stp ) {
my $chord_tmp = $_;
print "Akkord: $chord_tmp\n";
my $noteval_tmp = $chord_tmp;
$noteval_tmp =~ s/^"(.*)"-.*$/$1/;
print "Ton: $noteval_tmp\n";
$noteval_tmp = $chroma{$noteval_tmp};
print "Ton in Zahl: $noteval_tmp\n";
# Gesuchter Stufenintervall-Wert
my $intvall_tmp = $noteval_tmp - $chroma{$modenote};
if ( $intvall_tmp < 0 ) { $intvall_tmp = $intvall_tmp + 12 }
print "Gesuchter Stufenintervall-Wert in Zahl: $intvall_tmp\n";
# Aufsplittung in vollständige Akkorde und unvollständige Add-Chords
if ( $chord_tmp =~ m/roq/ || $chord_tmp =~ m/qor/ ) {
if ( not exists $stepchords_addo{$intvall_tmp} ) {
my @arr;
push @arr, $chord_tmp;
$stepchords_addo{$intvall_tmp} = [@arr]
} else {
my $arr_ref = $stepchords_addo{$intvall_tmp};
my @arr = @$arr_ref;
push @arr, $chord_tmp;
$stepchords_addo{$intvall_tmp} = [@arr]
}
} else {
if ( not exists $stepchords{$intvall_tmp} ) {
my @arr;
push @arr, $chord_tmp;
$stepchords{$intvall_tmp} = [@arr]
} else {
my $arr_ref = $stepchords{$intvall_tmp};
my @arr = @$arr_ref;
push @arr, $chord_tmp;
$stepchords{$intvall_tmp} = [@arr]
}
}
}
#### Kontrolldruck + Zuordnung der Akkorde direkt zu den Stufen im Stufenhash
print "\n\n";
print "Alle vollständigen Stufenakkorde, nach Stufe sortiert:\n\n";
foreach ( sort { $a <=> $b } keys %sevensteps ) {
my $stepnr = $_;
print "Stepnummer_ $stepnr\n";
my $stepint = $sevensteps{$stepnr};
print "Intervallschritt: $stepint\n";
my $tmparr_ref = $stepchords{$stepint};
my @tmparr = @$tmparr_ref;
print "\nStufe: $stepnr\n\n";
print map { $_, "\n" } @tmparr;
$sevensteps{$stepnr} = [@tmparr];
}
print "\n\n";
print "\n\n";
print "Alle unvollständigen Addo-Stufenakkorde (falls sie existieren), nach Stufe sortiert:\n\n";
if ( scalar keys %sevensteps_addo > 0 && scalar keys %stepchords_addo > 0 ) {
print "Addo-Sevensteps-Hash ist ", scalar keys %sevensteps_addo, " groß!\n";
print "Addo-Sevenchords-Hash ist ", scalar keys %stepchords_addo, " groß!\n";
foreach ( sort { $a <=> $b } keys %sevensteps_addo ) {
my $stepnr = $_;
my $stepint = $sevensteps_addo{$stepnr};
my $tmparr_ref = $stepchords_addo{$stepint};
my @tmparr = @$tmparr_ref;
print "\nStufe: $stepnr\n\n";
print map { $_, "\n" } @tmparr;
$sevensteps_addo{$stepnr} = [@tmparr];
}
print "\n\n";
}
# sleep 4;
## Wie lässt sich das vorgegebene Muster sinnvoll mit Stufenakkorden füllen?
print "Vorgegebenes Muster ist: $m1muster!\n\n";
# sleep 4;
## Schleife, bis alle Variablen des M1-Musters belegt sind
my @m1musterparts = split ( "", $m1muster );
my %mparts_filled = %muster_parts_7stp;
my %stepsingularity;
my $firstletter = '-';
my $ok = 'KO';
### Vorprüfung vor Schleifeneintritt
#### Enthält das M1-Muster den Teil 'a' onda 'A'?
#### Wenn ja, dann Standard-, wenn nein, dann Sonderbehandlung
if ( $m1muster !~ m/[aA]/ ) {
foreach ( sort { $a cmp $b } keys %muster_parts_7stp ) {
# Der alphabetisch erste Buchstabe wird genommen, egal ob klein oder groß geschrieben
if ( $firstletter eq '-' ) { $firstletter = $_ }
}
foreach ( keys %mparts_filled ) {
if ( $_ eq $firstletter || $_ eq uc $firstletter || $_ eq lc $firstletter ) {
$mparts_filled{$_} = $wishchordstep;
} else {
$mparts_filled{$_} = '-'
}
}
} else {
$firstletter = 'A';
foreach ( keys %mparts_filled ) {
# Klein- und Groß-A sollen identisch sein
if ( $_ =~ m/[aA]/ ) {
$mparts_filled{$_} = $wishchordstep;
} else {
$mparts_filled{$_} = '-'
}
}
}
until ( $ok eq 'OK' ) {
print "Die bisher ermittelten Musterteile:\n\n";
foreach ( keys %mparts_filled ) {
print "Teil: $_ ====> ", $mparts_filled{$_}, "\n";
}
print "\n\n";
# Welcher Buchstabe soll als Nächstes ermittelt werden?
## Die noch unbekannten Teile
## Die schon bekannten Teile
my %unknownyet;
my %yetknown;
foreach my $nr ( 1..(scalar @m1musterparts) ) {
my $part = $m1musterparts[($nr-1)];
print "Nr.: $nr ===> Teil: $part\n";
if ( $mparts_filled{$part} eq '-' ) {
$unknownyet{$part.$nr} = '-';
} else {
$yetknown{$part.$nr} = '!';
}
}
print "\n\n";
print "Folgende Teile sind noch unbekannt:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %unknownyet;
print "\n\n";
print "Folgende Teile sind bereits bekannt:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %yetknown;
print "\n\n";
## Die bekannten Teile sollen um die ausgedünnt werden, die keine unbekannten in Nachbarschaft haben
my %yetknown_new = %yetknown;
foreach my $nr ( 1..(scalar @m1musterparts) ) {
my $part = $m1musterparts[($nr-1)];
if ( $nr == 1 && (scalar @m1musterparts) > 2 ) {
my $part_next = $m1musterparts[$nr];
if ( exists $yetknown{$part.$nr} && exists $yetknown{$part_next.($nr+1)} ) {
delete $yetknown_new{$part.$nr};
print "1 - Lösche Teil $part mit der Nummer: ", $nr, "!\n";
}
} elsif ( $nr < ((scalar @m1musterparts)-1) ) {
my $part_before = $m1musterparts[$nr-2];
my $part_next = $m1musterparts[$nr];
if ( exists $yetknown{$part.$nr} && exists $yetknown{$part_next.($nr+1)} && exists $yetknown{$part_before.($nr-1)} ) {
delete $yetknown_new{$part.$nr};
print "2 - Lösche Teil $part mit der Nummer: ", $nr, "!\n";
}
} elsif ( $nr == ((scalar @m1musterparts)-1) ) {
my $part_before = $m1musterparts[$nr-2];
my $part_next = $m1musterparts[$nr];
if ( exists $yetknown{$part.$nr} && exists $yetknown{$part_next.($nr+1)} && exists $yetknown{$part_before.($nr-1)} ) {
delete $yetknown_new{$part.$nr};
print "3 - Lösche Teil $part mit der Nummer: ", $nr, "!\n";
} elsif ( exists $yetknown{$part.$nr} && exists $yetknown{$part_next.($nr+1)} && not exists $yetknown{$part_before.($nr-1)} ) {
delete $yetknown_new{$part_next.($nr+1)};
print "4 - Lösche Teil $part_next mit der Nummer: ", $nr+1, "!\n";
}
}
}
print "Folgende Teile sind bekannt und haben noch unbekannte Nachbarn:\n\n";
print map { $_, "\n" } sort { $a cmp $b } keys %yetknown_new;
print "\n\n";
## Es wird eins der bekannten Teile per Zufall für weitere Untersuchungen ausgelost
my @yetknown;
map { push @yetknown, $_ } keys %yetknown_new;
my $los = int rand ( @yetknown );
my $ausgelost = $yetknown[$los];
my $ausgelost_onr = $ausgelost;
$ausgelost_onr =~ s/[0-9]+//;
my $ausgelost_step = $mparts_filled{$ausgelost_onr};
print "Es wird die Umgebung des bereits bekannten Teils $ausgelost untersucht!\n";
print "Der bekannte Teil $ausgelost ist auf der Stufe $ausgelost_step!\n";
my $vorausgelost;
my $nachausgelost;
foreach my $nr ( 1..(scalar @m1musterparts) ) {
my $part = $m1musterparts[($nr-1)];
# print "Nr.: $nr ===> Teil: $part\n";
if ( $part.$nr eq $ausgelost ) {
# Bei mehrfachem Vorkommen bereits belegter Parts muß entschieden werden, welche ausgelost werden
if ( defined $vorausgelost ) {
# Münzwurf, ob es dabei bleibt oder ob das zweite, dritte, ... Vorkommen die Variablen neu belegen darf
my $coin = int rand (2);
if ( $coin == 0 ) { next }
}
if ( $nr > 1 && $nr < (scalar @m1musterparts) ) {
$vorausgelost = $m1musterparts[($nr-2)];
$nachausgelost = $m1musterparts[($nr)];
} elsif ( $nr > 1 && $nr == (scalar @m1musterparts) ) {
$vorausgelost = $m1musterparts[($nr-2)];
$nachausgelost = '-';
} elsif ( $nr == 1 && $nr < (scalar @m1musterparts) ) {
$vorausgelost = '-';
$nachausgelost = $m1musterparts[($nr)];
}
}
}
print "Der Teil vor dem ausgelosten bekannten Teil $ausgelost ist: $vorausgelost!\n";
print "Der Teil nach dem ausgelosten bekannten Teil $ausgelost ist: $nachausgelost!\n";
### Welcher Teil soll als Nächstes ermittelt werden?
my $eruier;
my $eruier_sub;
my $eruier_step;
if ( $vorausgelost ne '-' && $nachausgelost ne '-' && $ausgelost ne $vorausgelost && $ausgelost ne $nachausgelost ) {
my $coin = int rand (2);
if ( $coin == 0 ) { $eruier = $vorausgelost; $eruier_sub = 'vor' }
elsif ( $coin == 1 ) { $eruier = $nachausgelost; $eruier_sub = 'nach' }
} elsif ( $vorausgelost eq '-' && $ausgelost ne $nachausgelost ) {
$eruier = $nachausgelost;
$eruier_sub = 'nach';
} elsif ( $nachausgelost eq '-' && $ausgelost ne $vorausgelost ) {
$eruier = $vorausgelost;
$eruier_sub = 'vor';
} else {
print "Fehler im System! Houston, wir haben ein Problem!\n";
# sleep 11;
}
print "Versuchen wir mal $eruier zu ermitteln, ja?\n\n";
### Subroutinenaufruf zur Ermittlung abhängig von der Position vor oder nach dem bekannten Teil
if ( $eruier_sub eq 'vor' ) {
print "Die Stufe davor ist: $ausgelost_step\n";
$eruier_step = eruier7step_vor($ausgelost_step)
} elsif ( $eruier_sub eq 'nach' ) {
print "Die Stufe danach ist: $ausgelost_step\n";
$eruier_step = eruier7step_nach($ausgelost_step)
}
#### Ausdruck
print "Dringend ans Herz gelegte Stufe für $eruier ist: $eruier_step\n";
print "Wir fragen mal, ob wir den Vorschlag übernehmen dürfen.\n";
#### Hier sollte demnächst ein Gegencheck stattfinden, ob die Stufe schon vergeben ist
# ...
### Übergabe des Ermittlungsergebnisses
#### $eruier soll in Klein- und Großschreibung der gleiche Akkord/die gleiche Stufe sein
my $eruier_counterpart;
if ( $eruier eq lc $eruier ) {
$eruier_counterpart = uc $eruier
} else { $eruier_counterpart = lc $eruier }
if ( exists $mparts_filled{$eruier} && $mparts_filled{$eruier} eq '-' ) {
$mparts_filled{$eruier} = $eruier_step;
}
if ( exists $mparts_filled{$eruier_counterpart} && $mparts_filled{$eruier_counterpart} eq '-' ) {
$mparts_filled{$eruier_counterpart} = $eruier_step;
}
# Check, ob nach diesem Durchlauf alles ermittelt ist
$ok = 'OK';
print "Die bis hierher ermittelten Musterteile:\n\n";
foreach ( keys %mparts_filled ) {
print "Teil: $_ ====> ", $mparts_filled{$_}, "\n";
if ( $mparts_filled{$_} eq '-' ) { $ok = 'KO' }
}
print "\n\n";
# sleep 2;
}
# Akkorde werden gemäß der ermittelten Stufenangaben ausgelost
## Aufsplittung vollständige Akkorde (%mparts_filled) und unvollständige Add-Chords (%mparts_filled_addo)
my %mparts_filled_addo = %mparts_filled;
foreach ( keys %mparts_filled ) {
my $step_tmp = $mparts_filled{$_};
if ( $step_tmp !~ m/[0-9]{1}/ ) { next }
print "Die aktuelle Stufe für die Akkordauslosung: $step_tmp\n";
my $lostopf_ref = $sevensteps{$step_tmp};
my @lostopf = @$lostopf_ref;
my $los = int rand ( @lostopf );
my $win = $lostopf[$los];
$mparts_filled{$_} = $win;
}
foreach ( keys %mparts_filled ) {
print "Part $_ ist: ", $mparts_filled{$_}, "\n";
}
foreach ( keys %mparts_filled_addo ) {
my $step_tmp = $mparts_filled_addo{$_};
# Der Wunschakkord bleibt unverändert (experimentell)
if ( $step_tmp !~ m/[0-9]{1}/ ) { next }
print "Die aktuelle Stufe für die Akkordauslosung: $step_tmp\n";
my $lostopf_ref = $sevensteps_addo{$step_tmp};
my @lostopf = @$lostopf_ref;
my $los = int rand ( @lostopf );
my $win = $lostopf[$los];
$mparts_filled_addo{$_} = $win;
}
foreach ( keys %mparts_filled_addo ) {
print "Part Addo $_ ist: ", $mparts_filled_addo{$_}, "\n";
}
# sleep 5;
## Muster-Akkorde übertragen & -Strings & Notenlängen ermitteln
print "\nMeine \%muster_parts_7stp:\n\n";
print map { $_, " ==> ", $muster_parts_7stp{$_}, "\n" } keys %muster_parts_7stp;
### Für Addo-Akkorde
my %muster_parts_chords_addo_7stp;
my %muster_parts_chords_strings_addo_7stp;
foreach ( keys %muster_parts_7stp ) {
my $chord = $mparts_filled{$_};
my $chord_addo = $mparts_filled_addo{$_};
my $z = $muster_parts_7stp{$_};
print "Mein Akkord: $chord\n";
print "Mein Addo-Akkord: $chord_addo\n";
print "Die Siebenstufen-Akkorde:\n";
print map { $_, "\n" } keys %stepchords;
# Münzwurf, ob sich der Akkord ändern soll
my $chordchangecoin = int rand (2);
my $chord_changed;
if ( $chordchangecoin == 0 ) {
$chord_changed = chord_7stp_change($modenote,$chord,\%stepchords,\%sevensteps);
print "Mein geänderter Akkord (falls geändert): $chord_changed\n";
$chord = $chord_changed;
} else {
print "Akkord wurde nicht geändert: $chord\n";
}
# sleep 11;
## Modus per Zufall ändern
my ($mode_7stp_changed,$chord_addo_changed) = mode_7stp_change($chord,$chord_addo,$mode_7stp);
$chord_addo = $chord_addo_changed;
print "Hauptmodus: $mode_7stp\n";
print "Geänderter Modus: $mode_7stp_changed\n";
### Modustonstring ändern
my ($modenotesstring_7stp_changed,$chord_changed) = $modenotesstrings{$mode_7stp_changed};
print "Geänderter Modustonstring: $modenotesstring_7stp_changed\n";
# sleep 4;
$muster_parts_chords_7stp{$chord} = $z;
$muster_parts_chords_addo_7stp{$chord_addo} = $z;
my $string = chordnotes($chord);
my $string_addo = chordnotes($chord_addo);
print "Mein String: $string\n";
print "Mein String: $string_addo\n";
my $chord_string = $chord.' : '.$string;
my $chord_string_addo = $chord_addo.' : '.$string_addo;
print "Mein Akkord + String: $chord_string\n";
print "Mein Addo-Akkord + -String: $chord_string_addo\n";
# Notenwert WHOLE bzw. HALF wird per Zufall gesetzt
my $notevalue_value = (int rand ((scalar keys %notevalue) - 1)) + 1;
my $notevalue = $notevalue{$notevalue_value};
my $chord_string_value = $chord_string.' : '.$notevalue;
my $chord_string_addo_value = $chord_string_addo.' : '.$notevalue;
print "Mein Akkord + String + Wert: $chord_string_value\n";
print "Mein Addo-Akkord + -String + -Wert: $chord_string_addo_value\n";
# sleep 11;
# Modus zum String hinzufügen
$chord_string_value = $chord_string_value.' : '.$mode_7stp_changed;
$chord_string_addo_value = $chord_string_addo_value.' : '.$mode_7stp_changed;
# Modus-Töne-String zum String hinzufügen
$chord_string_value = $chord_string_value.' : '.$modenotesstring_7stp_changed;
$chord_string_addo_value = $chord_string_addo_value.' : '.$modenotesstring_7stp_changed;
# Part ermitteln und dem String hinzufügen
my $part = $muster_parts_rev_7stp{$z};
$muster_parts_chords_strings_7stp{$part} = $chord_string_value.' : M1-'.$part;
$muster_parts_chords_strings_addo_7stp{$part} = $chord_string_addo_value.' : M1-'.$part;
}
# sleep 2;
# Übergabe
return (\%muster_parts_chords_7stp,\%muster_parts_chords_strings_7stp,\%muster_parts_chords_addo_7stp,\%muster_parts_chords_strings_addo_7stp);
}
# Subroutine progcreateXsteps ( x = 8..12 )
sub progcreatexsteps {
# Meldung
print "Hier bin ich! Die Subroutine progcreate7steps!\n\n";
# Übernahmen
my $grundton_7stp = shift;
my $akkord_7stp = shift;
my $mode_7stp = shift;
my $modenotesstring_7stp = shift;
my $matchchords_7stp_ref = shift;
my @matchchords_7stp = @$matchchords_7stp_ref;
my $modesteps_7stp_ref = shift;
my @modesteps_7stp = @$modesteps_7stp_ref;
my $m1muster = shift;
my $muster_parts_7stp_ref = shift;
my %muster_parts_7stp = %$muster_parts_7stp_ref;
my $muster_parts_rev_7stp_ref = shift;
my %muster_parts_rev_7stp = %$muster_parts_rev_7stp_ref;
# Programm
my %muster_parts_chords_7stp;
my %muster_parts_chords_strings_7stp;
## Muster-Akkorde & -Strings & Notenlängen ermitteln
my $muster_parts_count = scalar keys %muster_parts_7stp;
for ( my $z = 0; $z < $muster_parts_count; $z++ ) {
my $chord;
# Erster Akkord ist gewählter Akkord
if ( $z == 0 ) {
$chord = '"'.$grundton_7stp.'"-'.$akkord_7stp;
} else {
# Akkord per Zufall auswählen
my $matchchord_choice_no = int rand(scalar @matchchords_7stp);
$chord = $matchchords_7stp[$matchchord_choice_no];
}
print "Mein Akkord: $chord\n";
if ( not exists $muster_parts_chords_7stp{$chord} ) {
$muster_parts_chords_7stp{$chord} = $z;
my $string = chordnotes($chord);
print "Mein String: $string\n";
my $chord_string = $chord.' : '.$string;
print "Mein Akkord + String: $chord_string\n";
# Notenwert WHOLE bzw. HALF wird per Zufall gesetzt
my $notevalue_value = (int rand ((scalar keys %notevalue) - 1)) + 1;
my $notevalue = $notevalue{$notevalue_value};
my $chord_string_value = $chord_string.' : '.$notevalue;
print "Mein Akkord + String + Wert: $chord_string_value\n";
# sleep 11;
# Modus zum String hinzufügen
$chord_string_value = $chord_string_value.' : '.$mode_7stp;
# Modus-Töne-String zum String hinzufügen
$chord_string_value = $chord_string_value.' : '.$modenotesstring_7stp;
# Part ermitteln und dem String hinzufügen
my $part = $muster_parts_rev_7stp{$z};
$muster_parts_chords_strings_7stp{$part} = $chord_string_value.' : M1-'.$part;
} else { $z-- }
}
# Übergabe
return (\%muster_parts_chords_7stp,\%muster_parts_chords_strings_7stp);
}
# Subroutine eruier7step_vor
sub eruier7step_vor {
# Meldung
print "Hier ist die Subroutine eruier7step_vor!\nGuten Tach!!!\n\n";
# Übernahme
my $step_after = shift;
# Variablen
my %prestep = ( '1' => '5',
'2' => '6',
'3' => '7',
'4' => '1',
'5' => '2',
'6' => '3',
'7' => '4' );
# Programm
my $step_vor = $prestep{$step_after};
# Übergabe
return $step_vor;
}
# Subroutine eruier7step_nach
sub eruier7step_nach {
# Meldung
print "Hier ist die Subroutine eruier7step_nach!\nGuten Tach!!!\n\n";
# Übernahme
my $step_before = shift;
# Variablen
my %afterstep = ( '1' => '4',
'2' => '5',
'3' => '6',
'4' => '7',
'5' => '1',
'6' => '2',
'7' => '3' );
# Programm
my $step_nach = $afterstep{$step_before};
# Übergabe
return $step_nach;
}
# Subroutine mode_7stp_change
sub mode_7stp_change {
# Meldung
print "\nHier ist die Subroutine mode_7stp_change!\n";
# Übernahmen
my $chord_2_see = shift;
my $chord_addo_2_see = shift;
my $mode_7stp_2change = shift;
print "Chord_2_see: $chord_2_see\n";
if ( $chord_addo_2_see eq '' ) {
print "Chord_addo_2_see ist derselbe wie Chord_2_see: $chord_2_see\n";
$chord_addo_2_see = $chord_2_see;
sleep 5;
} else { print "Chord_addo_2_see: $chord_addo_2_see\n" }
print "Modus 7-stp: $mode_7stp_2change\n";
# Herausfinden, welche Modi sonst noch gehen
# Grundton-Wert des Akkord ermitteln
my $grundton_7stp_change_first = $chord_2_see;
$grundton_7stp_change_first =~ s/^"([ABCDEFG]-*)"-.*$/$1/;
my $grundton_7stp_change_first_value = $chroma{$grundton_7stp_change_first};
# Akkordtyp des Akkords ermitteln
my $chord_7stp_change_first_type = $chord_2_see;
$chord_7stp_change_first_type =~ s/^"[ABCDEFG]-*"-(.*)$/$1/;
my $durmoll = $chord_7stp_change_first_type;
$durmoll =~ s/.*Dur.*/Dur/;
$durmoll =~ s/.*Moll.*/Moll/;
# Grundton-Wert des Addo-Akkord ermitteln
my $grundton_addo_7stp_change_first = $chord_addo_2_see;
$grundton_addo_7stp_change_first =~ s/^"([ABCDEFG]-*)"-.*$/$1/;
my $grundton_addo_7stp_change_first_value = $chroma{$grundton_addo_7stp_change_first};
# Akkordtyp des Addo-Akkords ermitteln
my $chord_addo_7stp_change_first_type = $chord_addo_2_see;
$chord_addo_7stp_change_first_type =~ s/^"[ABCDEFG]-*"-(.*)$/$1/;
my $durmoll_addo = $chord_addo_7stp_change_first_type;
$durmoll_addo =~ s/.*Dur.*/Dur/;
$durmoll_addo =~ s/.*Moll.*/Moll/;
# Übergaben an die Subroutine modes_strings & Rückgabenentgegennahmen
my ($matchmodes_7stp_change_ref,$notesstring_7stp_change_ref);
my @matchmodes_7stp_change;
my ($matchmodes_addo_7stp_change_ref,$notesstring_addo_7stp_change_ref);
my @matchmodes_addo_7stp_change;
if ( $durmoll eq $durmoll_addo ) {
($matchmodes_7stp_change_ref,$notesstring_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_7stp_change_first_type);
@matchmodes_7stp_change = @$matchmodes_7stp_change_ref;
# Bei der Ermittlung der Addo-Chords wird der Grundton des Nicht-Addo-Akkords verwendet,
# da dieser ohnehin gleich ist, solange kein Akkordwechsel stattgefunden hat
($matchmodes_addo_7stp_change_ref,$notesstring_addo_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_addo_7stp_change_first_type);
@matchmodes_addo_7stp_change = @$matchmodes_addo_7stp_change_ref;
} elsif ( $chord_7stp_change_first_type !~ m/sus/ && $chord_7stp_change_first_type !~ m/dim/ ) {
if ( $chord_addo_7stp_change_first_type =~ m/Moll7/ && $durmoll eq 'Dur' ) {
$chord_addo_7stp_change_first_type =~ s/Moll7/DurMaj7/;
} elsif ( $chord_addo_7stp_change_first_type =~ m/DurMaj7/ && $durmoll eq 'Moll' ) {
$chord_addo_7stp_change_first_type =~ s/DurMaj7/Moll7/;
}
($matchmodes_7stp_change_ref,$notesstring_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_7stp_change_first_type);
@matchmodes_7stp_change = @$matchmodes_7stp_change_ref;
# Bei der Ermittlung der Addo-Chords wird der Grundton des Nicht-Addo-Akkords verwendet,
# da dieser ohnehin gleich ist, solange kein Akkordwechsel stattgefunden hat
($matchmodes_addo_7stp_change_ref,$notesstring_addo_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_addo_7stp_change_first_type);
@matchmodes_addo_7stp_change = @$matchmodes_addo_7stp_change_ref;
} else {
print "Ich hab' eine Ahnung, was ich damit ($chord_7stp_change_first_type,$chord_addo_7stp_change_first_type) anfangen soll!\n";
($matchmodes_7stp_change_ref,$notesstring_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_7stp_change_first_type);
@matchmodes_7stp_change = @$matchmodes_7stp_change_ref;
# Bei der Ermittlung der Addo-Chords wird der Grundton des Nicht-Addo-Akkords verwendet,
# da dieser ohnehin gleich ist, solange kein Akkordwechsel stattgefunden hat
($matchmodes_addo_7stp_change_ref,$notesstring_addo_7stp_change_ref) = modes_strings($grundton_7stp_change_first_value,$chord_7stp_change_first_type);
@matchmodes_addo_7stp_change = @$matchmodes_addo_7stp_change_ref;
sleep 4;
}
# Schnittmenge bilden
my %schnittmenge;
foreach ( @matchmodes_7stp_change ) {
if ( not exists $schnittmenge{$_} ) {
$schnittmenge{$_} = 1
} else { $schnittmenge{$_} = $schnittmenge{$_} + 1 }
}
my @matchmodes_7stp_change_schnitt;
foreach ( keys %schnittmenge ) {
if ( $schnittmenge{$_} >= 2 ) {
push @matchmodes_7stp_change_schnitt, $_;
}
}
# Einen Modus per Zufall auswählen (evtl. denselben - egal!)
my $modus_7stp_change_changed;
if ( scalar @matchmodes_7stp_change_schnitt == 0 ) {
print "Es gibt leider keine Schnittmenge!\n";
$chord_addo_2_see = $chord_2_see;
my $los = int rand ( @matchmodes_7stp_change_schnitt );
$modus_7stp_change_changed = $matchmodes_7stp_change[$los];
} else {
print "Die Modi, die hier auch passen:\n\n";
print map { $_, "\n" } @matchmodes_7stp_change_schnitt;
print "\n\n";
my $los = int rand ( @matchmodes_7stp_change_schnitt );
$modus_7stp_change_changed = $matchmodes_7stp_change_schnitt[$los];
}
# Übergabe
return ($modus_7stp_change_changed,$chord_addo_2_see);
}
# Subroutine chord_7stp_change
sub chord_7stp_change {
# Meldung
print "\nHier ist die Subroutine chord_7stp_change!\n";
# Übernahme
my $modenote_chord_7stp_change = shift;
my $chord_7stp_2_change = shift;
my $stepchords_chord_7stp_change_ref = shift;
my %stepchords_chord_7stp_change = %$stepchords_chord_7stp_change_ref;
my $sevensteps_chord_7stp_change_ref = shift;
my %sevensteps_chord_7stp_change = %$sevensteps_chord_7stp_change_ref;
# Programm
my $chord_7stp_changed;
my $grundton_7stp_change = $chord_7stp_2_change;
$grundton_7stp_change =~ s/^"(.*)"-.*$/$1/;
my $wishchordstep_7stp_change;
print "Die sieben Stufen:\n\n";
foreach ( keys %sevensteps_chord_7stp_change ) {
print $_, " : ", $sevensteps_chord_7stp_change{$_}, "\n";
}
print "\n";
print "Die Akkorde zu den sieben Stufen:\n\n";
foreach ( keys %stepchords_chord_7stp_change ) {
print $_, " : ", $stepchords_chord_7stp_change{$_}, "\n";
}
print "\n";
# Die Stufenwerte ermitteln
my %sevenstepvals;
my $step_tmp = 0;
foreach ( sort { $a <=> $b } keys %stepchords_chord_7stp_change ) {
my $stepval_tmp = $_;
$step_tmp++;
if ( not exists $sevenstepvals{$step_tmp} ) {
$sevenstepvals{$step_tmp} = $stepval_tmp
} else { next }
}
print "Die Siebenstufen-Werte:\n\n";
print map { $_, " ==> ", $sevenstepvals{$_}, "\n" } sort { $a <=> $b } keys %sevenstepvals;
print "\n";
my %sevenstepvals_inv;
foreach ( keys %sevenstepvals ) {
my $tmpstep = $_;
my $tmpval = $sevenstepvals{$tmpstep};
$sevenstepvals_inv{$tmpval} = $tmpstep;
}
print "Die Siebenstufen-Werte, invertiert:\n\n";
print map { $_, " ==> ", $sevenstepvals_inv{$_}, "\n" } sort { $a <=> $b } keys %sevenstepvals_inv;
print "\n";
# sleep 11;
## Herausfinden der Stufe des zu ändernden Akkords + Addo-Akkords
print "Grundton: $grundton_7stp_change\n";
print "Chrome Grundton_7stp: $chroma{$grundton_7stp_change}\n";
my $wishchordstepval_7stp_change = $chroma{$grundton_7stp_change} - $chroma{$modenote_chord_7stp_change};
if ( $wishchordstepval_7stp_change < 0 ) { $wishchordstepval_7stp_change = $wishchordstepval_7stp_change + 12 }
print "Wischiwaschi-Cord-Stepp-Wal: $wishchordstepval_7stp_change\n";
my $step_chord_2_change = $sevenstepvals_inv{$wishchordstepval_7stp_change};
print "\nDie Stufe des zu ändernden Akkords $chord_7stp_2_change ist: $step_chord_2_change!";
print "\n\n";
# sleep 11;
# Entscheidung, ob Tritonus-Substitution oder Terzersetzung
if ( $chord_7stp_2_change =~ m/Dur7b5/ ) {
$chord_7stp_changed = tritonus_1($chord_7stp_2_change);
} elsif ( $chord_7stp_2_change =~ m/Dur7#5/ ) {
$chord_7stp_changed = tritonus_2($chord_7stp_2_change);
} else {
## Array mit Auswahl für Änderung bilden
my $coin_3_change = int rand (2);
if ( $coin_3_change == 0 ) {
### Array, was Terztausch ermöglicht
my $step_3_alt;
my @altstep3;
if ( $step_chord_2_change == 1 ) {
my $stepcoin = int rand (2);
if ( $stepcoin == 0 ) {
$step_3_alt = 3;
} elsif ( $stepcoin == 1 ) {
$step_3_alt = 6;
}
} elsif ( $step_chord_2_change == 2 ) {
$step_3_alt = 4;
} elsif ( $step_chord_2_change == 3 ) {
$step_3_alt = 5;
} elsif ( $step_chord_2_change == 4 ) {
$step_3_alt = 2;
} elsif ( $step_chord_2_change == 5 ) {
$step_3_alt = 7;
} elsif ( $step_chord_2_change == 6 ) {
$step_3_alt = 1;
} elsif ( $step_chord_2_change == 7 ) {
$step_3_alt = 5;
}
my $altstep3_ref = $sevensteps_chord_7stp_change{$step_3_alt};
@altstep3 = @$altstep3_ref;
### Akkord aus dem Array auswählen
my $altstep3_choice = int rand ( scalar @altstep3 );
$chord_7stp_changed = $altstep3[$altstep3_choice];
} elsif ( $coin_3_change == 1 ) {
### Dur-Moll-Tausch
$chord_7stp_changed = $chord_7stp_2_change;
if ( $chord_7stp_2_change =~ m/Dur/ ) {
$chord_7stp_changed =~ s/Dur/Moll/
} elsif ( $chord_7stp_2_change =~ m/Moll/ ) {
$chord_7stp_changed =~ s/Moll/Dur/
}
}
}
# Rückgabe
return ($chord_7stp_changed);
}
# Subroutine tritonus_1
sub tritonus_1 {
# Meldung
print "\nHier ist die Subroutine tritonus_1!\n";
# Übernahme
my $chord_2_tritonus = shift;
print "Der Akkord für die Tritonus-Substitution ist: $chord_2_tritonus\n";
sleep 11;
# Umwandlungs-Hash
my %tritontrans = ( '"C"-Dur7b5' => '"G-"-Dur7b5',
'"D-"-Dur7b5' => '"G"-Dur7b5',
'"D"-Dur7b5' => '"A-"-Dur7b5',
'"E-"-Dur7b5' => '"A"-Dur7b5',
'"E"-Dur7b5' => '"B-"-Dur7b5',
'"F"-Dur7b5' => '"B"-Dur7b5',
'"G-"-Dur7b5' => '"C"-Dur7b5',
'"G"-Dur7b5' => '"D-"-Dur7b5',
'"A-"-Dur7b5' => '"D"-Dur7b5',
'"A"-Dur7b5' => '"E-"-Dur7b5',
'"B-"-Dur7b5' => '"E"-Dur7b5',
'"B"-Dur7b5' => '"F"-Dur7b5' );
# Umgewandelter
my $chord_tritonustransformed = $tritontrans{$chord_2_tritonus};
# Rückgabe
return $chord_tritonustransformed;
}
# Subroutine tritonus_2
sub tritonus_2 {
# Meldung
print "\nHier ist die Subroutine tritonus_2!\n";
# Übernahme
my $chord_2_tritonus = shift;
print "Der Akkord für die Tritonus-Substitution ist: $chord_2_tritonus\n";
sleep 11;
# Umwandlungs-Hash
my %tritontrans = ( '"C"-Dur7#5' => '"G-"-Dur7addb9qor',
'"D-"-Dur7#5' => '"G"-Dur7addb9qor',
'"D"-Dur7#5' => '"A-"-Dur7addb9qor',
'"E-"-Dur7#5' => '"A"-Dur7addb9qor',
'"E"-Dur7#5' => '"B-"-Dur7addb9qor',
'"F"-Dur7#5' => '"B"-Dur7addb9qor',
'"G-"-Dur7#5' => '"C"-Dur7addb9qor',
'"G"-Dur7#5' => '"D-"-Dur7addb9qor',
'"A-"-Dur7#5' => '"D"-Dur7addb9qor',
'"A"-Dur7#5' => '"E-"-Dur7addb9qor',
'"B-"-Dur7#5' => '"E"-Dur7addb9qor',
'"B"-Dur7#5' => '"F"-Dur7addb9qor' );
# Umgewandelter
my $chord_tritonustransformed = $tritontrans{$chord_2_tritonus};
# Rückgabe
return $chord_tritonustransformed;
}
Kommentare
Kommentar veröffentlichen