Midi Harmonizer

[Fléau]

Hello usiners,
let's talk about a project that started in the french forum:
http://www.sensomusic.com/forums/viewtopic.php?id=3402.

actually there are 3 goal for this patch:
1- rescale a midi note to chosen scale (major,minor etc)
2- detect a played chord (ex major,major7,minor,diminished...)
3- play arpegio according to goal 1&2

Goal 1 is done:
download: midi note scaler



Goal 2:
-chord database is built
-chord isolator & comparator are near to be finished

Goal 3:
waiting for goal 2 finished,
but, same as in the french forum, i'm waiting suggestions to make this arpegiator sexy!

Will give you news when the chord detector will be patched.

Now i need help from someone who script, to make it lighter and simpler.
Here is a function that is used a lot there:
remove zeros from an array and resize it.



If someone could help me there it would be great.

Fléau.

[caco]

Fléau I really like the use of the dec2bin module, that is an ingenious way of storing the scale patterns

If nobody else has time for your script I will have a go for you tomorrow, I am learning Usine's script language at the moment so it will be good practice for me

[Fléau]

Yes, efficient way.
I remember that module is yours, it was me and my sister (berenice) who asked for it.
That's a great module!

[seamus]

Is it possible to have this work with chordal input? I was using the moody note scaler with chords being input into it and it constrained the notes to scale. This note scaler seems to only work on monophonic input. I would love to use yours as the scale and key options are fantastic!

[seamus]

http://www.sensomusic.com/forums/upload ... hannel.JPG

i figured out a way. this is great!

[seamus]

one interesting function that maybe could be added which i used to have on an old digitech dhp-33 harmonizer was the ability to have non-scale tones treated in different ways. I like having my lead voice be chromatic and the harmonized voices forced to scale. Non chord tones could be treated with another scaler so that for example if you were harmonizing in f dominant but you played an F# then the harmonized notes would harmonize to say a diminished scale. Im not sure how to add this feature quite yet. Still a newbie!

[Fléau]

It is monophonic just for the test, when scale and a key are selected you can only play degree I II III IV V VI VII,
When the chord detector will be patched you'll be able to link the tonic key to the root key, and it'll be polyphonic.

Not sure to understand, but it may be possible with a dual chord detector,
actually i didn't found a way to detect if you play a triad or a 13th so i may add a fader to limit input note number,
so you'll be able to use one seventh chord detector where you input your chord, and a 13th one
where you input your chord + additionals tones to detect the closest limited chord/scale.

Edit: midi make monophonic script is here just for my test, you can remove it, polyphony works here.

[seamus]

http://www.sensomusic.com/forums/upload ... scaler.pat


here i added a harmonizer in front. Multiple scalers but all sharing the same presets.

Brilliant Fleau thanks for your great work!

[bsork]

Fléau I really like the use of the dec2bin module, that is an ingenious way of storing the scale patterns

Agreed! The only problem is the behaviour of the list/combo boxes when using text/value pairs, as it will jump to the first item with the chosen value when the value is repeated. Confusing, but in this case educational, as you learn that scales with different names are in fact alike.

If nobody else has time for your script I will have a go for you tomorrow, I am learning Usine's script language at the moment so it will be good practice for me

If you don't find the time Caco, I think I can do it tonight. It shouldn't take many lines of code.

[Fléau]

The only problem is the behaviour of the list/combo boxes when using text/value pairs, as it will jump to the first item with the chosen value when the value is repeated..

agreed

Confusing, but in this case educational, as you learn that scales with different names are in fact alike..

That's why i didn't removed duplicates.
I could patch an 'educational button' to switch between two list.
Here are the duplicates:
duplicate.txt
What are the ones i should keep?

Thanks for the support.

[bsork]

I'm not the right person to ask - my knowledge in this area is rather limited. Actually, the only scales I remember the names of, are standard major and minor, which makes this patch al the more interesting for me.

[caco]

Here is my first version of the script to removes zero values from an array. Only had a quick test so far but it seemed to work okay so let me know what bugs you spot. Bsork feel free post a better version

Code: Select all

///////////////////////////////////////////////////////////////////////////////
// Function: Removes any zero values from an array 
// Version : 1.0
// Date : 12 June 2012
//////////////////////////////////////////////////////////////////////////////
// variables declaration
Var ArrayIn, ArrayOut : tparameter;
Var non_zero, i, j : integer;
// initialisation : create parameters
procedure init;
begin  
	ArrayIn:= createParam('Array in', PtArray); 
	SetIsOutput(ArrayIn,false);
	ArrayOut:= createParam('Array out', PtArray);         
	SetIsInput(ArrayOut,false);
