Ein bisschen mehr, ein bisschen weniger
Neuer Stand meines Autocomposer-Projekts
Ein bisschen mehr Mensch, ein bisschen weniger Automatik.
Ein bisschen mehr Einzelproggi, ein bisschen weniger Code.
Ein bisschen viel mehr Geschwindigkeit, ein bisschen viel weniger Fehler.
Es läuft sich jetzt ein bisschen leichter auf dem Mond, dank meinen neuen Moonboots. Bei den letzten Xpeditionen ist es außerdem wohl versehentlich zum Austreten einzelner, kleiner Schwerkraftzentren aus den schlampig verschlossenen Reagenzgläsern und -fässern gekommen - weshalb es teilweise zu Quer- & Überkopfstieg bei den manuellen Bildnahmen der entstehenden Kleinwelttonostope kam, die mangels korrekter Verortungsfähigkeiten für verzerrte Abbilder der konstruierten Realitäten verständlicherweise führen mussten. Kurz gesagt: Die Forschungsergebnisse der letzten Wochen lassen sich guten Gewissens eigentlich alle in die Tonne treten. Am Ende dieser Protokollnotiz seien die letzten, und davon die noch brauchbarsten Extrakte zur Probehörung verlinkt.
Ab heute ist aber wieder besser.
Die ersten Outputte
Gleiche Akkordprogression + gleiche Basismischung + gleiche Rhythmisierung + verschiedene Instrumentierung
Beiden Produkten liegt die folgende Basismischung zugrunde:
Teil: A => Akkord: CDurMaj7, Modus: "D"-Dorisch
Teil: E => Akkord: DDur7, Modus: "G-"-Vermindert
Teil: C => Akkord: FDurMaj7, Modus: "D"-Dorisch
Teil: B => Akkord: CDur7, Modus: "G"-Vermindert
Teil: D => Akkord: GDur7, Modus: "D"-Dorisch
Gleiche Akkordprogression + veränderte Basismischung ( gegenüber den letzten zwei Beispielen ) + verschiedene Rhythmisierung + gleiche Instrumentierung
Teil: A => Akkord: CDurMaj7, Modus: "C"-Ionisch
Teil: E => Akkord: DDur7, Modus: "D"-Mixolydisch
Teil: C => Akkord: FDurMaj7, Modus: "F"-Ionisch
Teil: B => Akkord: CDur7, Modus: "C"-Mixolydisch
Teil: D => Akkord: GDur7, Modus: "B"-Vermindert
Gleiche Akkordprogression + veränderte Basismischung ( gegenüber den letzten vier Beispielen ) + verschiedene Rhythmisierung + zufällige Instrumentierung
Teil: C => Akkord: FDurMaj7, Modus: "E"-Messiaenacht
Teil: B => Akkord: CDur7, Modus: "D"-Aeolisch
Teil: A => Akkord: CDurMaj7, Modus: "E"-Mollharmonisch
Teil: D => Akkord: GDur7, Modus: "F"-Vermindert
Teil: E => Akkord: DDur7, Modus: "A-"-Alteriert
( absichtlich gedankenlos **** zusammengestellt )
.....................................................................................................................
Tja, und wie harmonisiert fim das am Vernünftigsten? Hier muß ich schmerzvoll (nuja, geht so) merken, wie wenig Solidebelastbares ich immer noch weiß. Wär's so (konventionell) korrekt (?) :
Teil: A => Akkord: CDurMaj7, Modus: "C"-Ionisch
Teil: D => Akkord: GDur7, Modus: "G"-Mixolydisch
Teil: E => Akkord: DDur7, Modus: "D"-Mixolydisch
Teil: B => Akkord: CDur7, Modus: "C"-Mixolydisch
Teil: C => Akkord: FDurMaj7, Modus: "C"-Ionisch
( Vergewisserung - wg. Dummblödheit - mir mal kurz von hier geholt: http://www.gitarrengriffe-online.de/gitarren_skalen_tonleiter.php
Eigentlich müsste ich das ja schon sicher(er) wissen können. )
Garbage
Aus dem Schrotthaufen der letzten Wochen, die noch hübschesten Müllhäuflein, von ganz oben genommen:
Fazit:
Es lässt sich nicht behaupten, daß weniger meistens mehr sei. Aber zuviel ***** ist meistens weniger gut, und fast immer zuviel. Wirklich immer ist allerdings nur immer selbst. */**
Kurze Nachbemerkung:
Beim Umstrukturieren sind wirklich gravierende Fehler aufgefallen. Zum Beispiel hat die Implementierung der Rhythmus- & Motiv-Sack-Neufüllungen¹¹ ( die pro Songteil stattfinden sollte ) zwar funktioniert, war aber an ( sogar zwei ) Stellen untergebracht, wo sie überhaupt keine Auswirkungen auf die Rhythmus-Zuordnungen und Motivkonstruktionen haben konnte - ein echter Deppenfehler! Und soeben habe ich gesehen, daß die Akkordtöne teilweise nicht mehr passend zu den Akkorden in den Akkordprogressionsstrings übergeben worden sind - dito ein Deppenfehler, welcher auch immer. ***
Und: Keine Sorge, die Addo-Chords kommen auch wieder an Bord! Diesmal sogar mit einem Gehaltspegeleinstellregler. Eins nach dem anderen. Diesmal sollte ich vorher lieber den jetzigen Code noch ein bisschen besser strukturieren, bevor der am Ende auch noch zu einem dysfunktionalen Monster degeneriert.
Ach, so, kleiner Tipp für Perl-Programmierer ( die es noch nicht wissen, oder es leichtfertig wie ich vernachlässigen ( würden ) ): Verwende nie Variablennamen in Subroutinen, die eine Programmierebene höher oder in anderen Subroutinen auch vorkommen! Auch wenn das am Anfang noch völlig voneinander abgegrenzt aussehen mag: Erweiterungen kommen und ruckzuck hat fim die alten Zusammenhänge vergessen und verknüpft unwissend Dinge, die getrennt bleiben müssen ... uso oso ( vielleicht hat jemfimd bessere Metaphern am Start, dann nur zu! ) .
Zuguterletzt: Ob das jetzt alles nicht immer noch fehlerverseucht ist, kann ich zum jetzigen Zeitpunkt noch nicht exakt, mit halbendgültiger Gewitztheit sagen ;-). Ich bitte hiermit vielmals um Entschuldigung dafür.
Falls es aber nun & derzeit fehlerfrei funzt, so ist es sicherlich ein Lehrstück dafür, was fim harmonisch besser unterlassen sollte, wenn es nicht so klingen soll, wie es klingt, und was fim harmonisch besser machen könnte, damit es nicht so klingt, wie es klingt, und was fim so tun sollte, wie getan, damit es so klingt, wie es klingt - je nach gewünscht onda unerwünscht etc., woll?
Punkt. Dot.
Kleiner Einschub am Fastende:
Vor der Übergabe sieht's jedenfalls noch völlig okay aus (Auszug aus den letzten zwei Beispielen):
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
B-CEGWHOLECDur7:"C"-Mixolydisch:AB-CDEFG:M1-B:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
B-CEGWHOLECDur7:"C"-Mixolydisch:AB-CDEFG:M1-B:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACDG-WHOLEDDur7:"D"-Mixolydisch:ABCDEG-G:M1-E:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
B-CEGWHOLECDur7:"C"-Mixolydisch:AB-CDEFG:M1-B:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
B-CEGWHOLECDur7:"C"-Mixolydisch:AB-CDEFG:M1-B:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
BCEGWHOLECDurMaj7:"C"-Ionisch:ABCDEFG:M1-A:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-A:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-A:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACEFWHOLEFDurMaj7:"C"-Ionisch:ABCDEFG:M1-C:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
ACDG-WHOLEDDur7:"D"-Mixolydisch:ABCDEG-G:M1-E:M2-B:M3-A
BDFGWHOLEGDur7:"G"-Mixolydisch:ABCDEFG:M1-D:M2-B:M3-A
* Es mag sein ( und es darf auch sein ), daß ich mich da irre.
** Anmerkung für die, die ( noch immer ) nach Gewißheiten suchen.
*** Wenn ich mal viel Lust hab', schaue ich in den alten Programmversionen nach. In den neuen sind - dank der Vereinfachung mit dem nun vorgeschalteten Code - diverse Codeblöcke obsolet ge- und rausgekickt worden, die so unübersichtlich geworden waren, daß ich keinen Spaß mehr damit haben konnte ( ich hab's versucht, ehrlich! hab' mir Mühe gegeben, sorry, ihr Gelöschten! ihr wart iwi schon wie ein Teil von mir, aber ich mußte mich trennen. )-: )
**** Ob da auch etwas Sinnloses dabei herauskommt, da lasse ich mich noch überraschen. Vielleicht ist es ja gar nix Unsinniges, meine Fertigkeiten erlauben mir aber noch nicht, das schon gedanklich beurteilen zu können. Von daher "gedankenlos".
***** Ich bewege mich tendenziell immer ins Zuviel, und ich weiß darum.
¹¹ Aufwendigst programmierertüftelt!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Und als Bonus gibt's noch den Code, der nun als Erstes zum Zuge kommt, bevor die anderen, alten Proggis den Rest erledigen ( und nur noch das dürfen, was sie am Besten konnten, den Rest nicht mehr! ). Auch auf diesen Code bin ich alles andere als stolz. Immer noch viel zu hembelisch-durchwachsen-uneinheitlich-astringent-inkonsequent programmiert ( falls ich mein Gewerkel überhaupt so nennen darf ;-) ). Aber grade noch so tauglich, um zu demonstrieren, in welche Richtung das Grundkonzept jetzt geht. Ich glaube, in eine gut ( wenn auch sicher nicht ganz richtige, aber egal ).
Code
#!/usr/bin/perl
# chordprogression_creator-1.9.pl
use strict;
use warnings;
use Storable qw(store retrieve);
# Variablen
# Variablen
my %chordtypes = (
"Maj7sus2" => ["Maj7sus2", "0", "2", "7", "11"],
"Maj7sus4" => ["Maj7sus4", "0", "5", "7", "11"],
"7sus2" => ["7sus2", "0", "2", "7", "10"],
"7sus4" => ["7sus4", "0", "5", "7", "10"],
"7sus2b5" => ["7sus2b5", "0", "2", "6", "10"],
"7sus4b5" => ["7sus4b5", "0", "5", "6", "10"],
"Dur" => ["Dur", "0", "4", "7", "12"],
"Dursus2" => ["Dursus2", "0", "2", "4", "7"],
"Dursus4" => ["Dursus4", "0", "4", "5", "7"],
"Durb5" => ["Durb5", "0", "4", "6", "12"],
"Durb5sus2" => ["Durb5sus2", "0", "2", "4", "6"],
"Dur#5" => ["Dur#5", "0", "4", "8", "12"],
"Dur#5sus2" => ["Dur#5sus2", "0", "2", "4", "8"],
"DurMaj7" => ["DurMaj7", "0", "4", "7", "11"],
"DurMaj7b5" => ["DurMaj7b5", "0", "4", "6", "11"],
"DurMaj7#5" => ["DurMaj7#5", "0", "4", "8", "11"],
"Dur7" => ["Dur7", "0", "4", "7", "10"],
"Dur7b5" => ["Dur7b5", "0", "4", "6", "10"],
"Dur6" => ["Dur6", "0", "4", "9", "12"],
"Dur65" => ["Dur65", "0", "4", "7", "9"],
"Dur6sus2" => ["Dur6sus2", "0", "2", "4", "9"],
"Dur6b5" => ["Dur6b5", "0", "4", "6", "9"],
"Dur6add9qor" => ["Dur6add9qor", "4", "7", "9", "14"],
"Dur7add9qor" => ["Dur7add9qor", "4", "7", "10", "14"],
"DurMaj7add9qor" => ["Dur7add9qor", "4", "7", "11", "14"],
"Dur6addb9qor" => ["Dur6addb9qor", "4", "7", "9", "13"],
"Dur7addb9qor" => ["Dur7addb9qor", "4", "7", "10", "13"],
"DurMaj7addb9qor" => ["Dur7addb9qor", "4", "7", "11", "13"],
"Dur6add#9qor" => ["Dur6add#9qor", "4", "7", "9", "15"],
"Dur7add#9qor" => ["Dur7add#9qor", "4", "7", "10", "15"],
"DurMaj7add#9qor" => ["Dur7add#9qor", "4", "7", "11", "15"],
"Dur6add11qor" => ["Dur6add11qor", "4", "7", "9", "17"],
"Dur7add11qor" => ["Dur7add11qor", "4", "7", "10", "17"],
"DurMaj7add11qor" => ["Dur7add11qor", "4", "7", "11", "17"],
"Dur6add#11qor" => ["Dur6add#11qor", "4", "7", "9", "18"],
"Dur7add#11qor" => ["Dur7add#11qor", "4", "7", "10", "18"],
"DurMaj7add#11qor" => ["Dur7add#11qor", "4", "7", "11", "18"],
"Dur6add13qor" => ["Dur6add13qor", "4", "7", "9", "21"],
"Dur7add13qor" => ["Dur7add13qor", "4", "7", "10", "21"],
"DurMaj7add13qor" => ["Dur7add13qor", "4", "7", "11", "21"],
"Dur6addb13qor" => ["Dur6addb13qor", "4", "7", "9", "20"],
"Dur7addb13qor" => ["Dur7addb13qor", "4", "7", "10", "20"],
"DurMaj7addb13qor" => ["Dur7addb13qor", "4", "7", "11", "20"],
"Dur6add#13qor" => ["Dur6add#13qor", "4", "7", "9", "22"],
"Dur7add#13qor" => ["Dur7add#13qor", "4", "7", "10", "22"],
"DurMaj7add#13qor" => ["Dur7add#13qor", "4", "7", "11", "22"],
"Dur6add9roq" => ["Dur6add9roq", "0", "4", "9", "14"],
"Dur7add9roq" => ["Dur7add9roq", "0", "4", "10", "14"],
"DurMaj7add9roq" => ["Dur7add9roq", "0", "4", "11", "14"],
"Dur6addb9roq" => ["Dur6addb9roq", "0", "4", "9", "13"],
"Dur7addb9roq" => ["Dur7addb9roq", "0", "4", "10", "13"],
"DurMaj7addb9roq" => ["Dur7addb9roq", "0", "4", "11", "13"],
"Dur6add#9roq" => ["Dur6add#9roq", "0", "4", "9", "15"],
"Dur7add#9roq" => ["Dur7add#9roq", "0", "4", "10", "15"],
"DurMaj7add#9roq" => ["Dur7add#9roq", "0", "4", "11", "15"],
"Dur6add11roq" => ["Dur6add11roq", "0", "4", "9", "17"],
"Dur7add11roq" => ["Dur7add11roq", "0", "4", "10", "17"],
"DurMaj7add11roq" => ["Dur7add11roq", "0", "4", "11", "17"],
"Dur6add#11roq" => ["Dur6add#11roq", "0", "4", "9", "18"],
"Dur7add#11roq" => ["Dur7add#11roq", "0", "4", "10", "18"],
"DurMaj7add#11roq" => ["Dur7add#11roq", "0", "4", "11", "18"],
"Dur6add13roq" => ["Dur6add13roq", "0", "4", "9", "21"],
"Dur7add13roq" => ["Dur7add13roq", "0", "4", "10", "21"],
"DurMaj7add13roq" => ["Dur7add13roq", "0", "4", "11", "21"],
"Dur6addb13roq" => ["Dur6addb13roq", "0", "4", "9", "20"],
"Dur7addb13roq" => ["Dur7addb13roq", "0", "4", "10", "20"],
"DurMaj7addb13roq" => ["Dur7addb13roq", "0", "4", "11", "20"],
"Dur6add#13roq" => ["Dur6add#13roq", "0", "4", "9", "22"],
"Dur7add#13roq" => ["Dur7add#13roq", "0", "4", "10", "22"],
"DurMaj7add#13roq" => ["Dur7add#13roq", "0", "4", "11", "22"],
"Dur6b5add9qor" => ["Dur6b5add9qor", "4", "6", "9", "14"],
"Dur7b5add9qor" => ["Dur7b5add9qor", "4", "6", "10", "14"],
"DurMaj7b5add9qor" => ["Dur7b5add9qor", "4", "6", "11", "14"],
"Dur6b5addb9qor" => ["Dur6b5addb9qor", "4", "6", "9", "13"],
"Dur7b5addb9qor" => ["Dur7b5addb9qor", "4", "6", "10", "13"],
"DurMaj7b5addb9qor" => ["Dur7b5addb9qor", "4", "6", "11", "13"],
"Dur6b5add#9qor" => ["Dur6b5add#9qor", "4", "6", "9", "15"],
"Dur7b5add#9qor" => ["Dur7b5add#9qor", "4", "6", "10", "15"],
"DurMaj7b5add#9qor" => ["Dur7b5add#9qor", "4", "6", "11", "15"],
"Dur6b5add11qor" => ["Dur6b5add11qor", "4", "6", "9", "17"],
"Dur7b5add11qor" => ["Dur7b5add11qor", "4", "6", "10", "17"],
"DurMaj7b5add11qor" => ["Dur7b5add11qor", "4", "6", "11", "17"],
"Dur6b5add#11qor" => ["Dur6b5add#11qor", "4", "6", "9", "18"],
"Dur7b5add#11qor" => ["Dur7b5add#11qor", "4", "6", "10", "18"],
"DurMaj7b5add#11qor" => ["Dur7b5add#11qor", "4", "6", "11", "18"],
"Dur6b5add13qor" => ["Dur6b5add13qor", "4", "6", "9", "21"],
"Dur7b5add13qor" => ["Dur7b5add13qor", "4", "6", "10", "21"],
"DurMaj7b5add13qor" => ["Dur7b5add13qor", "4", "6", "11", "21"],
"Dur6b5addb13qor" => ["Dur6b5addb13qor", "4", "6", "9", "20"],
"Dur7b5addb13qor" => ["Dur7b5addb13qor", "4", "6", "10", "20"],
"DurMaj7b5addb13qor" => ["Dur7b5addb13qor", "4", "6", "11", "20"],
"Dur6b5add#13qor" => ["Dur6b5add#13qor", "4", "6", "9", "22"],
"Dur7b5add#13qor" => ["Dur7b5add#13qor", "4", "6", "10", "22"],
"DurMaj7b5add#13qor" => ["Dur7b5add#13qor", "4", "6", "11", "22"],
"Dur6#5add9qor" => ["Dur6#5add9qor", "4", "8", "9", "14"],
"Dur7#5add9qor" => ["Dur7#5add9qor", "4", "8", "10", "14"],
"DurMaj7#5add9qor" => ["Dur7#5add9qor", "4", "8", "11", "14"],
"Dur6#5addb9qor" => ["Dur6#5addb9qor", "4", "8", "9", "13"],
"Dur7#5addb9qor" => ["Dur7#5addb9qor", "4", "8", "10", "13"],
"DurMaj7#5addb9qor" => ["Dur7#5addb9qor", "4", "8", "11", "13"],
"Dur6#5add#9qor" => ["Dur6#5add#9qor", "4", "8", "9", "15"],
"Dur7#5add#9qor" => ["Dur7#5add#9qor", "4", "8", "10", "15"],
"DurMaj7#5add#9qor" => ["Dur7#5add#9qor", "4", "8", "11", "15"],
"Dur6#5add11qor" => ["Dur6#5add11qor", "4", "8", "9", "17"],
"Dur7#5add11qor" => ["Dur7#5add11qor", "4", "8", "10", "17"],
"DurMaj7#5add11qor" => ["Dur7#5add11qor", "4", "8", "11", "17"],
"Dur6#5add#11qor" => ["Dur6#5add#11qor", "4", "8", "9", "18"],
"Dur7#5add#11qor" => ["Dur7#5add#11qor", "4", "8", "10", "18"],
"DurMaj7#5add#11qor" => ["Dur7#5add#11qor", "4", "8", "11", "18"],
"Dur6#5add13qor" => ["Dur6#5add13qor", "4", "8", "9", "21"],
"Dur7#5add13qor" => ["Dur7#5add13qor", "4", "8", "10", "21"],
"DurMaj7#5add13qor" => ["Dur7#5add13qor", "4", "8", "11", "21"],
"Dur6#5addb13qor" => ["Dur6#5addb13qor", "4", "8", "9", "20"],
"Dur7#5addb13qor" => ["Dur7#5addb13qor", "4", "8", "10", "20"],
"DurMaj7#5addb13qor" => ["Dur7#5addb13qor", "4", "8", "11", "20"],
"Dur6#5add#13qor" => ["Dur6#5add#13qor", "4", "8", "9", "22"],
"Dur7#5add#13qor" => ["Dur7#5add#13qor", "4", "8", "10", "22"],
"DurMaj7#5add#13qor" => ["Dur7#5add#13qor", "4", "8", "11", "22"],
"Moll" => ["Moll", "0", "3", "7", "12"],
"Mollsus2" => ["Mollsus2", "0", "2", "3", "7"],
"Mollsus4" => ["Mollsus4", "0", "3", "5", "7"],
"Mollb5" => ["Mollb5", "0", "3", "6", "12"],
"Mollb5sus2" => ["Mollb5sus2", "0", "2", "3", "6"],
"Moll#5sus2" => ["Moll#5sus2", "0", "2", "3", "8"],
"MollMaj7" => ["MollMaj7", "0", "3", "7", "11"],
"MollMaj7b5" => ["MollMaj7b5", "0", "3", "6", "11"],
"MollMaj7#5" => ["MollMaj7#5", "0", "3", "8", "11"],
"Moll7" => ["Moll7", "0", "3", "7", "10"],
"Moll7b5" => ["Moll7b5", "0", "3", "6", "10"],
"Moll6" => ["Moll6", "0", "3", "7", "12"],
"Moll6sus2" => ["Moll6sus2", "0", "2", "3", "7"],
"Moll65" => ["Moll65", "0", "3", "7", "9"],
"Moll6add9qor" => ["Moll6add9qor", "3", "7", "9", "14"],
"Moll7add9qor" => ["Moll7add9qor", "3", "7", "10", "14"],
"MollMaj7add9qor" => ["Moll7add9qor", "3", "7", "11", "14"],
"Moll6addb9qor" => ["Moll6addb9qor", "3", "7", "9", "13"],
"Moll7addb9qor" => ["Moll7addb9qor", "3", "7", "10", "13"],
"MollMaj7addb9qor" => ["Moll7addb9qor", "3", "7", "11", "13"],
"Moll6add#9qor" => ["Moll6add#9qor", "3", "7", "9", "15"],
"Moll7add#9qor" => ["Moll7add#9qor", "3", "7", "10", "15"],
"MollMaj7add#9qor" => ["Moll7add#9qor", "3", "7", "11", "15"],
"Moll6add11qor" => ["Moll6add11qor", "3", "7", "9", "17"],
"Moll7add11qor" => ["Moll7add11qor", "3", "7", "10", "17"],
"MollMaj7add11qor" => ["Moll7add11qor", "3", "7", "11", "17"],
"Moll6add#11qor" => ["Moll6add#11qor", "3", "7", "9", "18"],
"Moll7add#11qor" => ["Moll7add#11qor", "3", "7", "10", "18"],
"MollMaj7add#11qor" => ["Moll7add#11qor", "3", "7", "11", "18"],
"Moll6add13qor" => ["Moll6add13qor", "3", "7", "9", "21"],
"Moll7add13qor" => ["Moll7add13qor", "3", "7", "10", "21"],
"MollMaj7add13qor" => ["Moll7add13qor", "3", "7", "11", "21"],
"Moll6addb13qor" => ["Moll6addb13qor", "3", "7", "9", "20"],
"Moll7addb13qor" => ["Moll7addb13qor", "3", "7", "10", "20"],
"MollMaj7addb13qor" => ["Moll7addb13qor", "3", "7", "11", "20"],
"Moll6add#13qor" => ["Moll6add#13qor", "3", "7", "9", "22"],
"Moll7add#13qor" => ["Moll7add#13qor", "3", "7", "10", "22"],
"MollMaj7add#13qor" => ["Moll7add#13qor", "3", "7", "11", "22"],
"Moll6add9roq" => ["Moll6add9roq", "0", "3", "9", "14"],
"Moll7add9roq" => ["Moll7add9roq", "0", "3", "10", "14"],
"MollMaj7add9roq" => ["Moll7add9roq", "0", "3", "11", "14"],
"Moll6addb9roq" => ["Moll6addb9roq", "0", "3", "9", "13"],
"Moll7addb9roq" => ["Moll7addb9roq", "0", "3", "10", "13"],
"MollMaj7addb9roq" => ["Moll7addb9roq", "0", "3", "11", "13"],
"Moll6add#9roq" => ["Moll6add#9roq", "0", "3", "9", "15"],
"Moll7add#9roq" => ["Moll7add#9roq", "0", "3", "10", "15"],
"MollMaj7add#9roq" => ["Moll7add#9roq", "0", "3", "11", "15"],
"Moll6add11roq" => ["Moll6add11roq", "0", "3", "9", "17"],
"Moll7add11roq" => ["Moll7add11roq", "0", "3", "10", "17"],
"MollMaj7add11roq" => ["Moll7add11roq", "0", "3", "11", "17"],
"Moll6add#11roq" => ["Moll6add#11roq", "0", "3", "9", "18"],
"Moll7add#11roq" => ["Moll7add#11roq", "0", "3", "10", "18"],
"MollMaj7add#11roq" => ["Moll7add#11roq", "0", "3", "11", "18"],
"Moll6add13roq" => ["Moll6add13roq", "0", "3", "9", "21"],
"Moll7add13roq" => ["Moll7add13roq", "0", "3", "10", "21"],
"MollMaj7add13roq" => ["Moll7add13roq", "0", "3", "11", "21"],
"Moll6addb13roq" => ["Moll6addb13roq", "0", "3", "9", "20"],
"Moll7addb13roq" => ["Moll7addb13roq", "0", "3", "10", "20"],
"DurMaj7addb13roq" => ["Dur7addb13roq", "0", "4", "11", "20"],
"Dur6add#13roq" => ["Dur6add#13roq", "0", "4", "9", "22"],
"Dur7add#13roq" => ["Dur7add#13roq", "0", "4", "10", "22"],
"DurMaj7add#13roq" => ["Dur7add#13roq", "0", "4", "11", "22"],
"Moll6b5add9qor" => ["Moll6b5add9qor", "3", "6", "9", "14"],
"Moll7b5add9qor" => ["Moll7b5add9qor", "3", "6", "10", "14"],
"MollMaj7b5add9qor" => ["Moll7b5add9qor", "3", "6", "11", "14"],
"Moll6b5addb9qor" => ["Moll6b5addb9qor", "3", "6", "9", "13"],
"Moll7b5addb9qor" => ["Moll7b5addb9qor", "3", "6", "10", "13"],
"MollMaj7b5addb9qor" => ["Moll7b5addb9qor", "3", "6", "11", "13"],
"Moll6b5add#9qor" => ["Moll6b5add#9qor", "3", "6", "9", "15"],
"Moll7b5add#9qor" => ["Moll7b5add#9qor", "3", "6", "10", "15"],
"MollMaj7b5add#9qor" => ["Moll7b5add#9qor", "3", "6", "11", "15"],
"Moll6b5add11qor" => ["Moll6b5add11qor", "3", "6", "9", "17"],
"Moll7b5add11qor" => ["Moll7b5add11qor", "3", "6", "10", "17"],
"MollMaj7b5add11qor" => ["Moll7b5add11qor", "3", "6", "11", "17"],
"Moll6b5add#11qor" => ["Moll6b5add#11qor", "3", "6", "9", "18"],
"Moll7b5add#11qor" => ["Moll7b5add#11qor", "3", "6", "10", "18"],
"MollMaj7b5add#11qor" => ["Moll7b5add#11qor", "3", "6", "11", "18"],
"Moll6b5add13qor" => ["Moll6b5add13qor", "3", "6", "9", "21"],
"Moll7b5add13qor" => ["Moll7b5add13qor", "3", "6", "10", "21"],
"MollMaj7b5add13qor" => ["Moll7b5add13qor", "3", "6", "11", "21"],
"Moll6b5addb13qor" => ["Moll6b5addb13qor", "3", "6", "9", "20"],
"Moll7b5addb13qor" => ["Moll7b5addb13qor", "3", "6", "10", "20"],
"MollMaj7b5addb13qor" => ["Moll7b5addb13qor", "3", "6", "11", "20"],
"Moll6b5add#13qor" => ["Moll6b5add#13qor", "3", "6", "9", "22"],
"Moll7b5add#13qor" => ["Moll7b5add#13qor", "3", "6", "10", "22"],
"MollMaj7b5add#13qor" => ["Moll7b5add#13qor", "3", "6", "11", "22"],
"Moll6#5add9qor" => ["Moll6#5add9qor", "3", "8", "9", "14"],
"Moll7#5add9qor" => ["Moll7#5add9qor", "3", "8", "10", "14"],
"MollMaj7#5add9qor" => ["Moll7#5add9qor", "3", "8", "11", "14"],
"Moll6#5addb9qor" => ["Moll6#5addb9qor", "3", "8", "9", "13"],
"Moll7#5addb9qor" => ["Moll7#5addb9qor", "3", "8", "10", "13"],
"MollMaj7#5addb9qor" => ["Moll7#5addb9qor", "3", "8", "11", "13"],
"Moll6#5add#9qor" => ["Moll6#5add#9qor", "3", "8", "9", "15"],
"Moll7#5add#9qor" => ["Moll7#5add#9qor", "3", "8", "10", "15"],
"MollMaj7#5add#9qor" => ["Moll7#5add#9qor", "3", "8", "11", "15"],
"Moll6#5add11qor" => ["Moll6#5add11qor", "3", "8", "9", "17"],
"Moll7#5add11qor" => ["Moll7#5add11qor", "3", "8", "10", "17"],
"MollMaj7#5add11qor" => ["Moll7#5add11qor", "3", "8", "11", "17"],
"Moll6#5add#11qor" => ["Moll6#5add#11qor", "3", "8", "9", "18"],
"Moll7#5add#11qor" => ["Moll7#5add#11qor", "3", "8", "10", "18"],
"MollMaj7#5add#11qor" => ["Moll7#5add#11qor", "3", "8", "11", "18"],
"Moll6#5add13qor" => ["Moll6#5add13qor", "3", "8", "9", "21"],
"Moll7#5add13qor" => ["Moll7#5add13qor", "3", "8", "10", "21"],
"MollMaj7#5add13qor" => ["Moll7#5add13qor", "3", "8", "11", "21"],
"Moll6#5addb13qor" => ["Moll6#5addb13qor", "3", "8", "9", "20"],
"Moll7#5addb13qor" => ["Moll7#5addb13qor", "3", "8", "10", "20"],
"MollMaj7#5addb13qor" => ["Moll7#5addb13qor", "3", "8", "11", "20"],
"Moll6#5add#13qor" => ["Moll6#5add#13qor", "3", "8", "9", "22"],
"Moll7#5add#13qor" => ["Moll7#5add#13qor", "3", "8", "10", "22"],
"MollMaj7#5add#13qor" => ["Moll7#5add#13qor", "3", "8", "11", "22"],
"dim1" => ["dim1", "0", "1", "2", "3"],
"dim2" => ["dim2", "0", "2", "4", "6"],
"Dim7" => ["Dim7", "0", "3", "6", "9"],
"dim12" => ["dim12", "0", "2", "3", "4"],
"dim13" => ["dim13", "0", "3", "4", "5"],
"dim14" => ["dim14", "0", "4", "5", "6"],
"dim15" => ["dim15", "0", "5", "6", "7"],
"dim16" => ["dim16", "0", "6", "7", "8"],
"dim17" => ["dim17", "0", "7", "8", "9"],
"dim18" => ["dim18", "0", "8", "9", "10"],
"dim19" => ["dim19", "0", "9", "10", "11"],
"dim22" => ["dim22", "0", "3", "5", "7"] );
# Akkordtypenarray
my @chordtypes;
@chordtypes = map { $_ } keys %chordtypes;
# Chroma & Chroma_invers
my %chroma = (
"C-" => 0,
"C" => 1,
"D-" => 2,
"D" => 3,
"E-" => 4,
"E" => 5,
"F-" => 5,
"F" => 6,
"G-" => 7,
"G" => 8,
"A-" => 9,
"A" => 10,
"B-" => 11,
"B" => 12 );
my %chroma_inv = (
"0" => "C-",
"1" => "C",
"2" => "D-",
"3" => "D",
"4" => "E-",
"5" => "E",
"6" => "F",
"7" => "G-",
"8" => "G",
"9" => "A-",
"10" => "A",
"11" => "B-",
"12" => "B" );
my %notevalue = (
"1" => "WHOLE",
"2" => "HALF",
"3" => "QUARTER" );
my %modes = (
Ionisch => ['0', '2', '4', '5', '7', '9', '11'],
Dorisch => ['0', '2', '3', '5', '7', '9', '10'],
Phrygisch => ['0', '1', '3', '5', '7', '8', '10'],
Lydisch => ['0', '2', '4', '6', '7', '9', '11'],
Mixolydisch => ['0', '2', '4', '5', '7', '9', '10'],
Aeolisch => ['0', '2', '3', '5', '7', '8', '10'],
Lokrisch => ['0', '1', '3', '5', '6', '8', '10'],
Vermindert => ['0', '2', '3', '5', '6', '8', '9','11'],
Alteriert => ['0', '1', '3', '4', '6', '8', '10'],
Chromatisch => ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11'],
Chromatischhalba => ['0', '1', '2', '3', '4', '5', '6'],
Chromatischhalbb => ['0', '6', '7', '8', '9', '10', '11'],
Messiaendrei => ['0', '2', '3', '4', '6', '7', '8', '10', '11'],
Messiaenvier => ['0', '1', '2', '5', '6', '7', '8', '11'],
Messiaenfuenf => ['0', '1', '5', '6', '7', '11'],
Messiaensechs => ['0', '2', '4', '5', '6', '8', '10', '11'],
Messiaensieben => ['0', '1', '2', '3', '5', '6', '7', '8', '9', '11'],
Messiaenacht => ['0', '1', '4', '5', '8', '9'],
Mollharmonisch => ['0', '2', '3', '5', '7', '8', '11'],
Mollmelodisch => ['0', '2', '3', '5', '7', '9', '11'] );
## Ermitteln der Tonstrings aus den Modes
my %modenotesstrings;
foreach ( sort { $a <=> $b } keys %chroma_inv ) {
my $grundtonvalue_temp = $_;
print "\n\nMein temporärer Grundton-Wert: $grundtonvalue_temp\n";
my $grundton_temp = $chroma_inv{$grundtonvalue_temp};
print "Mein temporärer Grundton: $grundton_temp\n\n";
foreach ( sort { $a cmp $b } keys %modes ) {
my %modenotes_temp;
my $mode_temp = $_;
print "\nMein aktueller Modus: \"$grundton_temp\"-$mode_temp\n\n";
my $modenotesstring_tmp = "";
my $intervalle_temp_ref = $modes{$_};
my @intervalle = @$intervalle_temp_ref;
foreach ( @intervalle ) {
my $notevalue_temp = $grundtonvalue_temp + $_;
# Doppelt wegen "add9"
if ( $notevalue_temp > 24 ) { $notevalue_temp = $notevalue_temp - 24 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
my $note_temp = $chroma_inv{$notevalue_temp};
print "Mein aktueller Ton: $note_temp\n";
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note_temp =~ m/-/ ) {
$note_temp =~ s/(.)-/$1a/;
} else { $note_temp =~ s/(.)/$1b/ };
if ( not exists $modenotes_temp{$note_temp} ) { $modenotes_temp{$note_temp} = 1 }
}
map { $modenotesstring_tmp = $modenotesstring_tmp.$_ } sort { $a cmp $b } keys %modenotes_temp;
# Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$modenotesstring_tmp =~ s/a/-/g;
$modenotesstring_tmp =~ s/b//g;
print "\nMein erzeugter Tonstring zu \"$grundton_temp\"-$mode_temp:\n$modenotesstring_tmp\n\n";
# sleep 4;
if ( not exists $modenotesstrings{$grundton_temp.'-'.$mode_temp} ) {
$modenotesstrings{'"'.$grundton_temp.'"-'.$mode_temp} = $modenotesstring_tmp }
}
}
# sleep 4;
## Korrektur des Bug-1111 ( "C-" = "B" & vice versa )
foreach ( keys %modenotesstrings ) {
my $string_temp = $_;
if ( $string_temp =~ m/^"C-"/ ) {
my $string_temp_changed = $string_temp;
my $modenotesstring_temp = $modenotesstrings{$string_temp};
$string_temp_changed =~ s/^"C-"/"B-"/;
if ( not exists $modenotesstrings{$string_temp_changed} ) {
$modenotesstrings{$string_temp_changed} = $modenotesstring_temp;
}
delete $modenotesstrings{$string_temp} }
}
# Akkorde und Akkordtonstrings
my %chords_n_strings;
for ( my $noteno = 1; $noteno < 13; $noteno++ ) {
my $grundton_value = $noteno;
my $grundton = $chroma_inv{$grundton_value};
foreach ( @chordtypes ) {
my $chordtype = $_;
my $chordintervall_ref = $chordtypes{$chordtype};
my @chordintervall = @$chordintervall_ref;
# Falls Akkordtyp Quinte ohne Root (qor) oder Root ohne Quinte (roq), dann ...
if ( $chordtype =~ m/^.*qor$/ ) {
# Root für Chordstring nachtragen
push @chordintervall, '0';
} elsif ( $chordtype =~ m/^.*roq$/ ) {
# Reine Quinte für Chordstring nachtragen
push @chordintervall, '7';
}
my %notes_temp;
my $notesstring_cns = "";
foreach ( @chordintervall ) {
if ( $_ eq $chordintervall[0] ) {
print "Akkordtyp: $_\n";
next
}
print "Intervall-Wert: $_\n";
my $note_value = $grundton_value + $_;
print "Noten-Wert: $note_value\n";
# Doppelt wegen "add9"
if ( $note_value > 24 ) { $note_value = $note_value - 24 }
if ( $note_value > 12 ) { $note_value = $note_value - 12 }
if ( $note_value > 12 ) { $note_value = $note_value - 12 }
print "Noten-Wert nach Korrektur: $note_value\n";
my $note = $chroma_inv{$note_value};
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note =~ m/-/ ) {
$note =~ s/(.)-/$1a/;
} else { $note =~ s/(.)/$1b/ };
if ( not exists $notes_temp{$note} ) { $notes_temp{$note} = 1 }
}
map { $notesstring_cns = $notesstring_cns.','.$_ } sort { $a cmp $b } keys %notes_temp;
$notesstring_cns =~ s/^,//;
# Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$notesstring_cns =~ s/a/-/g;
$notesstring_cns =~ s/b//g;
if ( not exists $chords_n_strings{'"'.$grundton.'"-'.$chordtype} ) {
$chords_n_strings{'"'.$grundton.'"-'.$chordtype} = $notesstring_cns
}
}
}
my $ok = '';
my %m1;
my %m2;
my %m3;
my $m4 = '';
# Falls bereits Teile gespeichert sind, laden
if ( -e 'm1_1.str' ) { my $m1_ref = retrieve ('m1_1.str'); %m1 = %$m1_ref }
if ( -e 'm2_1.str' ) { my $m2_ref = retrieve ('m2_1.str'); %m2 = %$m2_ref }
if ( -e 'm3_1.str' ) { my $m3_ref = retrieve ('m3_1.str'); %m3 = %$m3_ref }
if ( -e 'm4_1.str' ) { my $m4_ref = retrieve ('m4_1.str'); $m4 = $$m4_ref }
# Programm
until ( $ok eq 'OK' ) {
system("clear");
print "\nWelche Parts sollen bearbeitet werden? (M1,M2,M3,M4)\n\n";
my $choice = <STDIN>;
chomp $choice;
if ( $choice eq 'M1' ) {
m1();
} elsif ( $choice eq 'M2' ) {
m2();
} elsif ( $choice eq 'M3' ) {
m3();
} elsif ( $choice eq 'M4' ) {
m4();
}
# Check, ob fertig oder nicht
print "\n\n";
print "Bearbeitung beenden? Einfach 'OK' eingeben und Return!\n";
print "Ansonsten Return ohne Eingabe für weitere Bearbeitung(en)!\n";
$ok = <STDIN>;
chomp $ok;
}
# Betrachten der M1-Teile im M4-M3-M2-Zusammenhang
my %m4m3m2m1;
my %metamuster1_teile;
if ( -e 'm4m3m2m1.str' ) {
print "Es existiert bereits eine Speicherung. Übernehmen (j) oder neu anlegen (n)?\n";
my $answer = <STDIN>;
chomp $answer;
if ( $answer eq 'j' ) {
my $m4m3m2m1_ref = retrieve 'm4m3m2m1.str';
%m4m3m2m1 = %$m4m3m2m1_ref;
my $metamuster1_teile_ref = retrieve 'metamuster1_teile.str';
%metamuster1_teile = %$metamuster1_teile_ref;
} elsif ( $answer eq 'n' ) {
# Metamuster1-Teile werden angelegt, erste Modus-Grob-Zuordnung findet statt
metamuster1_und_modi();
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
} else { print "Dös war fei nix!\n"; exit }
} else {
# Metamuster1-Teile werden angelegt, erste Modus-Grob-Zuordnung findet statt
metamuster1_und_modi();
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
## Ausdruck des Hashs
print "\n\n";
print "Die M1-Parts in der M3-M2-Anordnung durchnummeriert:\n\n";
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $nr = $_;
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
print "Nummer $nr\n";
print "M3-Teil: $tmparr[4], M2-Teil: $tmparr[5], M1-Teil: $tmparr[6]\nTaktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
# Änderung Modus-Zuordnungen
print "Vervollständigen onda Ändern der Modus-Zuordnungen!\n\n";
metamuster1_und_modi_edit();
# Erzeugen der übergabefähigen Progression
## Schritt 1: Ergänzen der Modustonstrings
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $nr = $_;
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
print "Nummer $nr\n";
print "M3-Teil: $tmparr[4], M2-Teil: $tmparr[5], M1-Teil: $tmparr[6]\nTaktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
my $modenotesstring_tmp = $modenotesstrings{$tmparr[3]};
print "Modus-Ton-String: $modenotesstring_tmp\n";
$tmparr[7] = $modenotesstring_tmp;
$m4m3m2m1{$nr} = [@tmparr];
}
m4m3m2m1_store();
## Schritt 2: Umbauen in das für den simplechordpattern_creator-3.9.pl erkennbare chordprogression-Format
my @chordprogression;
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
my $string_tmp;
$string_tmp = $tmparr[0];
$string_tmp =~ s/,//g;
$string_tmp = $string_tmp.$tmparr[1].$tmparr[2].':'.$tmparr[3].':'.$tmparr[7].':M1-'.$tmparr[6].':M2-'.$tmparr[5].':M3-'.$tmparr[4];
push @chordprogression, $string_tmp;
}
### Kontrollausdruck + Testspeicherung
print "\nDie Akkordprogression:\n\n";
print map { $_, "\n" } @chordprogression;
print "\n\n";
store \@chordprogression, 'chordprogression-test.str';
sleep 11;
############################################################################################
################################## SUBROUTINEN #####################################
############################################################################################
# Subroutine m1
sub m1 {
# Meldung
print "\nHier ist die Subroutine m1!\n";
# Programm
if ( scalar keys %m1 == 0 ) {
print "\nEs gibt noch keine M1-Parts!\n";
print "Bitte den ersten M1-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte den Akkord angeben!\n";
my $chord = <STDIN>;
chomp $chord;
print "Und als Letztes die Taktlänge ( 1 = ganzer 4/4-, 2 = halber 4/4-Takt )!\n";
my $taktlaenge = <STDIN>;
chomp $taktlaenge;
$m1{$part_first} = "$chord:$taktlaenge";
} else {
print "\nEs gibt folgende M1-Parts!\n\n";
print map { $_, " = ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte den Akkord angeben!\n";
my $chord = <STDIN>;
chomp $chord;
print "Und als Letztes die Taktlänge ( 1 = ganzer 4/4-, 2 = halber 4/4-Takt )!\n";
my $taktlaenge = <STDIN>;
chomp $taktlaenge;
$m1{$part_new} = "$chord:$taktlaenge";
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m1{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m1{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m1{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m1, 'm1_1.str';
}
# Subroutine m2
sub m2 {
# Meldung
print "\nHier ist die Subroutine m2!\n";
# Programm
if ( scalar keys %m2 == 0 ) {
print "\nEs gibt noch keine M2-Parts!\n";
print "Bitte den ersten M2-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte einen M1-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $m1_parts = <STDIN>;
chomp $m1_parts;
$m2{$part_first} = $m1_parts;
} else {
print "\nEs gibt folgende M2-Parts!\n\n";
print map { $_, " = ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte einen M1-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $m1_parts = <STDIN>;
chomp $m1_parts;
$m2{$part_new} = $m1_parts;
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m2{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M1-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m2{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m2{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m2, 'm2_1.str';
}
# Subroutine m3
sub m3 {
# Meldung
print "\nHier ist die Subroutine m3!\n";
# Programm
if ( scalar keys %m3 == 0 ) {
print "\nEs gibt noch keine M3-Parts!\n";
print "Bitte den ersten M3-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte einen M2-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $m2_parts = <STDIN>;
chomp $m2_parts;
$m3{$part_first} = $m2_parts;
} else {
print "\nEs gibt folgende M3-Parts!\n\n";
print map { $_, " = ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte einen M2-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $m2_parts = <STDIN>;
chomp $m2_parts;
$m3{$part_new} = $m2_parts;
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m3{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M2-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m3{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m3{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m3, 'm3_1.str';
}
# Subroutine m4
sub m4 {
# Meldung
print "\nHier ist die Subroutine m4!\n";
# Programm
if ( $m4 eq '' ) {
print "\nEs ist noch keine M4-Reihenfolge der M3-Parts festgelegt!\n";
print "Bitte die M4-Reihenfolge angeben!\n";
print "Die M3-Teile bitte mit Doppelpunkt getrennt angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\n\n";
$m4 = <STDIN>;
chomp $m4;
} else {
print "\nEs existiert die folgende Anordnung der M3-Parts:\n\n";
print $m4, "\n";
print "\nSoll diese Anordnung bearbeitet (e) oder gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'e' ) {
print "Der zu bearbeitende Eintrag ist: ", $m4, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M3-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m4 = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
$m4 = '';
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \$m4, 'm4_1.str';
}
# Subroutine mode_chords_strings
sub modes_strings {
# Rückmeldung
print "Hier ist die Subroutine modes_strings!\n\n";
# Übergaben
my $grundton_value = shift;
my $akkord_ms = shift;
print "Der übergebene Grundton-Wert ist: $grundton_value\n\n";
print "Der übergebene Akkord ist: $akkord_ms\n\n";
## Grundton
my $grundton = $chroma_inv{$grundton_value};
print "Der übergebene Grundton ist: $grundton\n\n";
## Ermittlung der Intervalle + Töne, die im Akkord vorkommen
my %chordnotes_ms;
my $intervalle_ref = $chordtypes{$akkord_ms};
my @intervalle = @$intervalle_ref;
foreach ( @intervalle ) {
if ( $_ eq $intervalle[0] ) { next }
my $notevalue_temp = $grundton_value + $_;
# Doppelt wegen "add9"
if ( $notevalue_temp > 24 ) { $notevalue_temp = $notevalue_temp - 24 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
my $note_temp = $chroma_inv{$notevalue_temp};
if ( not exists $chordnotes_ms{$note_temp} ) { $chordnotes_ms{$note_temp} = 1 }
}
print "Array der Intervalle:\n\n";
print join (" :: ", map { $_ } @intervalle);
print "\n\n";
print "Array der Töne:\n\n";
print join (" :: ", map { $_ } keys %chordnotes_ms);
print "\n\n";
## Ermitteln des Tonstrings aus dem Akkord
my $notesstring_ms = "";
map { $notesstring_ms = $notesstring_ms.$_ } sort { $a cmp $b } keys %chordnotes_ms;
print "Der ermittelte Tonstring ist: $notesstring_ms\n\n";
# sleep 4;
### Kontrolldruck der Modalton-Strings
print "\nMeine ", scalar keys %modenotesstrings, " Modalton-Strings:\n\n";
print join ("\n", map { $_." = ".$modenotesstrings{$_} } sort { $a cmp $b } keys %modenotesstrings);
print "\n\n";
## Vergleich des Akkordstrings mit den Modalton-Strings
my @matchmodes_ms;
my $string2compare_regex = $notesstring_ms;
$string2compare_regex =~ s/([ABCDEFG]-*)/$1,/g;
### Regex-String muß umsortiert werden!
my $string2compare_new = "";
my @tempsort = split (",",$string2compare_regex);
my %tempsort;
foreach ( @tempsort ) {
my $note_temp = $_;
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note_temp =~ m/-/ ) {
$note_temp =~ s/(.)-/$1a/;
} else { $note_temp =~ s/(.)/$1b/ };
if ( not exists $tempsort{$note_temp} ) { $tempsort{$note_temp} = 1 }
}
map { $string2compare_new = $string2compare_new.'.*'.$_.',' } sort { $a cmp $b } keys %tempsort;
### Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$string2compare_new =~ s/a/-/g;
$string2compare_new =~ s/b//g;
### Übergabe des korrigierten Strings an die alte Variable
$string2compare_regex = $string2compare_new.'.*';
### Vergleich
print "\nMein zu vergleichender Regex-Ton-String: $string2compare_regex\n\n";
# sleep 4;
foreach ( keys %modenotesstrings ) {
my $string_temp = $modenotesstrings{$_};
# sleep 4;
$string_temp =~ s/([ABCDEFG]-*)/$1,/g;
print "Temporärer String ist jetzt: $string_temp\n";
my $mode_temp = $_;
if ( $string_temp =~ m/$string2compare_regex/ ) {
print "Hiphip-hooray! ";
print "$mode_temp ist möglich!\n";
print "Modal-Ton-String: $string_temp\n";
print "Ton-String: $notesstring_ms\n\n";
push @matchmodes_ms, $mode_temp;
}
}
## Ausgabe der Möglichkeiten
my $grundton_readable = $grundton;
$grundton_readable =~ s/-/b/;
print "\nEs gibt ", scalar @matchmodes_ms, " Modus-Möglichkeiten für \"$grundton_readable\"-$akkord_ms!\n\n";
print "\n";
# Übergabe der ermittelten Informationen
return (\@matchmodes_ms,$notesstring_ms)
}
# Subroutine metamuster1_und_modi
sub metamuster1_und_modi {
# Meldung
print "\nHier ist die Subroutine metamuster1_und_modi!\n";
# Programm
my %matchmodi;
foreach ( keys %m1 ) {
my $m1_part = $_;
my @m1part;
my $chord = $m1{$m1_part};
$chord =~ s/^(.*):.*$/$1/;
my $value = $m1{$m1_part};
$chord =~ s/^.*:(.*)$/$1/;
$chord =~ s/^(.*)(-.*)$/"$1"$2/;
$chord =~ s/"(.)b"/"$1-"/;
print "Akkord: $chord\n";
my $notes = $chords_n_strings{$chord};
$value =~ s/^.*:(.*)$/$1/;
$value =~ s/1/WHOLE/;
$value =~ s/2/HALF/;
$value =~ s/4/QUARTER/;
$m1part[0] = $notes;
$m1part[1] = $value;
$chord =~ s/"-//;
$chord =~ s/"//;
$m1part[2] = $chord;
# Die häufigst möglichen Modi ermitteln
my $grundton = $chord;
my $akkord_typ = $chord;
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
foreach ( @matchmodes_temp ) {
if ( not exists $matchmodi{$_} ) { $matchmodi{$_} = 1 }
else { $matchmodi{$_} = $matchmodi{$_} + 1 }
}
# Array dem Part zuordnen
$metamuster1_teile{$m1_part} = [@m1part];
}
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2]\n";
}
print "\n\n";
foreach ( sort { $matchmodi{$a} <=> $matchmodi{$b} } keys %matchmodi ) {
print "Anzahl des Vorkommens: $matchmodi{$_} des Modus: $_\n"
}
print "\n\n";
# Modi-Zuordnung
print "\nWelcher Modus soll - wenn möglich - den M1-Teilen zugeordnet werden?\n";
my $wunschmodus = <STDIN>;
chomp $wunschmodus;
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
# Test, ob der Wunschmodus zum M1-Teil passt
# Die häufigst möglichen Modi ermitteln
my $grundton = $tmparr[2];
my $akkord_typ = $tmparr[2];
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
my %matchmodes_temp;
foreach ( @matchmodes_temp ) {
if ( not exists $matchmodes_temp{$_} ) { $matchmodes_temp{$_} = 1 }
}
if ( exists $matchmodes_temp{$wunschmodus} ) {
$tmparr[3] = $wunschmodus
} else {
$tmparr[3] = 'Modus noch nicht bestimmt!'
}
# Array dem Part zuordnen
$metamuster1_teile{$_} = [@tmparr];
}
store \%metamuster1_teile, 'metamuster1_teile.str';
}
# Subroutine metamuster1_und_modi_edit
sub metamuster1_und_modi_edit {
# Meldung
print "\nHier ist die Subroutine metamuster1_und_modi_edit!\n\n";
# Programm
my $editflag = '';
until ( $editflag eq 'q' ) {
# Übersichtsdruck
foreach ( keys %metamuster1_teile ) {
my $part = $_;
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Teil: $part => Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
# Bei welchem Teil soll der Modus geändert/hinzugefügt werden?
print "Welchem Teil Modus ändern bzw. zuordnen?\n\n";
my $part2edit = <STDIN>;
chomp $part2edit;
if ( not exists $metamuster1_teile{$part2edit} ) {
print "FEHLER, FEHLER!!\n\n";
} else {
my $arr2edit_ref = $metamuster1_teile{$part2edit};
my @arr2edit = @$arr2edit_ref;
print "Teil: $part2edit => Akkord: $arr2edit[2], Modus: $arr2edit[3]\n";
print "Welcher Modus soll zugeordnet werden?\n\n";
print "Passende Modi anzeigen lassen? (j/n)\n\n";
my $showmodi = <STDIN>;
chomp $showmodi;
my @matchmodi;
if ( $showmodi eq 'j' ) {
my $matchmodi_ref = showmodi($arr2edit[2]);
@matchmodi = @$matchmodi_ref;
}
foreach my $nr ( 0..((scalar @matchmodi)-1) ) {
print $nr, ": $matchmodi[$nr]\n";
}
print "\nBitte den Modus jetzt eingeben (Nummer reicht {geht auch gar nicht anders ;-)})!\n\n";
my $wishmode = <STDIN>;
chomp $wishmode;
$wishmode = $matchmodi[$wishmode];
$arr2edit[3] = $wishmode;
$metamuster1_teile{$part2edit} = [@arr2edit];
}
# Änderungen beenden oder fortfahren
print "Weiter ändern ( Return ) oder beenden ( q + Return ) ?\n\n";
$editflag = <STDIN>;
chomp $editflag;
}
# Speichern oder nicht?
print "Änderungen speichern? (j/n)?\n\n";
my $save = <STDIN>;
chomp $save;
if ( $save eq 'j' ) {
store \%metamuster1_teile, 'metamuster1_teile.str';
# Aktualisieren und Speichern des m4m3m2m1-Hash
m4m3m2m1_refresh();
} else {
print "Änderungen wurden nicht gespeichert!\n\n";
}
}
# Subroutine showmodi
sub showmodi {
# Meldung
print "\nHier ist die Subroutine showmodi!\n\n";
# Übernahme
my $chord2check = shift;
# Programm
my $grundton = $chord2check;
my $akkord_typ = $chord2check;
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
# Übergabe
return \@matchmodes_temp;
}
# Subroutine m4m3m2m1_refresh
sub m4m3m2m1_refresh {
# Meldung
print "\nHier ist die Subroutine m4m3m2m1_refresh!\n\n";
# Programm
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
%m4m3m2m1 = ();
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
# Subroutine m4m3m2m1_refresh
sub m4m3m2m1_store {
# Meldung
print "\nHier ist die Subroutine m4m3m2m1_store!\n\n";
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
# chordprogression_creator-1.9.pl
use strict;
use warnings;
use Storable qw(store retrieve);
# Variablen
# Variablen
my %chordtypes = (
"Maj7sus2" => ["Maj7sus2", "0", "2", "7", "11"],
"Maj7sus4" => ["Maj7sus4", "0", "5", "7", "11"],
"7sus2" => ["7sus2", "0", "2", "7", "10"],
"7sus4" => ["7sus4", "0", "5", "7", "10"],
"7sus2b5" => ["7sus2b5", "0", "2", "6", "10"],
"7sus4b5" => ["7sus4b5", "0", "5", "6", "10"],
"Dur" => ["Dur", "0", "4", "7", "12"],
"Dursus2" => ["Dursus2", "0", "2", "4", "7"],
"Dursus4" => ["Dursus4", "0", "4", "5", "7"],
"Durb5" => ["Durb5", "0", "4", "6", "12"],
"Durb5sus2" => ["Durb5sus2", "0", "2", "4", "6"],
"Dur#5" => ["Dur#5", "0", "4", "8", "12"],
"Dur#5sus2" => ["Dur#5sus2", "0", "2", "4", "8"],
"DurMaj7" => ["DurMaj7", "0", "4", "7", "11"],
"DurMaj7b5" => ["DurMaj7b5", "0", "4", "6", "11"],
"DurMaj7#5" => ["DurMaj7#5", "0", "4", "8", "11"],
"Dur7" => ["Dur7", "0", "4", "7", "10"],
"Dur7b5" => ["Dur7b5", "0", "4", "6", "10"],
"Dur6" => ["Dur6", "0", "4", "9", "12"],
"Dur65" => ["Dur65", "0", "4", "7", "9"],
"Dur6sus2" => ["Dur6sus2", "0", "2", "4", "9"],
"Dur6b5" => ["Dur6b5", "0", "4", "6", "9"],
"Dur6add9qor" => ["Dur6add9qor", "4", "7", "9", "14"],
"Dur7add9qor" => ["Dur7add9qor", "4", "7", "10", "14"],
"DurMaj7add9qor" => ["Dur7add9qor", "4", "7", "11", "14"],
"Dur6addb9qor" => ["Dur6addb9qor", "4", "7", "9", "13"],
"Dur7addb9qor" => ["Dur7addb9qor", "4", "7", "10", "13"],
"DurMaj7addb9qor" => ["Dur7addb9qor", "4", "7", "11", "13"],
"Dur6add#9qor" => ["Dur6add#9qor", "4", "7", "9", "15"],
"Dur7add#9qor" => ["Dur7add#9qor", "4", "7", "10", "15"],
"DurMaj7add#9qor" => ["Dur7add#9qor", "4", "7", "11", "15"],
"Dur6add11qor" => ["Dur6add11qor", "4", "7", "9", "17"],
"Dur7add11qor" => ["Dur7add11qor", "4", "7", "10", "17"],
"DurMaj7add11qor" => ["Dur7add11qor", "4", "7", "11", "17"],
"Dur6add#11qor" => ["Dur6add#11qor", "4", "7", "9", "18"],
"Dur7add#11qor" => ["Dur7add#11qor", "4", "7", "10", "18"],
"DurMaj7add#11qor" => ["Dur7add#11qor", "4", "7", "11", "18"],
"Dur6add13qor" => ["Dur6add13qor", "4", "7", "9", "21"],
"Dur7add13qor" => ["Dur7add13qor", "4", "7", "10", "21"],
"DurMaj7add13qor" => ["Dur7add13qor", "4", "7", "11", "21"],
"Dur6addb13qor" => ["Dur6addb13qor", "4", "7", "9", "20"],
"Dur7addb13qor" => ["Dur7addb13qor", "4", "7", "10", "20"],
"DurMaj7addb13qor" => ["Dur7addb13qor", "4", "7", "11", "20"],
"Dur6add#13qor" => ["Dur6add#13qor", "4", "7", "9", "22"],
"Dur7add#13qor" => ["Dur7add#13qor", "4", "7", "10", "22"],
"DurMaj7add#13qor" => ["Dur7add#13qor", "4", "7", "11", "22"],
"Dur6add9roq" => ["Dur6add9roq", "0", "4", "9", "14"],
"Dur7add9roq" => ["Dur7add9roq", "0", "4", "10", "14"],
"DurMaj7add9roq" => ["Dur7add9roq", "0", "4", "11", "14"],
"Dur6addb9roq" => ["Dur6addb9roq", "0", "4", "9", "13"],
"Dur7addb9roq" => ["Dur7addb9roq", "0", "4", "10", "13"],
"DurMaj7addb9roq" => ["Dur7addb9roq", "0", "4", "11", "13"],
"Dur6add#9roq" => ["Dur6add#9roq", "0", "4", "9", "15"],
"Dur7add#9roq" => ["Dur7add#9roq", "0", "4", "10", "15"],
"DurMaj7add#9roq" => ["Dur7add#9roq", "0", "4", "11", "15"],
"Dur6add11roq" => ["Dur6add11roq", "0", "4", "9", "17"],
"Dur7add11roq" => ["Dur7add11roq", "0", "4", "10", "17"],
"DurMaj7add11roq" => ["Dur7add11roq", "0", "4", "11", "17"],
"Dur6add#11roq" => ["Dur6add#11roq", "0", "4", "9", "18"],
"Dur7add#11roq" => ["Dur7add#11roq", "0", "4", "10", "18"],
"DurMaj7add#11roq" => ["Dur7add#11roq", "0", "4", "11", "18"],
"Dur6add13roq" => ["Dur6add13roq", "0", "4", "9", "21"],
"Dur7add13roq" => ["Dur7add13roq", "0", "4", "10", "21"],
"DurMaj7add13roq" => ["Dur7add13roq", "0", "4", "11", "21"],
"Dur6addb13roq" => ["Dur6addb13roq", "0", "4", "9", "20"],
"Dur7addb13roq" => ["Dur7addb13roq", "0", "4", "10", "20"],
"DurMaj7addb13roq" => ["Dur7addb13roq", "0", "4", "11", "20"],
"Dur6add#13roq" => ["Dur6add#13roq", "0", "4", "9", "22"],
"Dur7add#13roq" => ["Dur7add#13roq", "0", "4", "10", "22"],
"DurMaj7add#13roq" => ["Dur7add#13roq", "0", "4", "11", "22"],
"Dur6b5add9qor" => ["Dur6b5add9qor", "4", "6", "9", "14"],
"Dur7b5add9qor" => ["Dur7b5add9qor", "4", "6", "10", "14"],
"DurMaj7b5add9qor" => ["Dur7b5add9qor", "4", "6", "11", "14"],
"Dur6b5addb9qor" => ["Dur6b5addb9qor", "4", "6", "9", "13"],
"Dur7b5addb9qor" => ["Dur7b5addb9qor", "4", "6", "10", "13"],
"DurMaj7b5addb9qor" => ["Dur7b5addb9qor", "4", "6", "11", "13"],
"Dur6b5add#9qor" => ["Dur6b5add#9qor", "4", "6", "9", "15"],
"Dur7b5add#9qor" => ["Dur7b5add#9qor", "4", "6", "10", "15"],
"DurMaj7b5add#9qor" => ["Dur7b5add#9qor", "4", "6", "11", "15"],
"Dur6b5add11qor" => ["Dur6b5add11qor", "4", "6", "9", "17"],
"Dur7b5add11qor" => ["Dur7b5add11qor", "4", "6", "10", "17"],
"DurMaj7b5add11qor" => ["Dur7b5add11qor", "4", "6", "11", "17"],
"Dur6b5add#11qor" => ["Dur6b5add#11qor", "4", "6", "9", "18"],
"Dur7b5add#11qor" => ["Dur7b5add#11qor", "4", "6", "10", "18"],
"DurMaj7b5add#11qor" => ["Dur7b5add#11qor", "4", "6", "11", "18"],
"Dur6b5add13qor" => ["Dur6b5add13qor", "4", "6", "9", "21"],
"Dur7b5add13qor" => ["Dur7b5add13qor", "4", "6", "10", "21"],
"DurMaj7b5add13qor" => ["Dur7b5add13qor", "4", "6", "11", "21"],
"Dur6b5addb13qor" => ["Dur6b5addb13qor", "4", "6", "9", "20"],
"Dur7b5addb13qor" => ["Dur7b5addb13qor", "4", "6", "10", "20"],
"DurMaj7b5addb13qor" => ["Dur7b5addb13qor", "4", "6", "11", "20"],
"Dur6b5add#13qor" => ["Dur6b5add#13qor", "4", "6", "9", "22"],
"Dur7b5add#13qor" => ["Dur7b5add#13qor", "4", "6", "10", "22"],
"DurMaj7b5add#13qor" => ["Dur7b5add#13qor", "4", "6", "11", "22"],
"Dur6#5add9qor" => ["Dur6#5add9qor", "4", "8", "9", "14"],
"Dur7#5add9qor" => ["Dur7#5add9qor", "4", "8", "10", "14"],
"DurMaj7#5add9qor" => ["Dur7#5add9qor", "4", "8", "11", "14"],
"Dur6#5addb9qor" => ["Dur6#5addb9qor", "4", "8", "9", "13"],
"Dur7#5addb9qor" => ["Dur7#5addb9qor", "4", "8", "10", "13"],
"DurMaj7#5addb9qor" => ["Dur7#5addb9qor", "4", "8", "11", "13"],
"Dur6#5add#9qor" => ["Dur6#5add#9qor", "4", "8", "9", "15"],
"Dur7#5add#9qor" => ["Dur7#5add#9qor", "4", "8", "10", "15"],
"DurMaj7#5add#9qor" => ["Dur7#5add#9qor", "4", "8", "11", "15"],
"Dur6#5add11qor" => ["Dur6#5add11qor", "4", "8", "9", "17"],
"Dur7#5add11qor" => ["Dur7#5add11qor", "4", "8", "10", "17"],
"DurMaj7#5add11qor" => ["Dur7#5add11qor", "4", "8", "11", "17"],
"Dur6#5add#11qor" => ["Dur6#5add#11qor", "4", "8", "9", "18"],
"Dur7#5add#11qor" => ["Dur7#5add#11qor", "4", "8", "10", "18"],
"DurMaj7#5add#11qor" => ["Dur7#5add#11qor", "4", "8", "11", "18"],
"Dur6#5add13qor" => ["Dur6#5add13qor", "4", "8", "9", "21"],
"Dur7#5add13qor" => ["Dur7#5add13qor", "4", "8", "10", "21"],
"DurMaj7#5add13qor" => ["Dur7#5add13qor", "4", "8", "11", "21"],
"Dur6#5addb13qor" => ["Dur6#5addb13qor", "4", "8", "9", "20"],
"Dur7#5addb13qor" => ["Dur7#5addb13qor", "4", "8", "10", "20"],
"DurMaj7#5addb13qor" => ["Dur7#5addb13qor", "4", "8", "11", "20"],
"Dur6#5add#13qor" => ["Dur6#5add#13qor", "4", "8", "9", "22"],
"Dur7#5add#13qor" => ["Dur7#5add#13qor", "4", "8", "10", "22"],
"DurMaj7#5add#13qor" => ["Dur7#5add#13qor", "4", "8", "11", "22"],
"Moll" => ["Moll", "0", "3", "7", "12"],
"Mollsus2" => ["Mollsus2", "0", "2", "3", "7"],
"Mollsus4" => ["Mollsus4", "0", "3", "5", "7"],
"Mollb5" => ["Mollb5", "0", "3", "6", "12"],
"Mollb5sus2" => ["Mollb5sus2", "0", "2", "3", "6"],
"Moll#5sus2" => ["Moll#5sus2", "0", "2", "3", "8"],
"MollMaj7" => ["MollMaj7", "0", "3", "7", "11"],
"MollMaj7b5" => ["MollMaj7b5", "0", "3", "6", "11"],
"MollMaj7#5" => ["MollMaj7#5", "0", "3", "8", "11"],
"Moll7" => ["Moll7", "0", "3", "7", "10"],
"Moll7b5" => ["Moll7b5", "0", "3", "6", "10"],
"Moll6" => ["Moll6", "0", "3", "7", "12"],
"Moll6sus2" => ["Moll6sus2", "0", "2", "3", "7"],
"Moll65" => ["Moll65", "0", "3", "7", "9"],
"Moll6add9qor" => ["Moll6add9qor", "3", "7", "9", "14"],
"Moll7add9qor" => ["Moll7add9qor", "3", "7", "10", "14"],
"MollMaj7add9qor" => ["Moll7add9qor", "3", "7", "11", "14"],
"Moll6addb9qor" => ["Moll6addb9qor", "3", "7", "9", "13"],
"Moll7addb9qor" => ["Moll7addb9qor", "3", "7", "10", "13"],
"MollMaj7addb9qor" => ["Moll7addb9qor", "3", "7", "11", "13"],
"Moll6add#9qor" => ["Moll6add#9qor", "3", "7", "9", "15"],
"Moll7add#9qor" => ["Moll7add#9qor", "3", "7", "10", "15"],
"MollMaj7add#9qor" => ["Moll7add#9qor", "3", "7", "11", "15"],
"Moll6add11qor" => ["Moll6add11qor", "3", "7", "9", "17"],
"Moll7add11qor" => ["Moll7add11qor", "3", "7", "10", "17"],
"MollMaj7add11qor" => ["Moll7add11qor", "3", "7", "11", "17"],
"Moll6add#11qor" => ["Moll6add#11qor", "3", "7", "9", "18"],
"Moll7add#11qor" => ["Moll7add#11qor", "3", "7", "10", "18"],
"MollMaj7add#11qor" => ["Moll7add#11qor", "3", "7", "11", "18"],
"Moll6add13qor" => ["Moll6add13qor", "3", "7", "9", "21"],
"Moll7add13qor" => ["Moll7add13qor", "3", "7", "10", "21"],
"MollMaj7add13qor" => ["Moll7add13qor", "3", "7", "11", "21"],
"Moll6addb13qor" => ["Moll6addb13qor", "3", "7", "9", "20"],
"Moll7addb13qor" => ["Moll7addb13qor", "3", "7", "10", "20"],
"MollMaj7addb13qor" => ["Moll7addb13qor", "3", "7", "11", "20"],
"Moll6add#13qor" => ["Moll6add#13qor", "3", "7", "9", "22"],
"Moll7add#13qor" => ["Moll7add#13qor", "3", "7", "10", "22"],
"MollMaj7add#13qor" => ["Moll7add#13qor", "3", "7", "11", "22"],
"Moll6add9roq" => ["Moll6add9roq", "0", "3", "9", "14"],
"Moll7add9roq" => ["Moll7add9roq", "0", "3", "10", "14"],
"MollMaj7add9roq" => ["Moll7add9roq", "0", "3", "11", "14"],
"Moll6addb9roq" => ["Moll6addb9roq", "0", "3", "9", "13"],
"Moll7addb9roq" => ["Moll7addb9roq", "0", "3", "10", "13"],
"MollMaj7addb9roq" => ["Moll7addb9roq", "0", "3", "11", "13"],
"Moll6add#9roq" => ["Moll6add#9roq", "0", "3", "9", "15"],
"Moll7add#9roq" => ["Moll7add#9roq", "0", "3", "10", "15"],
"MollMaj7add#9roq" => ["Moll7add#9roq", "0", "3", "11", "15"],
"Moll6add11roq" => ["Moll6add11roq", "0", "3", "9", "17"],
"Moll7add11roq" => ["Moll7add11roq", "0", "3", "10", "17"],
"MollMaj7add11roq" => ["Moll7add11roq", "0", "3", "11", "17"],
"Moll6add#11roq" => ["Moll6add#11roq", "0", "3", "9", "18"],
"Moll7add#11roq" => ["Moll7add#11roq", "0", "3", "10", "18"],
"MollMaj7add#11roq" => ["Moll7add#11roq", "0", "3", "11", "18"],
"Moll6add13roq" => ["Moll6add13roq", "0", "3", "9", "21"],
"Moll7add13roq" => ["Moll7add13roq", "0", "3", "10", "21"],
"MollMaj7add13roq" => ["Moll7add13roq", "0", "3", "11", "21"],
"Moll6addb13roq" => ["Moll6addb13roq", "0", "3", "9", "20"],
"Moll7addb13roq" => ["Moll7addb13roq", "0", "3", "10", "20"],
"DurMaj7addb13roq" => ["Dur7addb13roq", "0", "4", "11", "20"],
"Dur6add#13roq" => ["Dur6add#13roq", "0", "4", "9", "22"],
"Dur7add#13roq" => ["Dur7add#13roq", "0", "4", "10", "22"],
"DurMaj7add#13roq" => ["Dur7add#13roq", "0", "4", "11", "22"],
"Moll6b5add9qor" => ["Moll6b5add9qor", "3", "6", "9", "14"],
"Moll7b5add9qor" => ["Moll7b5add9qor", "3", "6", "10", "14"],
"MollMaj7b5add9qor" => ["Moll7b5add9qor", "3", "6", "11", "14"],
"Moll6b5addb9qor" => ["Moll6b5addb9qor", "3", "6", "9", "13"],
"Moll7b5addb9qor" => ["Moll7b5addb9qor", "3", "6", "10", "13"],
"MollMaj7b5addb9qor" => ["Moll7b5addb9qor", "3", "6", "11", "13"],
"Moll6b5add#9qor" => ["Moll6b5add#9qor", "3", "6", "9", "15"],
"Moll7b5add#9qor" => ["Moll7b5add#9qor", "3", "6", "10", "15"],
"MollMaj7b5add#9qor" => ["Moll7b5add#9qor", "3", "6", "11", "15"],
"Moll6b5add11qor" => ["Moll6b5add11qor", "3", "6", "9", "17"],
"Moll7b5add11qor" => ["Moll7b5add11qor", "3", "6", "10", "17"],
"MollMaj7b5add11qor" => ["Moll7b5add11qor", "3", "6", "11", "17"],
"Moll6b5add#11qor" => ["Moll6b5add#11qor", "3", "6", "9", "18"],
"Moll7b5add#11qor" => ["Moll7b5add#11qor", "3", "6", "10", "18"],
"MollMaj7b5add#11qor" => ["Moll7b5add#11qor", "3", "6", "11", "18"],
"Moll6b5add13qor" => ["Moll6b5add13qor", "3", "6", "9", "21"],
"Moll7b5add13qor" => ["Moll7b5add13qor", "3", "6", "10", "21"],
"MollMaj7b5add13qor" => ["Moll7b5add13qor", "3", "6", "11", "21"],
"Moll6b5addb13qor" => ["Moll6b5addb13qor", "3", "6", "9", "20"],
"Moll7b5addb13qor" => ["Moll7b5addb13qor", "3", "6", "10", "20"],
"MollMaj7b5addb13qor" => ["Moll7b5addb13qor", "3", "6", "11", "20"],
"Moll6b5add#13qor" => ["Moll6b5add#13qor", "3", "6", "9", "22"],
"Moll7b5add#13qor" => ["Moll7b5add#13qor", "3", "6", "10", "22"],
"MollMaj7b5add#13qor" => ["Moll7b5add#13qor", "3", "6", "11", "22"],
"Moll6#5add9qor" => ["Moll6#5add9qor", "3", "8", "9", "14"],
"Moll7#5add9qor" => ["Moll7#5add9qor", "3", "8", "10", "14"],
"MollMaj7#5add9qor" => ["Moll7#5add9qor", "3", "8", "11", "14"],
"Moll6#5addb9qor" => ["Moll6#5addb9qor", "3", "8", "9", "13"],
"Moll7#5addb9qor" => ["Moll7#5addb9qor", "3", "8", "10", "13"],
"MollMaj7#5addb9qor" => ["Moll7#5addb9qor", "3", "8", "11", "13"],
"Moll6#5add#9qor" => ["Moll6#5add#9qor", "3", "8", "9", "15"],
"Moll7#5add#9qor" => ["Moll7#5add#9qor", "3", "8", "10", "15"],
"MollMaj7#5add#9qor" => ["Moll7#5add#9qor", "3", "8", "11", "15"],
"Moll6#5add11qor" => ["Moll6#5add11qor", "3", "8", "9", "17"],
"Moll7#5add11qor" => ["Moll7#5add11qor", "3", "8", "10", "17"],
"MollMaj7#5add11qor" => ["Moll7#5add11qor", "3", "8", "11", "17"],
"Moll6#5add#11qor" => ["Moll6#5add#11qor", "3", "8", "9", "18"],
"Moll7#5add#11qor" => ["Moll7#5add#11qor", "3", "8", "10", "18"],
"MollMaj7#5add#11qor" => ["Moll7#5add#11qor", "3", "8", "11", "18"],
"Moll6#5add13qor" => ["Moll6#5add13qor", "3", "8", "9", "21"],
"Moll7#5add13qor" => ["Moll7#5add13qor", "3", "8", "10", "21"],
"MollMaj7#5add13qor" => ["Moll7#5add13qor", "3", "8", "11", "21"],
"Moll6#5addb13qor" => ["Moll6#5addb13qor", "3", "8", "9", "20"],
"Moll7#5addb13qor" => ["Moll7#5addb13qor", "3", "8", "10", "20"],
"MollMaj7#5addb13qor" => ["Moll7#5addb13qor", "3", "8", "11", "20"],
"Moll6#5add#13qor" => ["Moll6#5add#13qor", "3", "8", "9", "22"],
"Moll7#5add#13qor" => ["Moll7#5add#13qor", "3", "8", "10", "22"],
"MollMaj7#5add#13qor" => ["Moll7#5add#13qor", "3", "8", "11", "22"],
"dim1" => ["dim1", "0", "1", "2", "3"],
"dim2" => ["dim2", "0", "2", "4", "6"],
"Dim7" => ["Dim7", "0", "3", "6", "9"],
"dim12" => ["dim12", "0", "2", "3", "4"],
"dim13" => ["dim13", "0", "3", "4", "5"],
"dim14" => ["dim14", "0", "4", "5", "6"],
"dim15" => ["dim15", "0", "5", "6", "7"],
"dim16" => ["dim16", "0", "6", "7", "8"],
"dim17" => ["dim17", "0", "7", "8", "9"],
"dim18" => ["dim18", "0", "8", "9", "10"],
"dim19" => ["dim19", "0", "9", "10", "11"],
"dim22" => ["dim22", "0", "3", "5", "7"] );
# Akkordtypenarray
my @chordtypes;
@chordtypes = map { $_ } keys %chordtypes;
# Chroma & Chroma_invers
my %chroma = (
"C-" => 0,
"C" => 1,
"D-" => 2,
"D" => 3,
"E-" => 4,
"E" => 5,
"F-" => 5,
"F" => 6,
"G-" => 7,
"G" => 8,
"A-" => 9,
"A" => 10,
"B-" => 11,
"B" => 12 );
my %chroma_inv = (
"0" => "C-",
"1" => "C",
"2" => "D-",
"3" => "D",
"4" => "E-",
"5" => "E",
"6" => "F",
"7" => "G-",
"8" => "G",
"9" => "A-",
"10" => "A",
"11" => "B-",
"12" => "B" );
my %notevalue = (
"1" => "WHOLE",
"2" => "HALF",
"3" => "QUARTER" );
my %modes = (
Ionisch => ['0', '2', '4', '5', '7', '9', '11'],
Dorisch => ['0', '2', '3', '5', '7', '9', '10'],
Phrygisch => ['0', '1', '3', '5', '7', '8', '10'],
Lydisch => ['0', '2', '4', '6', '7', '9', '11'],
Mixolydisch => ['0', '2', '4', '5', '7', '9', '10'],
Aeolisch => ['0', '2', '3', '5', '7', '8', '10'],
Lokrisch => ['0', '1', '3', '5', '6', '8', '10'],
Vermindert => ['0', '2', '3', '5', '6', '8', '9','11'],
Alteriert => ['0', '1', '3', '4', '6', '8', '10'],
Chromatisch => ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11'],
Chromatischhalba => ['0', '1', '2', '3', '4', '5', '6'],
Chromatischhalbb => ['0', '6', '7', '8', '9', '10', '11'],
Messiaendrei => ['0', '2', '3', '4', '6', '7', '8', '10', '11'],
Messiaenvier => ['0', '1', '2', '5', '6', '7', '8', '11'],
Messiaenfuenf => ['0', '1', '5', '6', '7', '11'],
Messiaensechs => ['0', '2', '4', '5', '6', '8', '10', '11'],
Messiaensieben => ['0', '1', '2', '3', '5', '6', '7', '8', '9', '11'],
Messiaenacht => ['0', '1', '4', '5', '8', '9'],
Mollharmonisch => ['0', '2', '3', '5', '7', '8', '11'],
Mollmelodisch => ['0', '2', '3', '5', '7', '9', '11'] );
## Ermitteln der Tonstrings aus den Modes
my %modenotesstrings;
foreach ( sort { $a <=> $b } keys %chroma_inv ) {
my $grundtonvalue_temp = $_;
print "\n\nMein temporärer Grundton-Wert: $grundtonvalue_temp\n";
my $grundton_temp = $chroma_inv{$grundtonvalue_temp};
print "Mein temporärer Grundton: $grundton_temp\n\n";
foreach ( sort { $a cmp $b } keys %modes ) {
my %modenotes_temp;
my $mode_temp = $_;
print "\nMein aktueller Modus: \"$grundton_temp\"-$mode_temp\n\n";
my $modenotesstring_tmp = "";
my $intervalle_temp_ref = $modes{$_};
my @intervalle = @$intervalle_temp_ref;
foreach ( @intervalle ) {
my $notevalue_temp = $grundtonvalue_temp + $_;
# Doppelt wegen "add9"
if ( $notevalue_temp > 24 ) { $notevalue_temp = $notevalue_temp - 24 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
my $note_temp = $chroma_inv{$notevalue_temp};
print "Mein aktueller Ton: $note_temp\n";
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note_temp =~ m/-/ ) {
$note_temp =~ s/(.)-/$1a/;
} else { $note_temp =~ s/(.)/$1b/ };
if ( not exists $modenotes_temp{$note_temp} ) { $modenotes_temp{$note_temp} = 1 }
}
map { $modenotesstring_tmp = $modenotesstring_tmp.$_ } sort { $a cmp $b } keys %modenotes_temp;
# Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$modenotesstring_tmp =~ s/a/-/g;
$modenotesstring_tmp =~ s/b//g;
print "\nMein erzeugter Tonstring zu \"$grundton_temp\"-$mode_temp:\n$modenotesstring_tmp\n\n";
# sleep 4;
if ( not exists $modenotesstrings{$grundton_temp.'-'.$mode_temp} ) {
$modenotesstrings{'"'.$grundton_temp.'"-'.$mode_temp} = $modenotesstring_tmp }
}
}
# sleep 4;
## Korrektur des Bug-1111 ( "C-" = "B" & vice versa )
foreach ( keys %modenotesstrings ) {
my $string_temp = $_;
if ( $string_temp =~ m/^"C-"/ ) {
my $string_temp_changed = $string_temp;
my $modenotesstring_temp = $modenotesstrings{$string_temp};
$string_temp_changed =~ s/^"C-"/"B-"/;
if ( not exists $modenotesstrings{$string_temp_changed} ) {
$modenotesstrings{$string_temp_changed} = $modenotesstring_temp;
}
delete $modenotesstrings{$string_temp} }
}
# Akkorde und Akkordtonstrings
my %chords_n_strings;
for ( my $noteno = 1; $noteno < 13; $noteno++ ) {
my $grundton_value = $noteno;
my $grundton = $chroma_inv{$grundton_value};
foreach ( @chordtypes ) {
my $chordtype = $_;
my $chordintervall_ref = $chordtypes{$chordtype};
my @chordintervall = @$chordintervall_ref;
# Falls Akkordtyp Quinte ohne Root (qor) oder Root ohne Quinte (roq), dann ...
if ( $chordtype =~ m/^.*qor$/ ) {
# Root für Chordstring nachtragen
push @chordintervall, '0';
} elsif ( $chordtype =~ m/^.*roq$/ ) {
# Reine Quinte für Chordstring nachtragen
push @chordintervall, '7';
}
my %notes_temp;
my $notesstring_cns = "";
foreach ( @chordintervall ) {
if ( $_ eq $chordintervall[0] ) {
print "Akkordtyp: $_\n";
next
}
print "Intervall-Wert: $_\n";
my $note_value = $grundton_value + $_;
print "Noten-Wert: $note_value\n";
# Doppelt wegen "add9"
if ( $note_value > 24 ) { $note_value = $note_value - 24 }
if ( $note_value > 12 ) { $note_value = $note_value - 12 }
if ( $note_value > 12 ) { $note_value = $note_value - 12 }
print "Noten-Wert nach Korrektur: $note_value\n";
my $note = $chroma_inv{$note_value};
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note =~ m/-/ ) {
$note =~ s/(.)-/$1a/;
} else { $note =~ s/(.)/$1b/ };
if ( not exists $notes_temp{$note} ) { $notes_temp{$note} = 1 }
}
map { $notesstring_cns = $notesstring_cns.','.$_ } sort { $a cmp $b } keys %notes_temp;
$notesstring_cns =~ s/^,//;
# Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$notesstring_cns =~ s/a/-/g;
$notesstring_cns =~ s/b//g;
if ( not exists $chords_n_strings{'"'.$grundton.'"-'.$chordtype} ) {
$chords_n_strings{'"'.$grundton.'"-'.$chordtype} = $notesstring_cns
}
}
}
my $ok = '';
my %m1;
my %m2;
my %m3;
my $m4 = '';
# Falls bereits Teile gespeichert sind, laden
if ( -e 'm1_1.str' ) { my $m1_ref = retrieve ('m1_1.str'); %m1 = %$m1_ref }
if ( -e 'm2_1.str' ) { my $m2_ref = retrieve ('m2_1.str'); %m2 = %$m2_ref }
if ( -e 'm3_1.str' ) { my $m3_ref = retrieve ('m3_1.str'); %m3 = %$m3_ref }
if ( -e 'm4_1.str' ) { my $m4_ref = retrieve ('m4_1.str'); $m4 = $$m4_ref }
# Programm
until ( $ok eq 'OK' ) {
system("clear");
print "\nWelche Parts sollen bearbeitet werden? (M1,M2,M3,M4)\n\n";
my $choice = <STDIN>;
chomp $choice;
if ( $choice eq 'M1' ) {
m1();
} elsif ( $choice eq 'M2' ) {
m2();
} elsif ( $choice eq 'M3' ) {
m3();
} elsif ( $choice eq 'M4' ) {
m4();
}
# Check, ob fertig oder nicht
print "\n\n";
print "Bearbeitung beenden? Einfach 'OK' eingeben und Return!\n";
print "Ansonsten Return ohne Eingabe für weitere Bearbeitung(en)!\n";
$ok = <STDIN>;
chomp $ok;
}
# Betrachten der M1-Teile im M4-M3-M2-Zusammenhang
my %m4m3m2m1;
my %metamuster1_teile;
if ( -e 'm4m3m2m1.str' ) {
print "Es existiert bereits eine Speicherung. Übernehmen (j) oder neu anlegen (n)?\n";
my $answer = <STDIN>;
chomp $answer;
if ( $answer eq 'j' ) {
my $m4m3m2m1_ref = retrieve 'm4m3m2m1.str';
%m4m3m2m1 = %$m4m3m2m1_ref;
my $metamuster1_teile_ref = retrieve 'metamuster1_teile.str';
%metamuster1_teile = %$metamuster1_teile_ref;
} elsif ( $answer eq 'n' ) {
# Metamuster1-Teile werden angelegt, erste Modus-Grob-Zuordnung findet statt
metamuster1_und_modi();
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
} else { print "Dös war fei nix!\n"; exit }
} else {
# Metamuster1-Teile werden angelegt, erste Modus-Grob-Zuordnung findet statt
metamuster1_und_modi();
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
## Ausdruck des Hashs
print "\n\n";
print "Die M1-Parts in der M3-M2-Anordnung durchnummeriert:\n\n";
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $nr = $_;
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
print "Nummer $nr\n";
print "M3-Teil: $tmparr[4], M2-Teil: $tmparr[5], M1-Teil: $tmparr[6]\nTaktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
# Änderung Modus-Zuordnungen
print "Vervollständigen onda Ändern der Modus-Zuordnungen!\n\n";
metamuster1_und_modi_edit();
# Erzeugen der übergabefähigen Progression
## Schritt 1: Ergänzen der Modustonstrings
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $nr = $_;
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
print "Nummer $nr\n";
print "M3-Teil: $tmparr[4], M2-Teil: $tmparr[5], M1-Teil: $tmparr[6]\nTaktlänge: $tmparr[1], Akkord: $tmparr[2], Modus: $tmparr[3]\n";
my $modenotesstring_tmp = $modenotesstrings{$tmparr[3]};
print "Modus-Ton-String: $modenotesstring_tmp\n";
$tmparr[7] = $modenotesstring_tmp;
$m4m3m2m1{$nr} = [@tmparr];
}
m4m3m2m1_store();
## Schritt 2: Umbauen in das für den simplechordpattern_creator-3.9.pl erkennbare chordprogression-Format
my @chordprogression;
foreach ( sort { $a <=> $b } keys %m4m3m2m1 ) {
my $tmparr_ref = $m4m3m2m1{$_};
my @tmparr = @$tmparr_ref;
my $string_tmp;
$string_tmp = $tmparr[0];
$string_tmp =~ s/,//g;
$string_tmp = $string_tmp.$tmparr[1].$tmparr[2].':'.$tmparr[3].':'.$tmparr[7].':M1-'.$tmparr[6].':M2-'.$tmparr[5].':M3-'.$tmparr[4];
push @chordprogression, $string_tmp;
}
### Kontrollausdruck + Testspeicherung
print "\nDie Akkordprogression:\n\n";
print map { $_, "\n" } @chordprogression;
print "\n\n";
store \@chordprogression, 'chordprogression-test.str';
sleep 11;
############################################################################################
################################## SUBROUTINEN #####################################
############################################################################################
# Subroutine m1
sub m1 {
# Meldung
print "\nHier ist die Subroutine m1!\n";
# Programm
if ( scalar keys %m1 == 0 ) {
print "\nEs gibt noch keine M1-Parts!\n";
print "Bitte den ersten M1-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte den Akkord angeben!\n";
my $chord = <STDIN>;
chomp $chord;
print "Und als Letztes die Taktlänge ( 1 = ganzer 4/4-, 2 = halber 4/4-Takt )!\n";
my $taktlaenge = <STDIN>;
chomp $taktlaenge;
$m1{$part_first} = "$chord:$taktlaenge";
} else {
print "\nEs gibt folgende M1-Parts!\n\n";
print map { $_, " = ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte den Akkord angeben!\n";
my $chord = <STDIN>;
chomp $chord;
print "Und als Letztes die Taktlänge ( 1 = ganzer 4/4-, 2 = halber 4/4-Takt )!\n";
my $taktlaenge = <STDIN>;
chomp $taktlaenge;
$m1{$part_new} = "$chord:$taktlaenge";
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m1{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m1{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m1{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m1, 'm1_1.str';
}
# Subroutine m2
sub m2 {
# Meldung
print "\nHier ist die Subroutine m2!\n";
# Programm
if ( scalar keys %m2 == 0 ) {
print "\nEs gibt noch keine M2-Parts!\n";
print "Bitte den ersten M2-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte einen M1-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $m1_parts = <STDIN>;
chomp $m1_parts;
$m2{$part_first} = $m1_parts;
} else {
print "\nEs gibt folgende M2-Parts!\n\n";
print map { $_, " = ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte einen M1-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $m1_parts = <STDIN>;
chomp $m1_parts;
$m2{$part_new} = $m1_parts;
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m2{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M1-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m1{$_}, "\n" } sort { $a cmp $b } keys %m1;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m2{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m2{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m2, 'm2_1.str';
}
# Subroutine m3
sub m3 {
# Meldung
print "\nHier ist die Subroutine m3!\n";
# Programm
if ( scalar keys %m3 == 0 ) {
print "\nEs gibt noch keine M3-Parts!\n";
print "Bitte den ersten M3-Teil benennen und anlegen!\n";
print "Es sind Klein-, Großbuchstaben, Ziffern und Kombinationen aus allen möglich.\n\n";
print "Der erste Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_first = <STDIN>;
chomp $part_first;
print "Nun noch bitte einen M2-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $m2_parts = <STDIN>;
chomp $m2_parts;
$m3{$part_first} = $m2_parts;
} else {
print "\nEs gibt folgende M3-Parts!\n\n";
print map { $_, " = ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\nSoll ein Teil hinzugefügt (a), ein Teil bearbeitet (e) oder ein Teil gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'a' ) {
print "Der neue Teil soll wie benannt sein? Bitte Eingabe + Return!\n";
my $part_new = <STDIN>;
chomp $part_new;
print "Nun noch bitte einen M2-Teil oder mehrere - mit Doppelpunkt getrennt - angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $m2_parts = <STDIN>;
chomp $m2_parts;
$m3{$part_new} = $m2_parts;
} elsif ( $choice_cont eq 'e' ) {
print "Welcher Teil soll bearbeitet werden? Bitte Eingabe + Return!\n";
my $part_2edit = <STDIN>;
chomp $part_2edit;
print "Der zu bearbeitende Eintrag ist: ", $m3{$part_2edit}, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M2-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m2{$_}, "\n" } sort { $a cmp $b } keys %m2;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m3{$part_2edit} = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
print "Welcher Teil soll gelöscht werden? Bitte Eingabe + Return!\n";
my $part_2del = <STDIN>;
chomp $part_2del;
delete $m3{$part_2del};
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \%m3, 'm3_1.str';
}
# Subroutine m4
sub m4 {
# Meldung
print "\nHier ist die Subroutine m4!\n";
# Programm
if ( $m4 eq '' ) {
print "\nEs ist noch keine M4-Reihenfolge der M3-Parts festgelegt!\n";
print "Bitte die M4-Reihenfolge angeben!\n";
print "Die M3-Teile bitte mit Doppelpunkt getrennt angeben!\n";
print "Es stehen folgende zur Verfügung:\n\n";
print map { $_, " : ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\n\n";
$m4 = <STDIN>;
chomp $m4;
} else {
print "\nEs existiert die folgende Anordnung der M3-Parts:\n\n";
print $m4, "\n";
print "\nSoll diese Anordnung bearbeitet (e) oder gelöscht (d) werden?\n";
my $choice_cont = <STDIN>;
chomp $choice_cont;
if ( $choice_cont eq 'e' ) {
print "Der zu bearbeitende Eintrag ist: ", $m4, "\n";
print "Bitte den Ersatztext im gleichen Format eingeben!\n\n";
print "Es stehen folgende M3-Teile zur Verfügung:\n\n";
print map { $_, " : ", $m3{$_}, "\n" } sort { $a cmp $b } keys %m3;
print "\n\n";
my $part_edited = <STDIN>;
chomp $part_edited;
$m4 = $part_edited;
} elsif ( $choice_cont eq 'd' ) {
$m4 = '';
} else { print "Eingabe nicht passend!\n" }
}
# Zwischenspeichern
store \$m4, 'm4_1.str';
}
# Subroutine mode_chords_strings
sub modes_strings {
# Rückmeldung
print "Hier ist die Subroutine modes_strings!\n\n";
# Übergaben
my $grundton_value = shift;
my $akkord_ms = shift;
print "Der übergebene Grundton-Wert ist: $grundton_value\n\n";
print "Der übergebene Akkord ist: $akkord_ms\n\n";
## Grundton
my $grundton = $chroma_inv{$grundton_value};
print "Der übergebene Grundton ist: $grundton\n\n";
## Ermittlung der Intervalle + Töne, die im Akkord vorkommen
my %chordnotes_ms;
my $intervalle_ref = $chordtypes{$akkord_ms};
my @intervalle = @$intervalle_ref;
foreach ( @intervalle ) {
if ( $_ eq $intervalle[0] ) { next }
my $notevalue_temp = $grundton_value + $_;
# Doppelt wegen "add9"
if ( $notevalue_temp > 24 ) { $notevalue_temp = $notevalue_temp - 24 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
if ( $notevalue_temp > 12 ) { $notevalue_temp = $notevalue_temp - 12 }
my $note_temp = $chroma_inv{$notevalue_temp};
if ( not exists $chordnotes_ms{$note_temp} ) { $chordnotes_ms{$note_temp} = 1 }
}
print "Array der Intervalle:\n\n";
print join (" :: ", map { $_ } @intervalle);
print "\n\n";
print "Array der Töne:\n\n";
print join (" :: ", map { $_ } keys %chordnotes_ms);
print "\n\n";
## Ermitteln des Tonstrings aus dem Akkord
my $notesstring_ms = "";
map { $notesstring_ms = $notesstring_ms.$_ } sort { $a cmp $b } keys %chordnotes_ms;
print "Der ermittelte Tonstring ist: $notesstring_ms\n\n";
# sleep 4;
### Kontrolldruck der Modalton-Strings
print "\nMeine ", scalar keys %modenotesstrings, " Modalton-Strings:\n\n";
print join ("\n", map { $_." = ".$modenotesstrings{$_} } sort { $a cmp $b } keys %modenotesstrings);
print "\n\n";
## Vergleich des Akkordstrings mit den Modalton-Strings
my @matchmodes_ms;
my $string2compare_regex = $notesstring_ms;
$string2compare_regex =~ s/([ABCDEFG]-*)/$1,/g;
### Regex-String muß umsortiert werden!
my $string2compare_new = "";
my @tempsort = split (",",$string2compare_regex);
my %tempsort;
foreach ( @tempsort ) {
my $note_temp = $_;
# Wegen Sortierung muß vorübergehend Ton ohne '-' zu Ton mit 'b', Ton mit '-' zu Ton mit 'a' werden
if ( $note_temp =~ m/-/ ) {
$note_temp =~ s/(.)-/$1a/;
} else { $note_temp =~ s/(.)/$1b/ };
if ( not exists $tempsort{$note_temp} ) { $tempsort{$note_temp} = 1 }
}
map { $string2compare_new = $string2compare_new.'.*'.$_.',' } sort { $a cmp $b } keys %tempsort;
### Die vorübergehende Umbenennung wird wieder rückgängig gemacht
$string2compare_new =~ s/a/-/g;
$string2compare_new =~ s/b//g;
### Übergabe des korrigierten Strings an die alte Variable
$string2compare_regex = $string2compare_new.'.*';
### Vergleich
print "\nMein zu vergleichender Regex-Ton-String: $string2compare_regex\n\n";
# sleep 4;
foreach ( keys %modenotesstrings ) {
my $string_temp = $modenotesstrings{$_};
# sleep 4;
$string_temp =~ s/([ABCDEFG]-*)/$1,/g;
print "Temporärer String ist jetzt: $string_temp\n";
my $mode_temp = $_;
if ( $string_temp =~ m/$string2compare_regex/ ) {
print "Hiphip-hooray! ";
print "$mode_temp ist möglich!\n";
print "Modal-Ton-String: $string_temp\n";
print "Ton-String: $notesstring_ms\n\n";
push @matchmodes_ms, $mode_temp;
}
}
## Ausgabe der Möglichkeiten
my $grundton_readable = $grundton;
$grundton_readable =~ s/-/b/;
print "\nEs gibt ", scalar @matchmodes_ms, " Modus-Möglichkeiten für \"$grundton_readable\"-$akkord_ms!\n\n";
print "\n";
# Übergabe der ermittelten Informationen
return (\@matchmodes_ms,$notesstring_ms)
}
# Subroutine metamuster1_und_modi
sub metamuster1_und_modi {
# Meldung
print "\nHier ist die Subroutine metamuster1_und_modi!\n";
# Programm
my %matchmodi;
foreach ( keys %m1 ) {
my $m1_part = $_;
my @m1part;
my $chord = $m1{$m1_part};
$chord =~ s/^(.*):.*$/$1/;
my $value = $m1{$m1_part};
$chord =~ s/^.*:(.*)$/$1/;
$chord =~ s/^(.*)(-.*)$/"$1"$2/;
$chord =~ s/"(.)b"/"$1-"/;
print "Akkord: $chord\n";
my $notes = $chords_n_strings{$chord};
$value =~ s/^.*:(.*)$/$1/;
$value =~ s/1/WHOLE/;
$value =~ s/2/HALF/;
$value =~ s/4/QUARTER/;
$m1part[0] = $notes;
$m1part[1] = $value;
$chord =~ s/"-//;
$chord =~ s/"//;
$m1part[2] = $chord;
# Die häufigst möglichen Modi ermitteln
my $grundton = $chord;
my $akkord_typ = $chord;
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
foreach ( @matchmodes_temp ) {
if ( not exists $matchmodi{$_} ) { $matchmodi{$_} = 1 }
else { $matchmodi{$_} = $matchmodi{$_} + 1 }
}
# Array dem Part zuordnen
$metamuster1_teile{$m1_part} = [@m1part];
}
# Kontrolldruck
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Töne: $tmparr[0], Taktlänge: $tmparr[1], Akkord: $tmparr[2]\n";
}
print "\n\n";
foreach ( sort { $matchmodi{$a} <=> $matchmodi{$b} } keys %matchmodi ) {
print "Anzahl des Vorkommens: $matchmodi{$_} des Modus: $_\n"
}
print "\n\n";
# Modi-Zuordnung
print "\nWelcher Modus soll - wenn möglich - den M1-Teilen zugeordnet werden?\n";
my $wunschmodus = <STDIN>;
chomp $wunschmodus;
foreach ( keys %metamuster1_teile ) {
print $_, "\n";
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
# Test, ob der Wunschmodus zum M1-Teil passt
# Die häufigst möglichen Modi ermitteln
my $grundton = $tmparr[2];
my $akkord_typ = $tmparr[2];
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
my %matchmodes_temp;
foreach ( @matchmodes_temp ) {
if ( not exists $matchmodes_temp{$_} ) { $matchmodes_temp{$_} = 1 }
}
if ( exists $matchmodes_temp{$wunschmodus} ) {
$tmparr[3] = $wunschmodus
} else {
$tmparr[3] = 'Modus noch nicht bestimmt!'
}
# Array dem Part zuordnen
$metamuster1_teile{$_} = [@tmparr];
}
store \%metamuster1_teile, 'metamuster1_teile.str';
}
# Subroutine metamuster1_und_modi_edit
sub metamuster1_und_modi_edit {
# Meldung
print "\nHier ist die Subroutine metamuster1_und_modi_edit!\n\n";
# Programm
my $editflag = '';
until ( $editflag eq 'q' ) {
# Übersichtsdruck
foreach ( keys %metamuster1_teile ) {
my $part = $_;
my $tmparr_ref = $metamuster1_teile{$_};
my @tmparr = @$tmparr_ref;
print "Teil: $part => Akkord: $tmparr[2], Modus: $tmparr[3]\n";
}
print "\n\n";
# Bei welchem Teil soll der Modus geändert/hinzugefügt werden?
print "Welchem Teil Modus ändern bzw. zuordnen?\n\n";
my $part2edit = <STDIN>;
chomp $part2edit;
if ( not exists $metamuster1_teile{$part2edit} ) {
print "FEHLER, FEHLER!!\n\n";
} else {
my $arr2edit_ref = $metamuster1_teile{$part2edit};
my @arr2edit = @$arr2edit_ref;
print "Teil: $part2edit => Akkord: $arr2edit[2], Modus: $arr2edit[3]\n";
print "Welcher Modus soll zugeordnet werden?\n\n";
print "Passende Modi anzeigen lassen? (j/n)\n\n";
my $showmodi = <STDIN>;
chomp $showmodi;
my @matchmodi;
if ( $showmodi eq 'j' ) {
my $matchmodi_ref = showmodi($arr2edit[2]);
@matchmodi = @$matchmodi_ref;
}
foreach my $nr ( 0..((scalar @matchmodi)-1) ) {
print $nr, ": $matchmodi[$nr]\n";
}
print "\nBitte den Modus jetzt eingeben (Nummer reicht {geht auch gar nicht anders ;-)})!\n\n";
my $wishmode = <STDIN>;
chomp $wishmode;
$wishmode = $matchmodi[$wishmode];
$arr2edit[3] = $wishmode;
$metamuster1_teile{$part2edit} = [@arr2edit];
}
# Änderungen beenden oder fortfahren
print "Weiter ändern ( Return ) oder beenden ( q + Return ) ?\n\n";
$editflag = <STDIN>;
chomp $editflag;
}
# Speichern oder nicht?
print "Änderungen speichern? (j/n)?\n\n";
my $save = <STDIN>;
chomp $save;
if ( $save eq 'j' ) {
store \%metamuster1_teile, 'metamuster1_teile.str';
# Aktualisieren und Speichern des m4m3m2m1-Hash
m4m3m2m1_refresh();
} else {
print "Änderungen wurden nicht gespeichert!\n\n";
}
}
# Subroutine showmodi
sub showmodi {
# Meldung
print "\nHier ist die Subroutine showmodi!\n\n";
# Übernahme
my $chord2check = shift;
# Programm
my $grundton = $chord2check;
my $akkord_typ = $chord2check;
$grundton =~ s/^(.-*).*$/$1/;
$akkord_typ =~ s/^$grundton(.*)$/$1/;
my $grundton_val = $chroma{$grundton};
my ($matchmodes_temp_ref,$notesstring_void) = modes_strings($grundton_val,$akkord_typ);
my @matchmodes_temp = @$matchmodes_temp_ref;
# Übergabe
return \@matchmodes_temp;
}
# Subroutine m4m3m2m1_refresh
sub m4m3m2m1_refresh {
# Meldung
print "\nHier ist die Subroutine m4m3m2m1_refresh!\n\n";
# Programm
## Erzeugen des M4M3M2M1-Hashs mit Nummerierung
%m4m3m2m1 = ();
my $nr = 0;
my @m3_parts = split ( ":", $m4 );
foreach ( @m3_parts ) {
my $m3_part = $_;
my $m2_parts = $m3{$m3_part};
my @m2_parts = split ( ":", $m2_parts );
foreach ( @m2_parts ) {
my $m2_part = $_;
my $m1_parts = $m2{$m2_part};
my @m1_parts = split ( ":", $m1_parts );
foreach ( @m1_parts ) {
my $m1_part = $_;
my $tmparr_ref = $metamuster1_teile{$m1_part};
my @tmparr = @$tmparr_ref;
$tmparr[4] = $m3_part;
$tmparr[5] = $m2_part;
$tmparr[6] = $m1_part;
$nr++;
$m4m3m2m1{$nr} = [@tmparr];
}
}
}
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
# Subroutine m4m3m2m1_refresh
sub m4m3m2m1_store {
# Meldung
print "\nHier ist die Subroutine m4m3m2m1_store!\n\n";
### Speichern des Hash
store \%m4m3m2m1, 'm4m3m2m1.str';
}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Weiterer Bonus
Zwei große Pioniere
Hembelsche Quizfrage:
Wer erkennt die zwei, die eigentlich jeder kennt?
Auflösung:
lǝʞunɟɹɐƃ‾62%‾uoɯıs/ıʞıʍ/ƃɹo˙ɐıpǝdıʞıʍ˙uǝ//:sdʇʇɥ
............................................................................................................
............................................................................................................
Tschernobyl – just for fun! | NZZ
Istanbul: Der neue Star der Politik | ZEIT ONLINE
Saudi-Arabien: Hinrichtung! Mann (21) wegen WhatsApp-Nachricht geköpft - Politik Ausland - Bild.de
Die Grünen sind die neuen Liberalen - Politik - Süddeutsche.de
Nach Wahl-Fiasko richtet sich Erdogans Zorn plötzlich auf die eigenen Reihen - FOCUS Online
Transplants (band) - Wikipedia
Tim Timebomb - Wikipedia Billie Joe Armstrong - Wikipedia
Wake Me Up When September Ends - Wikipedia
William S. Burroughs – Wikipedia
Naked Lunch (Roman) – Wikipedia
Todesstrafe in Österreich: Tod am Wiener Würgegalgen. Was für eine „Mordsgaudi“ - WELT
Ersteinsatz der Guillotine: Ein dumpfer Schlag – und der Kopf war weg - WELT
„Bad Banks“: So viel Realität steckt in der ZDF-Serie
ABBA: "Does Your Mother Know" zu sexistisch? - klatsch-tratsch.de
"Game of Thrones": Drei Fluggeschosse, eine Beschützerin, ein Sexgott und eine Nervbacke | ZEIT ONLINE
"Game of Thrones": Ein kalter König, ein Hundsguter, eine junge Frau und ihre Schwester | ZEIT ONLINE
Interview zu Rechtspopulismus | Diese Passage lief nicht im „Heute Journal“ - Politik Inland - Bild.de
Gemälde „Sklavenmarkt“: US-Museum fordert AfD zum Abhängen von Plakaten auf - FOCUS Online
Kalifornien: Mann in Sunnyvale rast in Menschengruppe - Polizei vermutet Hassverbrechen - SPIEGEL ONLINE
Sibylle Berg in den Wagenhallen: „Ich mache Sie heute alle depressiv“ - Kultur - Stuttgarter Zeitung
Börsenaufsicht: Elon Musk muss Tweets zu Tesla vorab prüfen lassen | ZEIT ONLINE
"Histoire De Melody Nelson" von Serge Gainsbourg – laut.de – Album
Rammstein – laut.de – Band
Weizenbier – Wikipedia
Schwarzbier – Wikipedia
Pia Bohr – Vita | Bohr Skulpturen
Phillip Boa – Wikipedia
1105 Gäste angeblich betroffen: Coachella-Festival hat ein Genitalherpes-Problem - WELT
Maschinenethik: An diese Spielregeln sollten sich Sexpuppen halten - WELT
Rammstein präsentieren neuen Song "Radio" auf Berliner Straßenkreuzung - SPIEGEL ONLINE
"Gorch Fock": Fall Jenny Böken – Geschah ein Mord an Bord?
Gipfel in Wladiwostok: Wie Putin Nordkoreas Kim düpierte - WELT
Wladiwostok : Kim Jong Un lädt Wladimir Putin nach Nordkorea ein | ZEIT ONLINE
Konzert in Köln: Dolly Parton beeindruckt in der Lanxess-Arena | Kölnische Rundschau
Jolene (Lied) – Wikipedia
About Schmidt (Film) – Wikipedia
Easy Rider – Wikipedia
jools Holland and the fabulous wealthy tarts 1984 - YouTube
Jet Airliner (Steve Miller Band song) - Wikipedia
Tierheim Wiehl Koppelweide Tierschutzvereine Tierheime Hunde Katzen Kleintiere
Kommentare
Kommentar veröffentlichen