(*********************************************************************** This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialiation Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) (*:Mathematic Version 3.0*) (*:Name: Tuning`*) (*:Author: Frances Griffin*) (*:Context: Tuning`*) BeginPackage["Tuning`"]; SetScale::usage= "SetScale[scale] sets the current scale to scale. It must be set in order \ to use the harmony function Chord." CurrentScale::usage= "CurrentScale is a variable used by Chord. Guess its meaning." Third::usage= "Third[x] returns the frequency of the note a pure third above x if x is \ positive, and below x if x is negatve." PureFifths::usage= "PureFifths[x,n,pitch] generates n pure fifths from x, transposing the \ resulting notes to be in the octave above pitch. Positive n gives fifths \ above x, negative n gives fifths below x." TemperedFifths::usage= "TemperedFifths[x,n,r,pitch] generates n tempered intervals, not \ necessarily fifths, between x and r*x, transposing them to be in the octave \ above pitch. Positive n gives fifths above x, negative n gives fifths below \ x." AdjustOctave::usage= "AdjustOctave[y,p] transposes y up one octave if it is below p, or down one \ octave if it is above 2p." BuildScale::usage= "BuildScale[noteList] concatenates noteList and puts the elements in \ ascending order." Transposition::usage= "Transposition[s,n,pitch] transposes the scale s up n semitones if n is \ positive, or down n semitones if n is negative, based on pitch. Transposition \ has option TuningFixed->True as default. TuningFixed->True gives \ transposition in the usual sense, False gives transposition of the tuning \ with respect to the notes." Just::usage= "Just[] generates a chromatic scale based on Just Intonation at A=440. The \ flats are B and E, the sharps are F, C, G. These are tuned so that they give \ the simplest ratios to C. Just[pitch] generates the scale at A=pitch." Pythagorean::usage= "Pythagorean[] generates a chromatic scale in Pythagorean tuning at A=440, \ according to Arnault de Zwolle, 15th century. The flats are B and E, the \ sharps are F, C, G. Pythagorean[pitch] generates the scale at A=pitch." Fogliano::usage= "Fogliano[] generates a chromatic scale in 1/2 comma meantone tuning at \ A=440, described by Lodovico Fogliano, 1529. The flats are B and E, the \ sharps are F, C, G. Fogliano[pitch] generates the scale at A=pitch." Aron::usage= "Aron[] generates a chromatic scale in 1/4 comma meantone tuning at A=440, \ described by Pietro Aron and G Zarlino, 1571. The flats are B and E, the \ sharps are F, C, G. Aron[pitch] generates the scale at A=pitch." Rossi::usage= "Rossi[] generates a chromatic scale in 1/5 comma meantone tuning at A=440, \ described by Lemme Rossi, 1666. The flats are B and E, the sharps are F, C, \ G. Rossi[pitch] generates the scale at A=pitch." Werckmeister::usage= "Werckmeister[] generates a chromatic scale in Werckmeister III well \ temperament at A=440, described in 1691. This temperament works in all keys. \ Werckmeister[pitch] generates the scale at A=pitch." Kirnberger::usage= "Kirnberger[] generates a chromatic scale in Kirnberger III well \ temperament at A=440, described in 1779. This temperament works in all keys. \ Kirnberger[pitch] generates the scale at A=pitch." EqualTemperament::usage "EqualTemperament[] generates an equal tempered chromatic scale at A=440. \ EqualTemperament[pitch] generates the scale ate A=pitch." Chord::usage= "Chord[nts, dur] generates a sound object which is a chord containing nts \ lasting for dur seconds." AmpList::usage= "AmpList is a list of the amplitudes of the first 16 harmonics of the sound \ which will be used by Chord." DefaultAmpList::usage= "DefaultAmpList is obviously the default value for AmpList." TuningFixed::usage= "TuningFixed is an option for Transposition. It has default value True." (*===================Interval definitions======================*) Options[Transposition]={TuningFixed->True}; Begin["`Private`"] ; DefaultPitch=440; Third[x_]:=Abs[x](5/4)^Sign[x]; PureFifths[x_,n_,p_]:= Fold[AdjustOctave,Table[(3/2)^(i Sign[n])x, {i,0,Abs[n]}], Table[p,{Abs[n]}]]/;NumberQ[N[x]]&&NumberQ[N[n]]&&NumberQ[N[p]]; TemperedFifths[x_,n_,r_,p_]:= Fold[AdjustOctave,Table[r^(i/n)x, {i,0,Abs[n]}],Table[p,{Abs[n]}]]/; n!=0&&NumberQ[N[n]]&&NumberQ[N[p]]; (*=========these keep the scales from exceeding one octave==========*) AdjustOctave[y_,p_]:= Which[y=2p,y/2,(y>=p)&&(y<2p),y]/;NumberQ[N[y]]&&NumberQ[N[p]]; SetAttributes[{AdjustOctave},Listable]; (*this puts the bits of the scale together in ascending order of pitch*) BuildScale[noteList_]:=Sort[Flatten[{noteList}]//N]; (*========== transposition - both the usual sort and transposition of the tuning with respect to the notes========*) Transposition[s_,n_,p_,opts___]:= Module[{tune=s,m=n,pitch=p,myOpts,myList,seed,temp}, myOpts=TuningFixed/.Join[{opts},Options[Transposition]]; m=If[m<0,12+m,m]; myList=tune[pitch]; If[myOpts, temp=Drop[RotateLeft[myList,m],{-m,-m}]; myList=temp;, seed=myList[[1]]^2/myList[[m+1]]; myList=RotateLeft[Drop[tune[seed],-1],m]]; temp=Append[AdjustOctave[myList,myList[[1]]],myList[[1]]*2]]/; NumberQ[N[n]]&&NumberQ[N[p]]; (*====================Chords and harmony======================*) (*list of amplitudes of the harmonics in the sound*) DefaultAmpList={.9,1,.3,.7,.1,.15,.05,.5,0,.05,0,.07,0,.03,0,.1}; AmpList=DefaultAmpList; harmonics[amps_]:={Range[1,Length[amps]],amps}//Transpose; (*u and v are arbitrary values used in strength[] (found by T&E) for controlling the relative strengths of the harmonics in different registers. u works over an octave, v works on each harmonic separately. Both parameters should take values between 0 and 1 to decrease the amplitudes smoothly over the whole scale.*) SetScale[scale_]:=Module[{},CurrentScale=scale]/;Length[scale]>0; u=.95; v=.9; strength[p_,h_]:=u^(-p[[2]]2^((1/12)(p[[1]]-1))v^h)//N; (*s[] defines the period and amplitude for a particular harmonic*) s[harm_,params_]:=Module[{h=harm,par=params}, strength[par,h[[1]]]*h[[2]]* Sin[2h[[1]]*Pi*CurrentScale[[par//First]]t*par//Last]]; (*soundFn[] defines the sound function for a particular note*) soundFn[par_]:= Fold[Plus,0, Apply[s,Transpose[{harmonics[AmpList], Table[par,{Length[harmonics[AmpList]]}]}],{1}]]; (*chord[] combines notes as a sound object*) Chord[nts_,dur_]:= Play[Evaluate[soundFn/@nts],{t,0,dur},DisplayFunction->Identity]/; NumberQ[N[dur]]&& Apply[And,(#<=Length[CurrentScale])&/@ Extract[nts,Table[{i,1},{i,Length[nts]}]]]; (*=========================Scales==========================*) (*====Pythagorean tuning \[Dash] Arnault van Zwolle, early 15th century====*) Pythagorean[Pitch_:DefaultPitch]:= Module[{p=Pitch}, BuildScale[{PureFifths[p,-9,p],Drop[PureFifths[p,2,p],1],2p}]]/; NumberQ[N[Pitch]]; (*======Just Intonation======*) firstCycle[x_]:=PureFifths[x,3,x]; (*a,e,b,f#*) nextCycle[x_]:=AdjustOctave[Third[-firstCycle[x]],x]; (*f,c,g,d*) finalCycle[x_]:=AdjustOctave[Third[-Take[nextCycle[x],{1,3}]],x]; (*db,ab,eb*) beflat[x_]:=Take[PureFifths[First[nextCycle[x]],-1,x],-1]; (*bb*) Just[Pitch_:DefaultPitch]:=Module[{p=Pitch}, BuildScale[{firstCycle[p],finalCycle[p],nextCycle[p],beflat[p],2p}]]/; NumberQ[N[Pitch]]; (*========1/2 comma meantone \[Dash] Fogliano, late 16th century=======*) ae[x_]:=PureFifths[x,1,x]; (*a,e*) cg[x_]:=PureFifths[Third[-ae[x][[2]]],1,x]; (*c,g*) fd[x_]:=Take[TemperedFifths[cg[x][[2]],2,x/cg[x][[2]],x],{2,2}]; (*d*) fogthirds[x_]:= AdjustOctave[{Third[{ae[x],fd[x],cg[x][[2]]}],Third[-{x,fd[x],cg[x][[2]]}]}, x];(*c#,g#,f#,b,f,bb,eb*) Fogliano[Pitch_:DefaultPitch]:= Module[{p=Pitch},BuildScale[{ae[p],cg[p],fd[p],fogthirds[p],2p}]]/; NumberQ[N[Pitch]]; (*=======1/4 comma meantone \[Dash] Aron, Zarlino, early 17th century====*) aronFifths[x_]:=TemperedFifths[4x/(5^(3/4)),4,5,x]; (*c,g,d,a,e*) aronThirds[x_]:= AdjustOctave[{Drop[Third[aronFifths[x]],1], Third[-Take[aronFifths[x],{2,4}]]},x]; (*b,f#,c#,g#,eb,bb,f*) Aron[Pitch_:DefaultPitch]:= Module[{p=Pitch},BuildScale[{aronFifths[p],aronThirds[p],2p}]]/; NumberQ[N[Pitch]]; (*========1/5 comma meantone \[Dash] Rossi, 1666=========*) Rossi[Pitch_:DefaultPitch]:=Module[{p=Pitch}, BuildScale[{TemperedFifths[p,5,15/2,p], TemperedFifths[(15/2)^(-1/5)p,-5,15/2,p],2p}]]/;NumberQ[N[Pitch]]; (*=======Werckmeister III well tempering, 1691=======*) flatFifths[x_]:=Take[TemperedFifths[(4/5)x,4,20/4,x],{1,4}]; (*c,g,d,a*) werckFifths[x_]:=Take[PureFifths[flatFifths[x][[1]],-5,x],{2,6}]; (*f,bb,eb,ab,db,gb*) Werckmeister[Pitch_:DefaultPitch]:= Module[{p=Pitch}, BuildScale[{flatFifths[p],werckFifths[p],PureFifths[p,2,p],p*2}]]/; NumberQ[N[Pitch]]; (*=======Kirnberger III well tempering, 1779========*) kirnTempered[x_]:=TemperedFifths[4x/(5^(3/4)),4,5,x]; (*c,g,d,a,e*) kirnEBFs[x_]:=Drop[PureFifths[kirnTempered[x]//Last,2,x],1]; (*b,fs*) kirnPure[x_]:=Drop[PureFifths[kirnTempered[x]//First,-5,x],1]; (*f,bb,eb,ab,db*) Kirnberger[Pitch_:DefaultPitch]:= Module[{p=Pitch},BuildScale[{kirnTempered[p],kirnEBFs[p],kirnPure[p],2p}]]/; NumberQ[N[Pitch]]; (*=======Equal temperament========*) EqualTemperament[Pitch_:DefaultPitch]:= Module[{p=Pitch},{Drop[TemperedFifths[p,12,2,p],-1],2p}//N//Flatten]/; NumberQ[N[Pitch]]; End[]; EndPackage[];