end;

// Callback procedure
Procedure Callback(N:integer); 
begin
	if (N=ArrayIn)  then begin
		non_zero := 0;
		i := 0;
		j := 0;
		//count non-zero elements
		for i:= 0 to GetLength(ArrayIn)-1 do begin
			If  GetDataArrayValue&#40;ArrayIn, i&#41;  <> 0  then begin
				non_zero &#58;= non_zero + 1;
			 end;
		end;	
		//set output array to size of non zero elements
		SetLength&#40;ArrayOut, non_zero&#41;;
		//copy only non_zero elements to output
		for i&#58;= 0 to GetLength&#40;ArrayIn&#41;-1  do begin
			If  GetDataArrayValue&#40;ArrayIn, i&#41;  <> 0  then begin
				SetDataArrayValue&#40;ArrayOut, j, GetDataArrayValue&#40;ArrayIn, i&#41;&#41;; 
				j &#58;= j + 1;
			end;
		end;	
	end;
end;
//////////////////////////////
// main proc
//////////////////////////////
Procedure Process;
begin

end;

[bsork]

Had to take the challenge...

Your script works just fine, but could be a bit more efficient:

Code: Select all

Var ArrayIn, ArrayOut : tparameter;
// initialisation : create parameters
procedure init;
begin  
    ArrayIn:= createParam('Array in', PtArray); 
    SetIsOutput(ArrayIn,false);
    ArrayOut:= createParam('Array out', PtArray);         
    SetIsInput(ArrayOut,false);
end;

// Callback procedure
Procedure Callback(N:integer); 
  Var i, j : Integer;
begin
    if (N=ArrayIn)  then begin
        j := 0;
        for i:= 0 to GetLength(ArrayIn)-1 do begin
            If &#40;GetDataArrayValue&#40;ArrayIn, i&#41;  <> 0&#41; then begin
               SetDataArrayValue&#40;ArrayOut, j, GetDataArrayValue&#40;ArrayIn, i&#41;&#41;;
               j &#58;= j + 1;
            end;
        end;    
        SetLength&#40;ArrayOut, j&#41;;
    end;
end;

You can set the length after filling in the values, even if the new length is longer than the previous. AFAIK there shouldn't be any problems with that. I haven't done it much (if ever) with data arrays, but a lot of times with Midi arrays.

Besides, if you don't need Process - skip it. I don't know if it really matters and it's being called the engine when the procedure is empty, but in this case there's no need for it. I think you can do that with all the standard procedures: Init, Destroy, Callback and Process when they're not needed.

[caco]

Thanks for the feedback bsork. Not too bad for my first proper script, after many years using C++ and R the Pascal syntax feels unnatural to me with all its begins and ends, I miss my curly braces...

I do like the scripts though, it was very quick to create I can see myself starting to use them now in some cases instead of SDK to save time. I have been avoiding them so far but the language is pretty easy to pick up.

I didn't realize you could write to data arrays prior to resizing them, that makes things easier. In the SDK you can set DontProcess==TRUE if you do not need the audio processing to be called, maybe scripts have something similar?

[bsork]

Not bad indeed for a first try!

...and your post reminds me that it's about time I got into the SDK. Long time since I've done much with curly braces, though, and I've never used C++, which I must admit I find quite confusing. I'm not much of an OO programmer...

Regarding DontProcess or similar, I can't recall anything like that. I've just taken it for granted that if Process isn't declared, nothing happens. Well, maybe a couple of CPU cycles to find that there's nothing to do, but not much more. Any comments from the boss?

[Fléau]

Ok it works,
my patch was taking 0.04% cpu
caco script 0.03%
bsork script 0.02%
need to repace them all, and then 'chord detector' will be finished (it works yet)
many thanks!

need your advice:
should i make restricted scale list or should i patch a switch to chose between restricted/educational?

[tanabarbier]

Maybe I don't get the recurency problem, but I propose only one list with all the names of the same scale for each scale, both educational and practical?
like "pentatonic major / chinese mongolian"=661
etc ?
Anyway thanks a lot for this work, it's gonna be a HIT among the growing Usine community!

[Fléau]

@bsork:
I've found a better solution to compare chords, using your 'array find' script,
but it don't work with my array and i can't find why.
here is the workspace:
http://www.sensomusic.com/forums/upload ... %20bug.wkp

[bsork]

I'm looking into it. There's a bug when there are repeated values in the array. Probably just something really stupid, but I just can't see where the problem lies tonight... :/

If anyone else feels compelled to have a go at it - please do!

[Fléau]

Got it!:)

BEGIN
r := -1;
IF (((lenA - startA) >= lenB) AND (lenB > 0)) THEN BEGIN
b := 0;
// bx := GetDataArrayValue(pArrB, b); THIS LINE (42 i think)
FOR a := startA TO (lenA - 1) DO BEGIN
ax := GetDataArrayValue(pArrA, a);
bx := GetDataArrayValue(pArrB, b); HAD TO BE PLACED HERE
IF (ax = bx) THEN BEGIN
IF (b = 0) THEN r := a;
b := b + 1;
IF (b = lenB) THEN BREAK;
bx := GetDataArrayValue(pArrB, b);
END
ELSE BEGIN
b := 0;
r := -1;
END;
IF ((lenA - a - 1) < (lenB - b)) THEN BEGIN
r := -1;
BREAK;
END
END;
END;
SetValue(pResult, r);
doFind := FALSE;
END; // Find

Need to learn scripting,
what is the used language?

[caco]

Was just about to post the same thing, bx does not get updated in the FOR loop.

@Fléau - The scripting language used is based on Delphi.

[bsork]

Great that you've found a solution!

I think, however, that I can make the script somewhat more efficient by doing things in another order. Will probably do it tonight.

[bsork]

I've tried the suggestion, but It didn't do help anything. I've rewritten the script, and as far as I can tell, it should work now, also where there are equal values after another. It's maybe not (noticably) more efficient than the old one, but it's a little bit more compact, and I managed to avoid BREAKs, which I'm no fan of.

Here it is:

Code: Select all

////////////////////////////////////////////////////////////////////////////////
// ArrayFind.script
// Returns the array index where array B is first found in array A, with an
// optional start index for array A. If no matches, the result is -1.
//
// The returned index in A is the "real" index; the start offset is not 
// subtracted from the result.
//
// bSork, V2 June 2012
////////////////////////////////////////////////////////////////////////////////

VAR pArrA, pStartA, pArrB, pResult : tParameter;

PROCEDURE Init;
BEGIN
   pArrA := CreateParam('array A', ptArray); SetIsOutput(pArrA, FALSE);
   SetMin(pArrA, -1000000000);    SetMax(pArrA, +1000000000);

   pStartA := CreateParam('start index A', ptDataFader); SetIsOutput(pStartA, FALSE);
   SetMin(pStartA, 0); SetMax(pStartA, 8191); SetFormat(pStartA, '%.0f');
   SetDefaultValue(pStartA, 0);

   pArrB := CreateParam('array B', ptArray); SetIsOutput(pArrB, FALSE);
   SetMin(pArrB, -1000000000);    SetMax(pArrB, +1000000000);

   pResult := CreateParam('result', ptDataField); SetIsInput(pResult, FALSE);
   SetMin(pResult, -1); SetMax(pResult, 8191); SetFormat(pResult, '%.0f');
   SetValue(pResult, 0);
END; // Init

PROCEDURE Find;
   VAR lenA, lenB : Integer;
   VAR r, a, a2, b : Integer;
   VAR bx : Single;
   VAR found : Boolean;
BEGIN
   r := -1;
   lenB := GetLength(pArrB);
   IF (lenB > 0) THEN BEGIN
      b := 0;
      bx := GetDataArrayValue(pArrB, b);
      a := round(GetValue(pStartA));
      lenA := GetLength(pArrA);
      WHILE ((r = -1) AND ((lenA - a) >= lenB)) DO BEGIN
         found := (bx = GetDataArrayValue(pArrA, a));
         IF (found) THEN BEGIN
            a2 := a + 1;
            b := 1;
         END;
         WHILE &#40;found AND &#40;b < lenB&#41;&#41; DO BEGIN
            found &#58;= &#40;GetDataArrayValue&#40;pArrA, a2&#41; = GetDataArrayValue&#40;pArrB, b&#41;&#41;;
            a2 &#58;= a2 + 1;
            b &#58;= b + 1;
         END;
         IF &#40;found AND &#40;b = lenB&#41;&#41; THEN
            r &#58;= a
         ELSE
            b &#58;= 0;
         a &#58;= a + 1;
      END;
   END;
   SetValue&#40;pResult, r&#41;;
END; // Find

PROCEDURE Callback&#40;n &#58; Integer&#41;;
BEGIN
   IF &#40;n <= pArrB&#41; THEN
      Find;
END; // Callback

Hope it works for you!

I'll replace the old one in the add-ons as well.

[caco]

A nice elegant solution bsork

[Fléau]

I'm about post the latest version but scripting make me sick

Code: Select all

var input   : Tparameter;
var output  : Tparameter;
var transpo : TParameter;
var voices  : TParameter;

procedure init;
begin  
 Input := CreateParam('In',ptMidi);
 Output := CreateParam('Out',ptMidi);
 transpo := CreateParam('transpo',ptDataFader);
 voices := CreateParam('voices',ptDatafield);

 SetIsInput(Output,false);
 SetIsOutPut(Input,false);
 SetIsOutPut(transpo,false);
 SetFormat(transpo,'%.0f');
 SetIsInput(voices,false);
 SetMin(transpo,-24);
 SetMax(transpo,24);

end;

var i            : integer;
var nbOfMidi     : integer;
var ReceivedMidi : TMidi;
var TranspoVal   : single;

//////////////////////////////
// main proc
//////////////////////////////
procedure Process;
begin
 nbOfMidi := GetLength(input);  // get the number of incoming midi codes 
 if nbOfMidi > 0 
 then begin
    SetLength(outPut,nbOfMidi);      // set the number of output codes
    transpoVal := getValue(transpo); // get the transpo value
    for i := 0 to nbOfMidi-1         // loop for all input codes, for polyphonic data (chords)
    do begin
      GetMidiArrayValue(input,i,ReceivedMidi); // get each code
      ReceivedMidi.data1 := ReceivedMidi.data1+trunc(transpoVal); // calculate transpo
      SetMidiArrayValue(output,i,ReceivedMidi); // set output value     
    end;
 end 
 else SetLength(outPut,0); // nothing received, set out length to 0
end;

I added:
var voices : TParameter;
voices := CreateParam('voices',ptDatafield);
SetIsInput(voices,false);

i'd like to get
voices := nbOfMidi; (number of note on)
tried to place this line everywhere in the process but nothing happen,
what i'm doing wrong?

[caco]

I suspect the line you are looking for is

Code: Select all

SetValue(voices, nbOfMidi );

This will assign the value of nbOfMidi to the parameter called voices

I do not think this will not work as you hope though as nbOfMidi will only be greater than zero for the actual BLOC (e.g 64, 128 samples etc) that you receive the MIDI messages in. After that it will go back to zero. It will not give you the number of actual MIDI messages currently switched on.

[bsork]

Counting the number of sounding notes could be done with not too many modules, but I thought that what you were after was a subset of the Transpose script in the Midi Utility pack, so I dug it up, removed most of the code and added an extra output with the number of notes:

Code: Select all

CONST BUFFER_SIZE = 128;

// MIDI channel messages
CONST NOTEOFF = Byte(128);
CONST NOTEON  = Byte(144);

TYPE tMidiArr = ARRAY OF tMidi;

TYPE tNoteOns = RECORD
        origChannel : Byte;
        origNoteNo  : Byte;
        outChannel  : Byte;
        outNoteNo   : Byte;
     END;

VAR pMidiIn, pMidiOut1 : tParameter;
VAR pTranspose, pNumNotes : tParameter;

VAR sentNoteOns : ARRAY OF tNoteOns;
VAR numIn, numSentNoteOns, numOut1 : Integer;
VAR transpose : Integer;

PROCEDURE Init;
   VAR i : Integer;
BEGIN
   pMidiIn := CreateParam('midi in', ptMidi); SetIsOutput(pMidiIn, FALSE);
   pMidiOut1 := CreateParam('midi out', ptMidi); SetIsInput(pMidiOut1, FALSE);

   pTranspose := CreateParam('transpose', ptDataFader); SetIsOutput(pTranspose, FALSE);
   SetMin(pTranspose, -48); SetMax(pTranspose, 48);
   SetFormat(pTranspose, '%.0f'); SetSymbol(pTranspose, 'sm');

   pNumNotes := CreateParam('num notes', ptDataField); SetIsInput(pNumNotes, FALSE);

   SetArrayLength(sentNoteOns, BUFFER_SIZE);

   numSentNoteOns := 0;
   numOut1 := 0;
END; // Init

FUNCTION IsNoteOn (currMsg : tMidi) : Boolean;
BEGIN
   IsNoteOn := ((currMsg.msg = NOTEON) AND (currMsg.data2 > 0));
END;

FUNCTION IsNoteOff (currMsg : tMidi) : Boolean;
BEGIN
   IsNoteOff := (currMsg.msg = NOTEOFF) OR ((currMsg.msg = NOTEON) AND (currMsg.data2 = 0));
END;

PROCEDURE CreateOut(currMsg : tMidi);
BEGIN
   SetMidiArrayValue(pMidiOut1, numOut1, currMsg);
   numOut1 := numOut1 + 1;
END; // CreateOut

PROCEDURE CreateNoteOnOut(origMsg, outMsg : tMidi);
   VAR curr : tNoteOns;
BEGIN
   WITH curr DO BEGIN
      origChannel := origMsg.channel;
      origNoteNo  := origMsg.data1;
      outChannel  := outMsg.channel;
      outNoteNo   := outMsg.data1;
   END;
   sentNoteOns[numSentNoteOns] := curr;
   numSentNoteOns := numSentNoteOns + 1;
   CreateOut(outMsg);
END; // CreateNoteOnOut

PROCEDURE CheckSendNoteOff(currMsg : tMidi);
   VAR i, j : Integer;
   VAR outMsg : tMidi;
   VAR curr : tNoteOns;
BEGIN
   j := 0;
   FOR i := 0 TO (numSentNoteOns - 1) DO BEGIN
      curr := sentNoteOns[i];
      IF ((currMsg.channel = curr.origChannel) AND (currMsg.data1 = curr.origNoteNo)) THEN BEGIN
         outMsg.msg     := currMsg.msg;
         outMsg.channel := curr.outChannel;
         outMsg.data1   := curr.outNoteNo;
         outMsg.data2   := currMsg.data2;
         CreateOut(outMsg);
         j := j + 1;
      END
      ELSE BEGIN
         sentNoteOns[i - j] := curr;
      END;
   END;
   numSentNoteOns := numSentNoteOns - j;
END; // CheckSendNoteOff

PROCEDURE CheckInput(currMsg : tMidi);
   VAR newMsg : tMidi;
BEGIN
   newMsg := currMsg;
   IF (IsNoteOn(currMsg)) THEN BEGIN
      newMsg.data1 := newMsg.data1 + transpose;
      CreateNoteOnOut(currMsg, newMsg);
   END
   ELSE IF (IsNoteOff(currMsg)) THEN
      CheckSendNoteOff(currMsg);
   SetValue(pNumNotes, numSentNoteOns);
END; // CheckInput

PROCEDURE Callback(n : Integer);
BEGIN
   CASE n OF
      pMidiIn    : numIn     := GetLength(n);
      pTranspose : transpose := round(GetValue(n));
   END;
END; // Callback

PROCEDURE Process;
   VAR i : Integer;
   VAR currMsg : tMidi;
BEGIN
   FOR i := 0 TO (numIn - 1) DO BEGIN
      GetMidiArrayValue(pMidiIn, i, currMsg);
      CheckInput(currMsg);
   END;
   SetLength(pMidiOut1, numOut1);
   numOut1 := 0;
END; // Process

There are still bits and pieces of the code left that could be removed.

[Fléau]

First, a lot of thanks for those scripting help.
Here is the new version with the chord detector:

download:http://www.sensomusic.com/forums/upload ... onizer.wkp



Next step is isolating chords according to a scale and play them,
vice versa, and then play arpeggio.

[damstraversaz]

first thanks a lot for sharing.
I have an issue with the dec2bin module, which is not find by usine in the modules folder. does it need a additionnal pack ?
best,
Damien

[bsork]

You'll find it in the add-ons under data tools. It's called "Decimal To Binary"

[damstraversaz]

thanks !

[Fléau]

download:http://www.sensomusic.com/forums/upload ... onizer.wkp

Corrected a scale mistake in the chord database.
Added a 'key feedback' switch on the note scaler.
Added a chord player and a arppegio player with modulated speed.

I'm near to upload it in the addons, so all suggestions are welcome!

[nay-seven]

Really a good job
thanks a lot !