1 #include "snd.h"
2 #include "clm2xen.h"
3 #include "sndlib2xen.h"
4
5
6 /* -------------------------------- WAVELET TRANSFORM -------------------------------- */
7 /*
8 * taken from wavelets.cl in clm which is taken from
9 * M. J. Shensa Naval Ocean Systems Center,
10 * Wickerhauser "Adapted Wavelet Analysis",
11 * and the UBC Imager Wavelet Package by Bob Lewis
12 * later stuff from Numerical Recipes
13 */
14
wavelet_transform(mus_float_t * data,mus_long_t num,mus_float_t * cc,mus_long_t cc_size)15 static void wavelet_transform(mus_float_t *data, mus_long_t num, mus_float_t *cc, mus_long_t cc_size)
16 {
17 mus_float_t *data1 = NULL;
18 mus_float_t sig = -1.0;
19 mus_float_t *cr;
20 mus_long_t i, j, n, ii, ni, k, jf;
21
22 cr = (mus_float_t *)malloc(cc_size * sizeof(mus_float_t));
23
24 for (i = 0, j = cc_size - 1; i < cc_size; i++, j--)
25 {
26 cr[j] = sig * cc[i];
27 sig = -sig;
28 }
29
30 for (n = num; n >= 4; n /= 2)
31 {
32 mus_long_t n1, nh, nmod, joff;
33 if (data1) free(data1);
34 data1 = (mus_float_t *)calloc(n, sizeof(mus_float_t));
35 n1 = n - 1;
36 nmod = cc_size * n;
37 nh = n >> 1;
38 joff = -(cc_size >> 1);
39
40 for (ii = 0, i = 1; i <= n; i += 2, ii++)
41 {
42 ni = i + nmod + joff;
43 for (k = 0; k < cc_size; k++)
44 {
45 jf = n1 & (ni + k + 1);
46 data1[ii] += cc[k] * data[jf];
47 data1[ii + nh] += cr[k] * data[jf];
48 }
49 }
50 mus_copy_floats(data, data1, n);
51 }
52
53 if (data1) free(data1);
54 if (cr) free(cr);
55 }
56
57
58 /* these are from daub.h musicdsp.org, Computed by Kazuo Hatano, Aichi Institute of Technology. */
59 /* static mus_float_t Daub1[2] = { 7.07106781186e-01, 7.07106781186e-01}; */
60 static mus_float_t Daub2[4] = { 4.82962913144e-01, 8.36516303737e-01, 2.24143868042e-01,-1.29409522551e-01};
61 static mus_float_t Daub3[6] = { 3.32670552950e-01, 8.06891509311e-01, 4.59877502118e-01,-1.35011020010e-01,-8.54412738820e-02, 3.52262918857e-02};
62 static mus_float_t Daub4[8] = { 2.30377813308e-01, 7.14846570552e-01, 6.30880767929e-01,-2.79837694168e-02,-1.87034811719e-01, 3.08413818355e-02, 3.28830116668e-02,-1.05974017850e-02};
63 static mus_float_t Daub5[10] = { 1.60102397974e-01, 6.03829269797e-01, 7.24308528437e-01, 1.38428145901e-01,-2.42294887066e-01,-3.22448695846e-02, 7.75714938400e-02,-6.24149021279e-03,-1.25807519990e-02, 3.33572528547e-03};
64 static mus_float_t Daub6[12] = { 1.11540743350e-01, 4.94623890398e-01, 7.51133908021e-01, 3.15250351709e-01, -2.26264693965e-01,-1.29766867567e-01, 9.75016055873e-02, 2.75228655303e-02,-3.15820393174e-02, 5.53842201161e-04, 4.77725751094e-03,-1.07730108530e-03};
65 static mus_float_t Daub7[14] = { 7.78520540850e-02, 3.96539319481e-01, 7.29132090846e-01, 4.69782287405e-01,-1.43906003928e-01,-2.24036184993e-01, 7.13092192668e-02, 8.06126091510e-02,-3.80299369350e-02,-1.65745416306e-02, 1.25509985560e-02, 4.29577972921e-04,-1.80164070404e-03, 3.53713799974e-04};
66 static mus_float_t Daub8[16] = { 5.44158422431e-02, 3.12871590914e-01, 6.75630736297e-01, 5.85354683654e-01,-1.58291052563e-02,-2.84015542961e-01, 4.72484573913e-04, 1.28747426620e-01,-1.73693010018e-02,-4.40882539307e-02, 1.39810279173e-02, 8.74609404740e-03,-4.87035299345e-03,-3.91740373376e-04, 6.75449406450e-04,-1.17476784124e-04};
67 static mus_float_t Daub9[18] = { 3.80779473638e-02, 2.43834674612e-01, 6.04823123690e-01, 6.57288078051e-01, 1.33197385825e-01,-2.93273783279e-01,-9.68407832229e-02, 1.48540749338e-01, 3.07256814793e-02,-6.76328290613e-02, 2.50947114831e-04, 2.23616621236e-02,-4.72320475775e-03,-4.28150368246e-03, 1.84764688305e-03, 2.30385763523e-04,-2.51963188942e-04, 3.93473203162e-05};
68 static mus_float_t Daub10[20] = { 2.66700579005e-02, 1.88176800077e-01, 5.27201188931e-01, 6.88459039453e-01, 2.81172343660e-01,-2.49846424327e-01,-1.95946274377e-01, 1.27369340335e-01, 9.30573646035e-02,-7.13941471663e-02,-2.94575368218e-02, 3.32126740593e-02, 3.60655356695e-03,-1.07331754833e-02, 1.39535174705e-03, 1.99240529518e-03,-6.85856694959e-04,-1.16466855129e-04, 9.35886703200e-05,-1.32642028945e-05};
69 static mus_float_t Daub11[22] = { 1.86942977614e-02, 1.44067021150e-01, 4.49899764356e-01, 6.85686774916e-01, 4.11964368947e-01,-1.62275245027e-01,-2.74230846817e-01, 6.60435881966e-02, 1.49812012466e-01,-4.64799551166e-02,-6.64387856950e-02, 3.13350902190e-02, 2.08409043601e-02,-1.53648209062e-02,-3.34085887301e-03, 4.92841765605e-03,-3.08592858815e-04,-8.93023250666e-04, 2.49152523552e-04, 5.44390746993e-05,-3.46349841869e-05, 4.49427427723e-06};
70 static mus_float_t Daub12[24] = { 1.31122579572e-02, 1.09566272821e-01, 3.77355135214e-01, 6.57198722579e-01, 5.15886478427e-01,-4.47638856537e-02,-3.16178453752e-01,-2.37792572560e-02, 1.82478605927e-01, 5.35956967435e-03,-9.64321200965e-02, 1.08491302558e-02, 4.15462774950e-02,-1.22186490697e-02,-1.28408251983e-02, 6.71149900879e-03, 2.24860724099e-03,-2.17950361862e-03, 6.54512821250e-06, 3.88653062820e-04,-8.85041092082e-05,-2.42415457570e-05, 1.27769522193e-05,-1.52907175806e-06};
71 static mus_float_t Daub13[26] = { 9.20213353896e-03, 8.28612438729e-02, 3.11996322160e-01, 6.11055851158e-01, 5.88889570431e-01, 8.69857261796e-02,-3.14972907711e-01,-1.24576730750e-01, 1.79476079429e-01, 7.29489336567e-02,-1.05807618187e-01,-2.64884064753e-02, 5.61394771002e-02, 2.37997225405e-03,-2.38314207103e-02, 3.92394144879e-03, 7.25558940161e-03,-2.76191123465e-03,-1.31567391189e-03, 9.32326130867e-04, 4.92515251262e-05,-1.65128988556e-04, 3.06785375793e-05, 1.04419305714e-05,-4.70041647936e-06, 5.22003509845e-07};
72 static mus_float_t Daub14[28] = { 6.46115346008e-03, 6.23647588493e-02, 2.54850267792e-01, 5.54305617940e-01, 6.31187849104e-01, 2.18670687758e-01,-2.71688552278e-01,-2.18033529993e-01, 1.38395213864e-01, 1.39989016584e-01,-8.67484115681e-02,-7.15489555040e-02, 5.52371262592e-02, 2.69814083079e-02,-3.01853515403e-02,-5.61504953035e-03, 1.27894932663e-02,-7.46218989268e-04,-3.84963886802e-03, 1.06169108560e-03, 7.08021154235e-04,-3.86831947312e-04,-4.17772457703e-05, 6.87550425269e-05,-1.03372091845e-05,-4.38970490178e-06, 1.72499467536e-06,-1.78713996831e-07};
73 static mus_float_t Daub15[30] = { 4.53853736157e-03, 4.67433948927e-02, 2.06023863986e-01, 4.92631771708e-01, 6.45813140357e-01, 3.39002535454e-01,-1.93204139609e-01,-2.88882596566e-01, 6.52829528487e-02, 1.90146714007e-01,-3.96661765557e-02,-1.11120936037e-01, 3.38771439235e-02, 5.47805505845e-02,-2.57670073284e-02,-2.08100501696e-02, 1.50839180278e-02, 5.10100036040e-03,-6.48773456031e-03,-2.41756490761e-04, 1.94332398038e-03,-3.73482354137e-04,-3.59565244362e-04, 1.55896489920e-04, 2.57926991553e-05,-2.81332962660e-05, 3.36298718173e-06, 1.81127040794e-06,-6.31688232588e-07, 6.13335991330e-08};
74 static mus_float_t Daub16[32] = { 3.18922092534e-03, 3.49077143236e-02, 1.65064283488e-01, 4.30312722846e-01, 6.37356332083e-01, 4.40290256886e-01,-8.97510894024e-02,-3.27063310527e-01,-2.79182081330e-02, 2.11190693947e-01, 2.73402637527e-02,-1.32388305563e-01,-6.23972275247e-03, 7.59242360442e-02,-7.58897436885e-03,-3.68883976917e-02, 1.02976596409e-02, 1.39937688598e-02,-6.99001456341e-03,-3.64427962149e-03, 3.12802338120e-03, 4.07896980849e-04,-9.41021749359e-04, 1.14241520038e-04, 1.74787245225e-04,-6.10359662141e-05,-1.39456689882e-05, 1.13366086612e-05,-1.04357134231e-06,-7.36365678545e-07, 2.30878408685e-07,-2.10933963010e-08};
75 static mus_float_t Daub17[34] = { 2.24180700103e-03, 2.59853937036e-02, 1.31214903307e-01, 3.70350724152e-01, 6.10996615684e-01, 5.18315764056e-01, 2.73149704032e-02,-3.28320748363e-01,-1.26599752215e-01, 1.97310589565e-01, 1.01135489177e-01,-1.26815691778e-01,-5.70914196316e-02, 8.11059866541e-02, 2.23123361781e-02,-4.69224383892e-02,-3.27095553581e-03, 2.27336765839e-02,-3.04298998135e-03,-8.60292152032e-03, 2.96799669152e-03, 2.30120524215e-03,-1.43684530480e-03,-3.28132519409e-04, 4.39465427768e-04,-2.56101095665e-05,-8.20480320245e-05, 2.31868137987e-05, 6.99060098507e-06,-4.50594247722e-06, 3.01654960999e-07, 2.95770093331e-07,-8.42394844600e-08, 7.26749296856e-09};
76 static mus_float_t Daub18[36] = { 1.57631021844e-03, 1.92885317241e-02, 1.03588465822e-01, 3.14678941337e-01, 5.71826807766e-01, 5.71801654888e-01, 1.47223111969e-01,-2.93654040736e-01,-2.16480934005e-01, 1.49533975565e-01, 1.67081312763e-01,-9.23318841508e-02,-1.06752246659e-01, 6.48872162119e-02, 5.70512477385e-02,-4.45261419029e-02,-2.37332103958e-02, 2.66707059264e-02, 6.26216795430e-03,-1.30514809466e-02, 1.18630033858e-04, 4.94334360546e-03,-1.11873266699e-03,-1.34059629833e-03, 6.28465682965e-04, 2.13581561910e-04,-1.98648552311e-04,-1.53591712353e-07, 3.74123788074e-05,-8.52060253744e-06,-3.33263447888e-06, 1.76871298362e-06,-7.69163268988e-08,-1.17609876702e-07, 3.06883586304e-08,-2.50793445494e-09};
77 static mus_float_t Daub19[38] = { 1.10866976318e-03, 1.42810984507e-02, 8.12781132654e-02, 2.64388431740e-01, 5.24436377464e-01, 6.01704549127e-01, 2.60894952651e-01,-2.28091394215e-01,-2.85838631755e-01, 7.46522697081e-02, 2.12349743306e-01,-3.35185419023e-02,-1.42785695038e-01, 2.75843506256e-02, 8.69067555558e-02,-2.65012362501e-02,-4.56742262772e-02, 2.16237674095e-02, 1.93755498891e-02,-1.39883886785e-02,-5.86692228101e-03, 7.04074736710e-03, 7.68954359257e-04,-2.68755180070e-03, 3.41808653458e-04, 7.35802520505e-04,-2.60676135678e-04,-1.24600791734e-04, 8.71127046721e-05, 5.10595048707e-06,-1.66401762971e-05, 3.01096431629e-06, 1.53193147669e-06,-6.86275565776e-07, 1.44708829879e-08, 4.63693777578e-08,-1.11640206703e-08, 8.66684883899e-10};
78 static mus_float_t Daub20[40] = { 7.79953613666e-04, 1.05493946249e-02, 6.34237804590e-02, 2.19942113551e-01, 4.72696185310e-01, 6.10493238938e-01, 3.61502298739e-01,-1.39212088011e-01,-3.26786800434e-01,-1.67270883090e-02, 2.28291050819e-01, 3.98502464577e-02,-1.55458750707e-01,-2.47168273386e-02, 1.02291719174e-01, 5.63224685730e-03,-6.17228996246e-02, 5.87468181181e-03, 3.22942995307e-02,-8.78932492390e-03,-1.38105261371e-02, 6.72162730225e-03, 4.42054238704e-03,-3.58149425960e-03,-8.31562172822e-04, 1.39255961932e-03,-5.34975984399e-05,-3.85104748699e-04, 1.01532889736e-04, 6.77428082837e-05,-3.71058618339e-05,-4.37614386218e-06, 7.24124828767e-06,-1.01199401001e-06,-6.84707959700e-07, 2.63392422627e-07, 2.01432202355e-10,-1.81484324829e-08, 4.05612705555e-09,-2.99883648961e-10};
79 static mus_float_t Daub21[42] = { 5.48822509852e-04, 7.77663905235e-03, 4.92477715381e-02, 1.81359625440e-01, 4.19687944939e-01, 6.01506094935e-01, 4.44590451927e-01,-3.57229196172e-02,-3.35664089530e-01,-1.12397071568e-01, 2.11564527680e-01, 1.15233298439e-01,-1.39940424932e-01,-8.17759429808e-02, 9.66003903237e-02, 4.57234057492e-02,-6.49775048937e-02,-1.86538592021e-02, 3.97268354278e-02, 3.35775639033e-03,-2.08920536779e-02, 2.40347092080e-03, 8.98882438197e-03,-2.89133434858e-03,-2.95837403893e-03, 1.71660704063e-03, 6.39418500512e-04,-6.90671117082e-04,-3.19640627768e-05, 1.93664650416e-04,-3.63552025008e-05,-3.49966598498e-05, 1.53548250927e-05, 2.79033053981e-06,-3.09001716454e-06, 3.16609544236e-07, 2.99213663046e-07,-1.00040087903e-07,-2.25401497467e-09, 7.05803354123e-09,-1.47195419765e-09, 1.03880557102e-10};
80 static mus_float_t Daub22[44] = { 3.86263231491e-04, 5.72185463133e-03, 3.80699372364e-02, 1.48367540890e-01, 3.67728683446e-01, 5.78432731009e-01, 5.07901090622e-01, 7.37245011836e-02,-3.12726580428e-01,-2.00568406104e-01, 1.64093188106e-01, 1.79973187992e-01,-9.71107984091e-02,-1.31768137686e-01, 6.80763143927e-02, 8.45573763668e-02,-5.13642542974e-02,-4.65308118275e-02, 3.69708466206e-02, 2.05867076275e-02,-2.34800013444e-02,-6.21378284936e-03, 1.25647252183e-02, 3.00137398507e-04,-5.45569198615e-03, 1.04426073918e-03, 1.82701049565e-03,-7.70690988123e-04,-4.23787399839e-04, 3.28609414213e-04, 4.34589990453e-05,-9.40522363481e-05, 1.13743496621e-05, 1.73737569575e-05,-6.16672931646e-06,-1.56517913199e-06, 1.29518205731e-06,-8.77987987336e-08,-1.28333622875e-07, 3.76122874933e-08, 1.68017140492e-09,-2.72962314663e-09, 5.33593882166e-10,-3.60211348433e-11};
81 static mus_float_t Daub23[46] = { 2.71904194128e-04, 4.20274889318e-03, 2.93100036578e-02, 1.20515531783e-01, 3.18450813852e-01, 5.44931147873e-01, 5.51018517241e-01, 1.81392625363e-01,-2.61392148030e-01,-2.71402098607e-01, 9.21254070824e-02, 2.23573658242e-01,-3.30374470942e-02,-1.64011321531e-01, 2.02830745756e-02, 1.12297043618e-01,-2.11262123562e-02,-7.02073915749e-02, 2.17658568344e-02, 3.84953325225e-02,-1.85235136501e-02,-1.75371010030e-02, 1.27519439315e-02, 6.03184065002e-03,-7.07531927370e-03,-1.13486547335e-03, 3.12287644981e-03,-2.46501400516e-04,-1.06123122888e-03, 3.19420492709e-04, 2.56762452007e-04,-1.50021850349e-04,-3.37889483412e-05, 4.42607120310e-05,-2.63520788924e-06,-8.34787556785e-06, 2.39756954684e-06, 8.14757483477e-07,-5.33900540520e-07, 1.85309178563e-08, 5.41754917953e-08,-1.39993549543e-08,-9.47288590181e-10, 1.05044645369e-09,-1.93240511131e-10, 1.25020330235e-11};
82 static mus_float_t Daub24[48] = { 1.91435800947e-04, 3.08208171490e-03, 2.24823399497e-02, 9.72622358336e-02, 2.72908916067e-01, 5.04371040839e-01, 5.74939221095e-01, 2.80985553233e-01,-1.87271406885e-01,-3.17943078999e-01, 4.77661368434e-03, 2.39237388780e-01, 4.25287296414e-02,-1.71175351370e-01,-3.87771735779e-02, 1.21016303469e-01, 2.09801137091e-02,-8.21616542080e-02,-4.57843624181e-03, 5.13016200399e-02,-4.94470942812e-03,-2.82131070949e-02, 7.66172188164e-03, 1.30499708710e-02,-6.29143537001e-03,-4.74656878632e-03, 3.73604617828e-03, 1.15376493683e-03,-1.69645681897e-03,-4.41618485614e-05, 5.86127059318e-04,-1.18123323796e-04,-1.46007981776e-04, 6.55938863930e-05, 2.18324146046e-05,-2.02288829261e-05, 1.34115775080e-08, 3.90110033859e-06,-8.98025314393e-07,-4.03250775687e-07, 2.16633965327e-07,-5.05764541979e-10,-2.25574038817e-08, 5.15777678967e-09, 4.74837582425e-10,-4.02465864458e-10, 6.99180115763e-11,-4.34278250380e-12};
83 static mus_float_t Daub25[50] = { 1.34802979347e-04, 2.25695959185e-03, 1.71867412540e-02, 7.80358628721e-02, 2.31693507886e-01, 4.59683415146e-01, 5.81636896746e-01, 3.67885074802e-01,-9.71746409646e-02,-3.36473079641e-01,-8.75876145876e-02, 2.24537819745e-01, 1.18155286719e-01,-1.50560213750e-01,-9.85086152899e-02, 1.06633805018e-01, 6.67521644940e-02,-7.70841110565e-02,-3.71739628611e-02, 5.36179093987e-02, 1.55426059291e-02,-3.40423204606e-02,-3.07983679484e-03, 1.89228044766e-02,-1.98942578220e-03,-8.86070261804e-03, 2.72693625873e-03, 3.32270777397e-03,-1.84248429020e-03,-8.99977423746e-04, 8.77258193674e-04, 1.15321244046e-04,-3.09880099098e-04, 3.54371452327e-05, 7.90464000396e-05,-2.73304811996e-05,-1.27719529319e-05, 8.99066139306e-06, 5.23282770815e-07,-1.77920133265e-06, 3.21203751886e-07, 1.92280679014e-07,-8.65694173227e-08,-2.61159855611e-09, 9.27922448008e-09,-1.88041575506e-09,-2.22847491022e-10, 1.53590157016e-10,-2.52762516346e-11, 1.50969208282e-12};
84 static mus_float_t Daub26[52] = { 9.49379575071e-05, 1.65052023353e-03, 1.30975542925e-02, 6.22747440251e-02, 1.95039438716e-01, 4.13292962278e-01, 5.73669043034e-01, 4.39158311789e-01, 1.77407678098e-03,-3.26384593691e-01,-1.74839961289e-01, 1.81291832311e-01, 1.82755409589e-01,-1.04323900285e-01,-1.47977193275e-01, 6.98231861132e-02, 1.06482405249e-01,-5.34485616814e-02,-6.86547596040e-02, 4.22321857963e-02, 3.85357159711e-02,-3.13781103630e-02,-1.77609035683e-02, 2.07349201799e-02, 5.82958055531e-03,-1.17854979061e-02,-5.28738399262e-04, 5.60194723942e-03,-9.39058250473e-04,-2.14553028156e-03, 8.38348805654e-04, 6.16138220457e-04,-4.31955707426e-04,-1.06057474828e-04, 1.57479523860e-04,-5.27779549303e-06,-4.10967399639e-05, 1.07422154087e-05, 7.00007868296e-06,-3.88740016185e-06,-4.65046322064e-07, 7.93921063370e-07,-1.07900423757e-07,-8.90446637016e-08, 3.40779562129e-08, 2.16932825985e-09,-3.77601047853e-09, 6.78004724582e-10, 1.00230319104e-10,-5.84040818534e-11, 9.13051001637e-12,-5.25187122424e-13};
85 static mus_float_t Daub27[54] = { 6.68713138543e-05, 1.20553123167e-03, 9.95258878087e-03, 4.94525999829e-02, 1.62922027502e-01, 3.67110214125e-01, 5.53849860990e-01, 4.93406122677e-01, 1.02840855061e-01,-2.89716803314e-01,-2.48264581903e-01, 1.14823019517e-01, 2.27273288414e-01,-3.87864186318e-02,-1.78031740959e-01, 1.57993974602e-02, 1.31197971717e-01,-1.40627515558e-02,-9.10229065295e-02, 1.73110182654e-02, 5.79694057347e-02,-1.85124935619e-02,-3.27390666310e-02, 1.61469669223e-02, 1.56655956489e-02,-1.15771864589e-02,-5.86209634546e-03, 6.85663560968e-03, 1.34262687730e-03,-3.33285446952e-03, 1.45752962593e-04, 1.30117745024e-03,-3.41835122691e-04,-3.87901857410e-04, 2.01971987969e-04, 7.66005838706e-05,-7.71114551779e-05,-3.51748361490e-06, 2.06344264773e-05,-3.90116407063e-06,-3.65750090818e-06, 1.63436962472e-06, 3.05088068625e-07,-3.47246814739e-07, 3.28655896805e-08, 4.02625505286e-08,-1.32133227399e-08,-1.30946560685e-09, 1.52161498477e-09,-2.41552692801e-10,-4.37498622429e-11, 2.21366208806e-11,-3.29579012247e-12, 1.82818835288e-13};
86 static mus_float_t Daub28[56] = { 4.71080777501e-05, 8.79498515984e-04, 7.54265037764e-03, 3.90926081154e-02, 1.35137914253e-01, 3.22563361285e-01, 5.24998231630e-01, 5.30516293441e-01, 2.00176144045e-01,-2.30498954047e-01,-3.01327809532e-01, 3.28578791633e-02, 2.45808151373e-01, 3.69068853157e-02,-1.82877330732e-01,-4.68382337445e-02, 1.34627567910e-01, 3.44786312750e-02,-9.76853558056e-02,-1.73419228313e-02, 6.77478955019e-02, 3.44801895554e-03,-4.33333686160e-02, 4.43173291006e-03, 2.46880600101e-02,-6.81554976455e-03,-1.20635919682e-02, 5.83881662774e-03, 4.78486311245e-03,-3.72546124707e-03,-1.36037384563e-03, 1.87599866820e-03, 1.41567239314e-04,-7.48674955911e-04, 1.15465606365e-04, 2.29579098223e-04,-8.90390149004e-05,-4.90771341619e-05, 3.64140121105e-05, 4.63866498139e-06,-1.00432604133e-05, 1.24790031757e-06, 1.84036373451e-06,-6.67021547995e-07,-1.75746117320e-07, 1.49066001353e-07,-8.26238731562e-09,-1.78413869087e-08, 5.04404705638e-09, 6.94454032894e-10,-6.07704124722e-10, 8.49222001105e-11, 1.86736726378e-11,-8.36549047125e-12, 1.18885053340e-12,-6.36777235471e-14};
87 static mus_float_t Daub29[58] = { 3.31896627984e-05, 6.40951680304e-04, 5.70212651777e-03, 3.07735802214e-02, 1.11370116951e-01, 2.80653455970e-01, 4.89758804762e-01, 5.51374432758e-01, 2.89105238335e-01,-1.54028734459e-01,-3.30040948917e-01,-5.57068000729e-02, 2.36105236153e-01, 1.12419174873e-01,-1.60877988594e-01,-1.07845949938e-01, 1.14472295893e-01, 8.32207471624e-02,-8.51254926156e-02,-5.50274895253e-02, 6.34791645842e-02, 3.05315432727e-02,-4.51879812777e-02,-1.29171425542e-02, 2.94704318717e-02, 2.64832730767e-03,-1.70412245736e-02, 1.73788033272e-03, 8.46972549356e-03,-2.55080712778e-03,-3.47379898968e-03, 1.87712092572e-03, 1.08705394222e-03,-1.00077832708e-03,-2.00071136307e-04, 4.11128345474e-04,-2.29201804121e-05,-1.29304484008e-04, 3.64502606856e-05, 2.91334475016e-05,-1.65732839530e-05,-3.59364480402e-06, 4.75060924645e-06,-3.02905459205e-07,-8.97570175063e-07, 2.63389838699e-07, 9.38719741109e-08,-6.28615692201e-08, 1.07659190661e-09, 7.76897885477e-09,-1.89399538617e-09,-3.42680086326e-10, 2.40709945350e-10,-2.94058925076e-11,-7.83250973362e-12, 3.15276241337e-12,-4.28565487006e-13, 2.21919131158e-14};
88 static mus_float_t Daub30[60] = { 2.33861617273e-05, 4.66637950428e-04, 4.30079716504e-03, 2.41308326715e-02, 9.12383040670e-02, 2.42020670940e-01, 4.50487821853e-01, 5.57572232912e-01, 3.66242683371e-01,-6.61836707759e-02,-3.32966975020e-01,-1.41968513330e-01, 1.99462121580e-01, 1.77829873244e-01,-1.14558219432e-01,-1.57236817959e-01, 7.27786589703e-02, 1.22747746045e-01,-5.38064654582e-02,-8.76586900363e-02, 4.38016646714e-02, 5.67123657447e-02,-3.56733974967e-02,-3.22637589193e-02, 2.70786195952e-02, 1.52879607698e-02,-1.83997438681e-02,-5.29685966613e-03, 1.09156316583e-02, 6.19671756497e-04,-5.53073014819e-03, 8.43384586662e-04, 2.32452009406e-03,-8.60927696811e-04,-7.67878250438e-04, 5.05094823903e-04, 1.72482584235e-04,-2.16171830116e-04,-8.54830546758e-06, 6.98200837080e-05,-1.33971686329e-05,-1.63615247872e-05, 7.25214553589e-06, 2.32754909849e-06,-2.18726767699e-06, 1.09947433852e-08, 4.26166232601e-07,-1.00041468235e-07,-4.76437996513e-08, 2.60544275497e-08, 5.55339786139e-10,-3.33110568046e-09, 6.98486269183e-10, 1.61362297827e-10,-9.46138799727e-11, 1.00010513139e-11, 3.23942863853e-12,-1.18523759210e-12, 1.54399757084e-13,-7.73794263095e-15};
89 static mus_float_t Daub31[62] = { 1.64801338645e-05, 3.39412203776e-04, 3.23688406862e-03, 1.88536916129e-02, 7.43360930116e-02, 2.07012874485e-01, 4.09192200037e-01, 5.51139840914e-01, 4.29468808206e-01, 2.71692124973e-02,-3.10955118319e-01,-2.17978485523e-01, 1.40178288765e-01, 2.24966711473e-01,-4.99263491604e-02,-1.86962360895e-01, 1.54369884294e-02, 1.45089500931e-01,-8.13983227346e-03,-1.07612773323e-01, 1.09412974523e-02, 7.53536117432e-02,-1.48800266181e-02,-4.86190754648e-02, 1.61541715659e-02, 2.80476193667e-02,-1.42762752777e-02,-1.39005529392e-02, 1.05176394873e-02, 5.51616357331e-03,-6.52085237587e-03,-1.42826422321e-03, 3.39306677671e-03,-6.39790110601e-05,-1.45904174198e-03, 3.43139829690e-04, 4.99881617563e-04,-2.39658346940e-04,-1.24341161725e-04, 1.08958435041e-04, 1.50133572744e-05,-3.63125515786e-05, 4.03452023518e-06, 8.79530134269e-06,-3.03514236589e-06,-1.36906023094e-06, 9.81001542204e-07, 5.32725065697e-08,-1.97592512917e-07, 3.61682651733e-08, 2.32830971382e-08,-1.06152960215e-08,-6.47431168795e-10, 1.40856815102e-09,-2.52404395415e-10,-7.34893003248e-11, 3.69210880887e-11,-3.32700896712e-12,-1.32433491724e-12, 4.44546709629e-13,-5.55944205057e-14, 2.69938287976e-15};
90 static mus_float_t Daub32[64] = { 1.16146330213e-05, 2.46656690638e-04, 2.43126191957e-03, 1.46810463814e-02, 6.02574991203e-02, 1.75750783639e-01, 3.67509628597e-01, 5.34317919340e-01, 4.77809163733e-01, 1.20630538265e-01,-2.66698181476e-01,-2.77421581558e-01, 6.47133548055e-02, 2.48310642356e-01, 2.46624448396e-02,-1.92102344708e-01,-4.89951171846e-02, 1.45232079475e-01, 4.44049081999e-02,-1.09456113116e-01,-2.96278725084e-02, 8.08741406384e-02, 1.41061515161e-02,-5.69263140624e-02,-2.38026446493e-03, 3.70514579235e-02,-4.14590766082e-03,-2.16628228363e-02, 6.16752731068e-03, 1.10174007154e-02,-5.41156825727e-03,-4.64921675118e-03, 3.62722464068e-03, 1.46895510046e-03,-1.96474055582e-03,-2.21167872957e-04, 8.67305851845e-04,-1.02453731060e-04,-3.05965442382e-04, 1.05391546173e-04, 8.10367832913e-05,-5.25980928268e-05,-1.29404577940e-05, 1.82426840198e-05,-6.36178153226e-07,-4.55830957626e-06, 1.20288903632e-06, 7.56004762559e-07,-4.28597069315e-07,-5.00336186874e-08, 8.96596631195e-08,-1.21992435948e-08,-1.10438302172e-08, 4.25042231198e-09, 4.38438779994e-10,-5.88109146263e-10, 8.90472379622e-11, 3.26327074133e-11,-1.43091876516e-11, 1.07561065350e-12, 5.36148222961e-13,-1.66380048943e-13, 2.00071530381e-14,-9.42101913953e-16};
91 static mus_float_t Daub33[66] = { 8.18635831417e-06, 1.79101615370e-04, 1.82270943516e-03, 1.13959433745e-02, 4.86146665317e-02, 1.48186313180e-01, 3.26718130117e-01, 5.09376172514e-01, 5.11254770583e-01, 2.09582350713e-01,-2.04202622398e-01,-3.15997410766e-01,-1.92783394369e-02, 2.45420612119e-01, 9.98515586803e-02,-1.71428099051e-01,-1.10844133116e-01, 1.21967856403e-01, 9.47880880506e-02,-9.11469683513e-02,-7.03024850540e-02, 7.01911439409e-02, 4.57345618938e-02,-5.34712513358e-02,-2.52485829774e-02, 3.86870607602e-02, 1.07032658200e-02,-2.57287617547e-02,-2.16775861735e-03, 1.53169541158e-02,-1.59428878241e-03,-7.95354038705e-03, 2.38906240816e-03, 3.48080095340e-03,-1.86071821445e-03,-1.20430925760e-03, 1.07438069635e-03, 2.72730584733e-04,-4.90832900759e-04, 4.39316625176e-06, 1.78043189825e-04,-4.16043851627e-05,-4.92956442341e-05, 2.42333539881e-05, 9.07080575782e-06,-8.86612136675e-06,-3.60751610287e-07, 2.28837127614e-06,-4.42692340795e-07,-3.98579129198e-07, 1.82244333257e-07, 3.37797270373e-08,-3.98783819851e-08, 3.67286357683e-09, 5.11121185734e-09,-1.67139267725e-09,-2.49640210524e-10, 2.42683310230e-10,-3.04957445394e-11,-1.42023685988e-11, 5.50941472076e-12,-3.34348121895e-13,-2.15248838683e-13, 6.21474024717e-14,-7.19651054536e-15, 3.28937367841e-16};
92 static mus_float_t Daub34[68] = { 5.77051063273e-06, 1.29947620067e-04, 1.36406139005e-03, 8.81988940388e-03, 3.90488413517e-02, 1.24152482111e-01, 2.87765059233e-01, 4.78478746279e-01, 5.30555099656e-01, 2.90366329507e-01,-1.28246842174e-01,-3.31525301508e-01,-1.03891915515e-01, 2.16907220187e-01, 1.66601750412e-01,-1.27337358223e-01,-1.60924927177e-01, 7.79918469379e-02, 1.34125960271e-01,-5.44829680641e-02,-1.02947596992e-01, 4.35760946496e-02, 7.31852354367e-02,-3.70128384178e-02,-4.74385596452e-02, 3.07397465739e-02, 2.72283507563e-02,-2.36717379228e-02,-1.31439800166e-02, 1.64093741998e-02, 4.71364926099e-03,-1.00455067083e-02,-6.19474884515e-04, 5.33495076875e-03,-7.69212797506e-04,-2.39945394353e-03, 8.58995987436e-04, 8.75199906407e-04,-5.52735576214e-04,-2.32673214023e-04, 2.65077239755e-04, 2.66005001845e-05,-9.91469777078e-05, 1.35311722724e-05, 2.84495141969e-05,-1.05765749425e-05,-5.71082651099e-06, 4.16987175854e-06, 4.97971810142e-07,-1.11630653481e-06, 1.44819570833e-07, 2.02599066666e-07,-7.52670174041e-08,-1.99034650153e-08, 1.74042333293e-08,-8.66574426136e-10,-2.31650194699e-09, 6.44637821032e-10, 1.30041031860e-10,-9.90477453763e-11, 1.00420873546e-11, 6.08012535400e-12,-2.10787910891e-12, 9.79945115821e-14, 8.57919405179e-14,-2.31708370390e-14, 2.58733838193e-15,-1.14894475448e-16};
93 static mus_float_t Daub35[70] = { 4.06793406114e-06, 9.42146947557e-05, 1.01912268037e-03, 6.80729288431e-03, 3.12362885114e-02, 1.03404455861e-01, 2.51307378994e-01, 4.43592739224e-01, 5.37008427509e-01, 3.60345640518e-01,-4.38838818739e-02,-3.23822864912e-01,-1.81786976766e-01, 1.66041357490e-01, 2.17299289321e-01,-6.52628713106e-02,-1.91919589298e-01, 1.93095446660e-02, 1.55292480396e-01,-4.75268083411e-03,-1.20585522643e-01, 4.73422917264e-03, 8.99135475707e-02,-9.31855894990e-03,-6.33560374404e-02, 1.32285495850e-02, 4.12546930647e-02,-1.43668397842e-02,-2.41694978016e-02, 1.27664567156e-02, 1.22894360081e-02,-9.57779789923e-03,-5.08599164923e-03, 6.13775458674e-03, 1.42808879407e-03,-3.35764438092e-03, 7.61596943517e-06, 1.54963746970e-03,-3.34669216425e-04,-5.86481031899e-04, 2.64832881996e-04, 1.70001228366e-04,-1.36588307226e-04,-2.97699596284e-05, 5.30414312291e-05,-2.43700152682e-06,-1.57244207727e-05, 4.30804786171e-06, 3.35334586287e-06,-1.89592961769e-06,-3.90393173328e-07, 5.30236861690e-07,-3.70030837820e-08,-9.99039694453e-08, 3.00818865071e-08, 1.08490273378e-08,-7.45811655289e-09, 5.89795131038e-11, 1.03082334548e-09,-2.43354557375e-10,-6.40793825650e-11, 4.00053662725e-11,-3.12563935710e-12,-2.56706547615e-12, 8.01508853368e-13,-2.59795432889e-14,-3.39772085679e-14, 8.62403743472e-15,-9.29801252932e-16, 4.01462871233e-17};
94 static mus_float_t Daub36[72] = { 2.86792518275e-06, 6.82602867854e-05, 7.60215109966e-04, 5.24029737740e-03, 2.48905656448e-02, 8.56520925952e-02, 2.17756953097e-01, 4.06433697708e-01, 5.32266895260e-01, 4.17875335600e-01, 4.39751975293e-02,-2.94421039589e-01,-2.46807036978e-01, 9.81142041631e-02, 2.46537277608e-01, 7.27851509579e-03,-1.99337205608e-01,-4.58614007463e-02, 1.54106236627e-01, 5.02761800735e-02,-1.18803754310e-01,-3.98808535755e-02, 9.11567822580e-02, 2.50387214495e-02,-6.82090166368e-02,-1.13191003168e-02, 4.85130835478e-02, 1.42497266176e-03,-3.19807206776e-02, 3.98404019871e-03, 1.90635947806e-02,-5.65781324505e-03,-9.99026347328e-03, 5.02298910666e-03, 4.41348483535e-03,-3.48454144540e-03,-1.50307406629e-03, 1.99079377185e-03, 2.77681279571e-04,-9.46340382326e-04, 8.61456575899e-05, 3.69350728496e-04,-1.15511889584e-04,-1.13189946808e-04, 6.69474119693e-05, 2.37510668366e-05,-2.73139082465e-05,-1.18347105998e-06, 8.37221819816e-06,-1.58614578243e-06,-1.87081160285e-06, 8.31142127970e-07, 2.54842352255e-07,-2.45537765843e-07, 2.75324907333e-09, 4.79904346545e-08,-1.15609368881e-08,-5.61278434332e-09, 3.13884169578e-09, 1.09081555371e-10,-4.51254577856e-10, 8.96241820385e-11, 3.03742909811e-11,-1.59971668926e-11, 8.87684628721e-13, 1.07096935711e-12,-3.02928502697e-13, 5.54226318263e-15, 1.33807138629e-14,-3.20462854340e-15, 3.33997198481e-16,-1.40327417537e-17};
95 static mus_float_t Daub37[74] = { 2.02206086249e-06, 4.94234375062e-05, 5.66241837706e-04, 4.02414036825e-03, 1.97622861538e-02, 7.05848259771e-02, 1.87326331862e-01, 3.68440972400e-01, 5.18167040855e-01, 4.62207553661e-01, 1.30878963233e-01,-2.46180429761e-01,-2.94375915262e-01, 1.96715004523e-02, 2.51523254360e-01, 8.18060283872e-02,-1.81962291778e-01,-1.08451713823e-01, 1.29929646959e-01, 1.01780296838e-01,-9.66075406166e-02,-8.23302119065e-02, 7.50476199483e-02, 5.95674108715e-02,-5.92568156326e-02,-3.82538294793e-02, 4.58079441512e-02, 2.09728005925e-02,-3.35235840641e-02,-8.83349389041e-03, 2.26186515445e-02, 1.69047238348e-03,-1.37639819628e-02, 1.51930577883e-03, 7.38775745285e-03,-2.24805318700e-03,-3.39452327640e-03, 1.81687134380e-03, 1.26393425811e-03,-1.11148486531e-03,-3.28078847088e-04, 5.49053277337e-04, 1.53443902319e-05,-2.20894403245e-04, 4.33672612594e-05, 7.05513878206e-05,-3.09866292761e-05,-1.63916249616e-05, 1.35432771841e-05, 1.84994500311e-06,-4.30994155659e-06, 4.85473139699e-07, 1.00212139929e-06,-3.49494860344e-07,-1.50988538867e-07, 1.10903123221e-07, 5.35065751546e-09,-2.25219383672e-08, 4.22448570636e-09, 2.79397446595e-09,-1.29720500146e-09,-1.03141112909e-10, 1.94616489408e-10,-3.20339824412e-11,-1.39841571553e-11, 6.33495544097e-12,-2.09636319423e-13,-4.42161240987e-13, 1.13805283092e-13,-4.51888960746e-16,-5.24302569188e-15, 1.18901238750e-15,-1.19928033585e-16, 4.90661506493e-18};
96 static mus_float_t Daub38[76] = { 1.42577664167e-06, 3.57625199426e-05, 4.21170266472e-04, 3.08308811925e-03, 1.56372493475e-02, 5.78899436128e-02, 1.60071993564e-01, 3.30775781411e-01, 4.96591175311e-01, 4.93356078517e-01, 2.13050571355e-01,-1.82867667708e-01,-3.21675637808e-01,-6.22665060478e-02, 2.32125963835e-01, 1.49985119618e-01,-1.41795685973e-01,-1.59912565158e-01, 8.56381215561e-02, 1.41414734073e-01,-5.65864586307e-02,-1.14731170710e-01, 4.30958954330e-02, 8.72043982620e-02,-3.66051034028e-02,-6.17662087084e-02, 3.19898775315e-02, 4.00549811051e-02,-2.68914938808e-02,-2.31141340205e-02, 2.09046452556e-02, 1.12904972786e-02,-1.47018820653e-02,-4.13130665603e-03, 9.21478503219e-03, 5.62571574840e-04,-5.07131450921e-03, 7.16982182106e-04, 2.40069778189e-03,-8.44862666553e-04,-9.42461407722e-04, 5.81075975053e-04, 2.81763925038e-04,-3.03102046072e-04,-4.55568269666e-05, 1.26204335016e-04,-1.15540910383e-05,-4.17514164854e-05, 1.33417614992e-05, 1.03735918404e-05,-6.45673042846e-06,-1.55084435011e-06, 2.14996026993e-06,-8.48708758607e-08,-5.18773373887e-07, 1.39637754550e-07, 8.40035104689e-08,-4.88475793745e-08,-5.42427480028e-09, 1.03470453927e-08,-1.43632948779e-09,-1.34919775398e-09, 5.26113255735e-10, 6.73233649018e-11,-8.27825652253e-11, 1.10169293459e-11, 6.29153731703e-12,-2.48478923756e-12, 2.62649650406e-14, 1.80866123627e-13,-4.24981781957e-14,-4.56339716212e-16, 2.04509967678e-15,-4.40530704248e-16, 4.30459683955e-17,-1.71615245108e-18};
97
98
99 static mus_float_t Battle_Lemarie[24] = {-0.0028284274, -0.004242641, 0.008485282, 0.008485282, -0.018384777, -0.016970564, 0.042426407,
100 0.032526914, -0.11030867, -0.049497478, 0.4341636, 0.7665038, 0.4341636, -0.049497478, -0.11030867,
101 0.032526914, 0.042426407, -0.016970564, -0.018384777, 0.008485282, 0.008485282, -0.004242641, -0.0028284274, 0.0};
102 static mus_float_t Burt_Adelson[6] = {-0.07071068, 0.3535534, 0.8485282, 0.3535534, -0.07071068, 0.0};
103 static mus_float_t Beylkin[18] = {0.099305765374353, 0.424215360812961, 0.699825214056600, 0.449718251149468,
104 -.110927598348234, -.264497231446384, 0.026900308803690, 0.155538731877093,
105 -.017520746266529, -.088543630622924, 0.019679866044322, 0.042916387274192,
106 -.017460408696028, -.014365807968852, 0.010040411844631, .0014842347824723,
107 -.002736031626258, .0006404853285212};
108 static mus_float_t coif2[6] = {0.038580775, -0.12696913, -0.07716155, 0.6074917, 0.74568766, 0.2265843};
109 static mus_float_t coif4[12] = {0.0011945726958388, -0.01284557955324, 0.024804330519353, 0.050023519962135, -0.15535722285996,
110 -0.071638282295294, 0.57046500145033, 0.75033630585287, 0.28061165190244, -0.0074103835186718,
111 -0.014611552521451, -0.0013587990591632};
112 static mus_float_t coif6[18] = {-0.0016918510194918, -0.00348787621998426, 0.019191160680044, 0.021671094636352, -0.098507213321468,
113 -0.056997424478478, 0.45678712217269, 0.78931940900416, 0.38055713085151, -0.070438748794943,
114 -0.056514193868065, 0.036409962612716, 0.0087601307091635, -0.011194759273835, -0.0019213354141368,
115 0.0020413809772660, 0.00044583039753204, -0.00021625727664696};
116 static mus_float_t sym2[5] = {-0.1767767, 0.3535534, 1.0606602, 0.3535534, -0.1767767};
117 static mus_float_t sym3[4] = {0.1767767, 0.5303301, 0.5303301, 0.1767767};
118 static mus_float_t sym4[10] = {0.033145633, -0.066291265, -0.1767767, 0.4198447, 0.994369, 0.4198447, -0.1767767, -0.066291265, 0.033145633, 0.0};
119 static mus_float_t sym5[8] = {0.066291265, -0.19887379, -0.15467963, 0.994369, 0.994369, -0.15467963, -0.19887379, 0.066291265};
120 static mus_float_t sym6[16] = {-0.0030210863, -0.009063259, -0.016831767, 0.07466399, 0.03133298, -0.30115914, -0.026499243,
121 0.9516422, 0.9516422, -0.026499243, -0.30115914, 0.03133298, 0.07466399, -0.016831767, -0.009063259, -0.0030210863};
122
123 static const char *wavelet_names_1[NUM_WAVELETS] =
124 {"daub4", "daub6", "daub8", "daub10", "daub12", "daub14", "daub16", "daub18", "daub20",
125 "battle-lemarie", "burt-adelson", "beylkin", "coif2", "coif4", "coif6",
126 "sym2", "sym3", "sym4", "sym5", "sym6",
127 "daub22", "daub24", "daub26", "daub28", "daub30", "daub32", "daub34", "daub36", "daub38", "daub40",
128 "daub42", "daub44", "daub46", "daub48", "daub50", "daub52", "daub54", "daub56", "daub58", "daub60",
129 "daub62", "daub64", "daub66", "daub68", "daub70", "daub72", "daub74", "daub76"};
130
131 static int wavelet_sizes[NUM_WAVELETS] =
132 {4, 6, 8, 10, 12, 14, 16, 18, 20,
133 24, 6, 18, 6, 12, 18,
134 5, 4, 10, 8, 16,
135 22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56, 58, 60, 62, 64, 66, 68, 70, 72, 74, 76};
136
137 static mus_float_t *wavelet_data[NUM_WAVELETS] =
138 {Daub2, Daub3, Daub4, Daub5, Daub6, Daub7, Daub8, Daub9, Daub10,
139 Battle_Lemarie, Burt_Adelson, Beylkin, coif2, coif4, coif6,
140 sym2, sym3, sym4, sym5, sym6,
141 Daub11, Daub12, Daub13, Daub14, Daub15, Daub16, Daub17, Daub18, Daub19, Daub20,
142 Daub21, Daub22, Daub23, Daub24, Daub25, Daub26, Daub27, Daub28, Daub29, Daub30,
143 Daub31, Daub32, Daub33, Daub34, Daub35, Daub36, Daub37, Daub38};
144
wavelet_name(int i)145 const char *wavelet_name(int i) {return(wavelet_names_1[i]);}
146
wavelet_names(void)147 const char **wavelet_names(void) {return(wavelet_names_1);}
148
149
150
151 /* -------------------------------- HAAR TRANSFORM -------------------------------- */
152 /*
153 * from fxt/haar/haar.cc
154 */
155
haar_transform(mus_float_t * f,mus_long_t n)156 static void haar_transform(mus_float_t *f, mus_long_t n)
157 {
158 mus_long_t m, i, j, k;
159 mus_float_t s2;
160 mus_float_t v = 1.0;
161 mus_float_t x, y;
162 mus_float_t *g;
163
164 s2 = sqrt(0.5);
165 g = (mus_float_t *)calloc(n, sizeof(mus_float_t));
166
167 for (m = n; m > 1; m >>= 1)
168 {
169 mus_long_t mh;
170 v *= s2;
171 mh = (m >> 1);
172 for (j = 0, k = 0; j < m; j += 2, k++)
173 {
174 x = f[j];
175 y = f[j + 1];
176 g[k] = x + y;
177 g[mh + k] = (x - y) * v;
178 }
179 for (i = m - 1; i >= 0; i--) f[i] = g[i];
180 }
181
182 f[0] *= v;
183 free(g);
184 }
185
186
187
188 /* -------------------------------- WALSH TRANSFORM -------------------------------- */
189
190 /* borrowed from walsh/walshdit2.cc in the fxt package fxt970929.tgz written by (and copyright) Joerg Arndt
191 * arndt@spektracom.de, arndt@jjj.de, http://www.spektracom.de/~arndt/joerg.html, http://www.jjj.de/fxt/
192 * fxt.doc appears to say I can use it here (Snd is freeware and I've modified the original to some extent).
193 */
194
walsh_transform(mus_float_t * data,mus_long_t n)195 static void walsh_transform(mus_float_t *data, mus_long_t n)
196 {
197 int i, ipow;
198 ipow = (int)((log(n) / log(2)) + .0001); /* added fudge factor 21-Sep-01 -- (int)3.0000 = 2 on PC */
199
200 for (i = ipow; i >= 1; --i)
201 {
202 mus_long_t r, m, mh, t1, t2;
203 m = (1 << i);
204 mh = (m >> 1);
205 for (r = 0; r < n; r += m)
206 {
207 int j;
208 for (j = 0, t1 = r, t2 = r + mh; j < mh; ++j, ++t1, ++t2)
209 {
210 mus_float_t u, v;
211 u = data[t1];
212 v = data[t2];
213 data[t1] = u + v;
214 data[t2] = u - v;
215 }
216 }
217 }
218 }
219
220
221
compare_peaks(const void * pk1,const void * pk2)222 static int compare_peaks(const void *pk1, const void *pk2)
223 {
224 if (((fft_peak *)pk1)->freq > ((fft_peak *)pk2)->freq) return(1);
225 if (((fft_peak *)pk1)->freq == ((fft_peak *)pk2)->freq) return(0);
226 return(-1);
227 }
228
find_and_sort_peaks(mus_float_t * buf,fft_peak * found,int num_peaks,mus_long_t losamp,mus_long_t hisamp)229 int find_and_sort_peaks(mus_float_t *buf, fft_peak *found, int num_peaks, mus_long_t losamp, mus_long_t hisamp)
230 {
231 /* in the fft peak finder below we assume data between 0 and 1 */
232 /* this procedure is for the list graph -- see below for fft */
233
234 mus_long_t i, j;
235 int pks, minpk;
236 mus_float_t minval, ra, ca;
237 mus_float_t *peaks;
238 mus_long_t *inds;
239
240 if (num_peaks <= 0) return(0);
241 peaks = (mus_float_t *)calloc(num_peaks, sizeof(mus_float_t));
242 inds = (mus_long_t *)calloc(num_peaks, sizeof(mus_long_t));
243
244 pks = 0;
245 ca = 0.0;
246 ra = 0.0;
247 minval = 0.00001;
248
249 for (i = losamp; i < hisamp; i++)
250 {
251 mus_float_t la;
252 la = ca;
253 ca = ra;
254 ra = buf[i];
255 if ((ca > minval) && (ca > ra) && (ca > la))
256 {
257 if (pks < num_peaks)
258 {
259 inds[pks] = i - 1;
260 peaks[pks++] = ca;
261 }
262 else
263 {
264 minval = peaks[0];
265 minpk = 0;
266 for (j = 1; j < num_peaks; j++)
267 if (peaks[j] < minval)
268 {
269 minval = peaks[j];
270 minpk = j;
271 }
272 if (ca > minval)
273 {
274 inds[minpk] = i - 1;
275 peaks[minpk] = ca;
276 }
277 }
278 }
279 }
280
281 for (i = 0; i < pks; i++)
282 {
283 j = inds[i];
284 found[i].amp = buf[j];
285 found[i].freq = (mus_float_t)j;
286 }
287
288 if (pks > 0) qsort((void *)found, pks, sizeof(fft_peak), compare_peaks);
289 free(peaks);
290 free(inds);
291 return(pks);
292 }
293
294
295 #define MIN_CHECK 0.000001
296
find_and_sort_transform_peaks(mus_float_t * buf,fft_peak * found,int num_peaks,mus_long_t losamp,mus_long_t hisamp,mus_float_t samps_per_pixel,mus_float_t fft_scale)297 int find_and_sort_transform_peaks(mus_float_t *buf, fft_peak *found, int num_peaks,
298 mus_long_t losamp, mus_long_t hisamp, mus_float_t samps_per_pixel, mus_float_t fft_scale)
299 {
300 /* we want to reflect the graph as displayed, so each "bin" is samps_per_pixel wide */
301 mus_long_t i, j, k, hop, pkj;
302 int pks, minpk;
303 mus_float_t minval, la, ra, ca, logca, logra, logla, offset, fscl, ascl, bscl, fftsize2;
304 mus_float_t *peaks;
305 mus_long_t *inds;
306
307 fftsize2 = (mus_float_t)hisamp;
308 peaks = (mus_float_t *)calloc(num_peaks, sizeof(mus_float_t));
309 inds = (mus_long_t *)calloc(num_peaks, sizeof(mus_long_t));
310
311 fscl = 1.0 / fftsize2;
312 hop = (mus_long_t)(samps_per_pixel + 0.5);
313 if (hop < 1) hop = 1;
314
315 pks = 0;
316 /* la = 0.0; */
317 ca = 0.0;
318 ra = 0.0;
319 minval = 0.0;
320 ascl = 0.0;
321 pkj = 0;
322
323 for (i = losamp; i < hisamp - hop; i += hop)
324 {
325 mus_long_t oldpkj;
326 la = ca;
327 ca = ra;
328 oldpkj = pkj;
329 ra = 0.0;
330
331 for (k = 0; k < hop; k++)
332 if (buf[i + k] > ra)
333 {
334 pkj = i + k;
335 ra = buf[pkj]; /* reflect user's view of the graph */
336 }
337
338 if ((ca > minval) && (ca > ra) && (ca > la))
339 {
340 if (ascl < ca) ascl = ca;
341 if (pks < num_peaks)
342 {
343 inds[pks] = oldpkj;
344 peaks[pks] = ca;
345 pks++;
346 }
347 else
348 {
349 minval = peaks[0];
350 minpk = 0;
351 for (j = 1; j < num_peaks; j++)
352 {
353 if (peaks[j] < minval)
354 {
355 minval = peaks[j];
356 minpk = j;
357 }
358 }
359 if (ca > minval)
360 {
361 inds[minpk] = oldpkj;
362 peaks[minpk] = ca;
363 }
364 }
365 }
366 }
367
368 /* now we have the peaks; turn these into interpolated peaks/amps, and sort */
369 if (ascl > 0.0)
370 ascl = 1.0 / ascl;
371 else ascl = 1.0;
372
373 if (fft_scale > 0.0)
374 bscl = fft_scale / ascl;
375 else bscl = 1.0;
376
377 for (i = 0, k = 0; i < pks; i++)
378 {
379 j = inds[i];
380 ca = buf[j] * ascl;
381 if (j > 0)
382 la = buf[j - 1] * ascl;
383 else la = ca;
384 ra = buf[j + 1] * ascl;
385
386 if ((la < MIN_CHECK) || (ra < MIN_CHECK))
387 {
388 found[k].amp = bscl * ca;
389 found[k].freq = fscl * j;
390 }
391 else
392 {
393 logla = log10(la);
394 logca = log10(ca);
395 logra = log10(ra);
396 offset = (0.5 * (logla - logra)) / (logla + logra - 2 * logca); /* this assumes amps < 1.0 (from XJS sms code) */
397 found[k].amp = bscl * pow(10.0, logca - 0.25 * offset * (logla - logra));
398
399 if ((found[k].amp > 1.0) &&
400 (fft_scale > 0.0))
401 found[k].amp = 1.0;
402 found[k].freq = fscl * (j + offset);
403 }
404 if (found[k].freq < 0.0) found[k].freq = 0.0;
405 if (found[k].amp > 0.0) k++;
406 }
407
408 for (i = k; i < num_peaks; i++) found[i].freq = 1.0; /* move blank case to end of sorted list */
409 qsort((void *)found, pks, sizeof(fft_peak), compare_peaks);
410
411 free(peaks);
412 free(inds);
413 return(k);
414 }
415
416
417 static mus_float_t beta_maxes[MUS_NUM_FFT_WINDOWS] = {1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
418 1.0, 15.0 /* kaiser */, 10.0, 10.0, 10.0, 1.0, 18.0 /* dolph */, 10.0, 1.0, 18.0 /* samaraki */,
419 18.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
420 1.0, 1.0, 1.0, 1.0, 1.0, 0.24};
421
fft_beta_max(mus_fft_window_t win)422 mus_float_t fft_beta_max(mus_fft_window_t win) {return(beta_maxes[(int)win]);}
423
424
425
426 static const char *transform_type_names[NUM_BUILTIN_TRANSFORM_TYPES] = {"Fourier", "Wavelet", "Walsh", "Autocorrelate", "Cepstrum", "Haar"};
427
428 static const char *transform_type_program_names[NUM_BUILTIN_TRANSFORM_TYPES] = {
429 S_fourier_transform, S_wavelet_transform, S_walsh_transform, S_autocorrelation, S_cepstrum, S_haar_transform};
430
431
432 typedef struct {
433 char *name, *xlabel;
434 mus_float_t lo, hi;
435 Xen proc;
436 int type, row, gc_loc;
437 } added_transform;
438
439 static added_transform **added_transforms = NULL;
440 static int added_transforms_size = 0;
441
442
new_transform(void)443 static added_transform *new_transform(void)
444 {
445 int loc = -1;
446 if (!added_transforms)
447 {
448 loc = 0;
449 added_transforms_size = 4;
450 added_transforms = (added_transform **)calloc(added_transforms_size, sizeof(added_transform *));
451 }
452 else
453 {
454 int i;
455 for (i = 0; i < added_transforms_size; i++)
456 if (!added_transforms[i])
457 {
458 loc = i;
459 break;
460 }
461 if (loc == -1)
462 {
463 int i;
464 loc = added_transforms_size;
465 added_transforms_size += 4;
466 added_transforms = (added_transform **)realloc(added_transforms, added_transforms_size * sizeof(added_transform *));
467 for (i = loc; i < added_transforms_size; i++) added_transforms[i] = NULL;
468 }
469 }
470 added_transforms[loc] = (added_transform *)calloc(1, sizeof(added_transform));
471 added_transforms[loc]->type = loc + NUM_BUILTIN_TRANSFORM_TYPES;
472 return(added_transforms[loc]);
473 }
474
475
add_transform(const char * name,const char * xlabel,mus_float_t lo,mus_float_t hi,Xen proc)476 static int add_transform(const char *name, const char *xlabel, mus_float_t lo, mus_float_t hi, Xen proc)
477 {
478 added_transform *af;
479 af = new_transform();
480 af->name = mus_strdup(name);
481 af->xlabel = mus_strdup(xlabel);
482 af->lo = lo;
483 af->hi = hi;
484 af->proc = proc;
485 af->gc_loc = snd_protect(proc);
486 make_transform_type_list();
487 return(af->type);
488 }
489
490
type_to_transform(int type)491 static added_transform *type_to_transform(int type)
492 {
493 int loc;
494 loc = type - NUM_BUILTIN_TRANSFORM_TYPES;
495 if ((loc >= 0) && (loc < added_transforms_size))
496 return(added_transforms[loc]);
497 return(NULL);
498 }
499
500
is_transform(int type)501 bool is_transform(int type)
502 {
503 if (type < 0) return(false);
504 if (type < NUM_BUILTIN_TRANSFORM_TYPES) return(true);
505 return(type_to_transform(type));
506 }
507
508
509 /* delete-transform would also need to remove its name from the various UI lists */
510
transform_name(int type)511 const char *transform_name(int type)
512 {
513 if (is_transform(type))
514 {
515 added_transform *af;
516 if (type < NUM_BUILTIN_TRANSFORM_TYPES)
517 return(transform_type_names[type]);
518 af = type_to_transform(type);
519 return(af->name);
520 }
521 return("unknown");
522 }
523
524
transform_program_name(int type)525 const char *transform_program_name(int type)
526 {
527 if (is_transform(type))
528 {
529 added_transform *af;
530 if (type < NUM_BUILTIN_TRANSFORM_TYPES)
531 return(transform_type_program_names[type]);
532 af = type_to_transform(type);
533 return(af->name);
534 }
535 return("unknown");
536 }
537
538
added_transform_xlabel(int type)539 static const char *added_transform_xlabel(int type)
540 {
541 added_transform *af;
542 af = type_to_transform(type);
543 if (af) return(af->xlabel);
544 return("unknown");
545 }
546
547
added_transform_lo(int type)548 static mus_float_t added_transform_lo(int type)
549 {
550 added_transform *af;
551 af = type_to_transform(type);
552 if (af) return(af->lo);
553 return(0.0);
554 }
555
556
added_transform_hi(int type)557 static mus_float_t added_transform_hi(int type)
558 {
559 added_transform *af;
560 af = type_to_transform(type);
561 if (af) return(af->hi);
562 return(1.0);
563 }
564
565
added_transform_proc(int type)566 static Xen added_transform_proc(int type)
567 {
568 added_transform *af;
569 af = type_to_transform(type);
570 if (af) return(af->proc);
571 return(Xen_false);
572 }
573
574
set_transform_position(int i,int j)575 void set_transform_position(int i, int j)
576 {
577 if (i >= NUM_BUILTIN_TRANSFORM_TYPES)
578 {
579 added_transform *af;
580 af = type_to_transform(i);
581 af->row = j;
582 }
583 }
584
585
max_transform_type(void)586 int max_transform_type(void)
587 {
588 return(NUM_BUILTIN_TRANSFORM_TYPES + added_transforms_size);
589 }
590
591
transform_type_to_position(int type)592 int transform_type_to_position(int type)
593 {
594 added_transform *af;
595 if (type < NUM_BUILTIN_TRANSFORM_TYPES)
596 return(type);
597 af = type_to_transform(type);
598 if (af) return(af->row);
599 return(-1);
600 }
601
602
transform_position_to_type(int pos)603 int transform_position_to_type(int pos)
604 {
605 int i;
606 if (pos < NUM_BUILTIN_TRANSFORM_TYPES)
607 return(pos);
608 for (i = 0; i < added_transforms_size; i++)
609 {
610 added_transform *af;
611 af = added_transforms[i];
612 if ((af) && (af->row = pos))
613 return(af->type);
614 }
615 return(-1);
616 }
617
618
spectro_xlabel(chan_info * cp)619 static const char *spectro_xlabel(chan_info *cp)
620 {
621 switch (cp->transform_type)
622 {
623 case FOURIER:
624 if (cp->fft_log_frequency)
625 return("log freq");
626 else return("frequency");
627
628 case WAVELET: return(wavelet_names_1[cp->wavelet_type]);
629 case HAAR: return("Haar spectrum");
630 case CEPSTRUM: return("cepstrum");
631 case WALSH: return("Sequency");
632 case AUTOCORRELATION: return("Lag time");
633 default: return(added_transform_xlabel(cp->transform_type));
634 }
635 return(NULL);
636 }
637
638
make_sonogram_axes(chan_info * cp)639 static void make_sonogram_axes(chan_info *cp)
640 {
641 fft_info *fp;
642 fp = cp->fft;
643 if (fp)
644 {
645 axis_info *ap;
646 mus_float_t max_freq, min_freq, yang;
647 ap = cp->axis;
648 if (cp->transform_type == FOURIER)
649 {
650 max_freq = cp->spectrum_end * (mus_float_t)snd_srate(cp->sound) * 0.5;
651 if ((cp->fft_log_frequency) && ((snd_srate(cp->sound) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
652 min_freq = log_freq_start(ss);
653 else min_freq = cp->spectrum_start * (mus_float_t)snd_srate(cp->sound) * 0.5;
654 }
655 else
656 {
657 if ((cp->transform_type == AUTOCORRELATION) ||
658 (cp->transform_type == CEPSTRUM))
659 {
660 max_freq = fp->current_size * cp->spectrum_end / 2;
661 min_freq = fp->current_size * cp->spectrum_start / 2;
662 }
663 else
664 {
665 max_freq = fp->current_size * cp->spectrum_end;
666 min_freq = fp->current_size * cp->spectrum_start;
667 }
668 }
669 yang = fmod(cp->spectro_y_angle, 360.0);
670 if (yang < 0.0) yang += 360.0;
671 if (cp->transform_graph_type == GRAPH_AS_SPECTROGRAM)
672 {
673 const char *xlabel;
674 if (cp->transform_type == FOURIER)
675 {
676 if (yang < 45.0) xlabel = "frequency";
677 else if (yang < 135.0) xlabel = "time";
678 else if (yang < 225.0) xlabel = "wavelength?";
679 else if (yang < 315.0) xlabel = "reversed time?";
680 else xlabel = "frequency";
681 }
682 else xlabel = spectro_xlabel(cp);
683 fp->axis = make_axis_info(cp,
684 min_freq, max_freq,
685 ap->x0, ap->x1,
686 xlabel,
687 min_freq, max_freq,
688 ap->x0, ap->x1,
689 fp->axis);
690 }
691 else
692 {
693 if (!fp->xlabel)
694 fp->xlabel = mus_strdup("time");
695 fp->axis = make_axis_info(cp,
696 ap->x0, ap->x1,
697 min_freq, max_freq,
698 fp->xlabel,
699 ap->x0, ap->x1,
700 min_freq, max_freq,
701 fp->axis);
702 }
703 }
704 }
705
706
707 typedef struct fft_state {
708 mus_long_t size;
709 mus_fft_window_t wintype;
710 graph_type_t graph_type;
711 bool done;
712 chan_info *cp;
713 mus_float_t *window;
714 mus_float_t *data;
715 mus_float_t alpha, beta;
716 int wavelet_choice, transform_type;
717 mus_long_t beg, databeg, datalen;
718 mus_long_t losamp;
719 int edit_ctr;
720 bool dBing, lfreq, with_phases;
721 int pad_zero;
722 mus_float_t cutoff;
723 } fft_state;
724
725
726 static mus_float_t *fs_idata = NULL;
727 static mus_long_t fs_idata_size = 0;
728
fourier_spectrum(snd_fd * sf,mus_float_t * fft_data,mus_long_t fft_size,mus_long_t data_len,mus_float_t * window,chan_info * cp)729 void fourier_spectrum(snd_fd *sf, mus_float_t *fft_data, mus_long_t fft_size, mus_long_t data_len, mus_float_t *window, chan_info *cp)
730 {
731 mus_long_t i, j, lim;
732
733 if (window)
734 {
735 for (i = 0; i < data_len; i++)
736 fft_data[i] = window[i] * read_sample(sf);
737 }
738 else
739 {
740 for (i = 0; i < data_len; i++)
741 fft_data[i] = read_sample(sf);
742 }
743
744 if (data_len < fft_size)
745 mus_clear_floats(fft_data + data_len, fft_size - data_len);
746 if (fft_size <= fs_idata_size)
747 mus_clear_floats(fs_idata, fft_size);
748 else
749 {
750 if (!fs_idata)
751 fs_idata = (mus_float_t *)malloc(fft_size * sizeof(mus_float_t));
752 else fs_idata = (mus_float_t *)realloc(fs_idata, fft_size * sizeof(mus_float_t));
753 mus_clear_floats(fs_idata, fft_size);
754 fs_idata_size = fft_size;
755 }
756
757 mus_fft(fft_data, fs_idata, fft_size, 1);
758
759 lim = fft_size / 2;
760 if ((cp) && (cp->fft_with_phases))
761 {
762 fft_data[0] = hypot(fft_data[0], fs_idata[0]);
763 cp->fft->phases[0] = -atan2(fs_idata[0], fft_data[0]);
764 for (i = 1, j = fft_size - 1; i < lim; i++, j--)
765 {
766 fft_data[i] = hypot(fft_data[i], fs_idata[i]);
767 fft_data[j] = fft_data[i];
768 cp->fft->phases[i] = -atan2(fs_idata[i], fft_data[i]);
769 cp->fft->phases[j] = -cp->fft->phases[i];
770 }
771 }
772 else
773 {
774 fft_data[0] = hypot(fft_data[0], fs_idata[0]);
775 for (i = 1, j = fft_size - 1; i < lim; i++, j--)
776 {
777 fft_data[i] = hypot(fft_data[i], fs_idata[i]);
778 fft_data[j] = fft_data[i];
779 }
780 }
781 if (fs_idata_size >= 4194304)
782 {
783 free(fs_idata);
784 fs_idata = NULL;
785 fs_idata_size = 0;
786 }
787 }
788
789
790 static Xen before_transform_hook;
791
apply_fft(fft_state * fs)792 static void apply_fft(fft_state *fs)
793 {
794 mus_long_t i, ind0, data_len;
795 mus_float_t *fft_data;
796 snd_fd *sf;
797 chan_info *cp;
798
799 cp = fs->cp;
800 fft_data = fs->data;
801 data_len = cp->transform_size;
802
803 if ((show_selection_transform(ss)) &&
804 (selection_is_active_in_channel(cp)) &&
805 (fs->datalen > 0))
806 {
807 ind0 = fs->databeg;
808 if (cp->transform_graph_type == GRAPH_ONCE)
809 data_len = fs->datalen;
810 }
811 else
812 {
813 if (Xen_hook_has_list(before_transform_hook))
814 {
815 Xen res;
816 res = run_progn_hook(before_transform_hook,
817 Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
818 C_int_to_Xen_integer(cp->chan)),
819 S_before_transform_hook);
820 if (Xen_is_llong(res))
821 ind0 = Xen_llong_to_C_llong(res) + fs->beg;
822 else ind0 = cp->axis->losamp + fs->beg;
823 }
824 else
825 ind0 = cp->axis->losamp + fs->beg;
826 }
827
828 if (data_len > fs->size) data_len = fs->size;
829 sf = init_sample_read(ind0, cp, READ_FORWARD);
830 if (!sf) return;
831
832 switch (cp->transform_type)
833 {
834 case FOURIER:
835 fourier_spectrum(sf, fft_data, fs->size, data_len, fs->window, cp);
836 break;
837
838 case WAVELET:
839 for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
840 if (data_len < fs->size)
841 mus_clear_floats(fft_data + data_len, fs->size - data_len);
842 wavelet_transform(fft_data, fs->size, wavelet_data[cp->wavelet_type], wavelet_sizes[cp->wavelet_type]);
843 break;
844
845 case HAAR:
846 for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
847 if (data_len < fs->size)
848 mus_clear_floats(fft_data + data_len, fs->size - data_len);
849 haar_transform(fft_data, fs->size);
850 break;
851
852 case CEPSTRUM:
853 for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
854 if (data_len < fs->size)
855 mus_clear_floats(fft_data + data_len, fs->size - data_len);
856 mus_cepstrum(fft_data, fs->size);
857 break;
858
859 case WALSH:
860 for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
861 if (data_len < fs->size)
862 mus_clear_floats(fft_data + data_len, fs->size - data_len);
863 walsh_transform(fft_data, fs->size);
864 break;
865
866 case AUTOCORRELATION:
867 for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
868 if (data_len < fs->size)
869 mus_clear_floats(fft_data + data_len, fs->size - data_len);
870 mus_autocorrelate(fft_data, fs->size);
871 break;
872
873 default:
874 {
875 Xen res, sfd;
876 int gc_loc, sf_loc;
877 sfd = g_c_make_sampler(sf);
878 sf_loc = snd_protect(sfd);
879 res = Xen_call_with_2_args(added_transform_proc(cp->transform_type),
880 C_llong_to_Xen_llong(data_len),
881 sfd,
882 "added transform func");
883 gc_loc = snd_protect(res);
884 if (mus_is_vct(res))
885 {
886 vct *v;
887 mus_long_t len;
888 v = Xen_to_vct(res);
889 len = mus_vct_length(v);
890 mus_copy_floats(fft_data, mus_vct_data(v), len);
891 }
892 snd_unprotect_at(gc_loc);
893 snd_unprotect_at(sf_loc);
894 free_snd_fd_almost(sf);
895 return;
896 }
897 }
898
899 free_snd_fd(sf);
900 }
901
902
display_fft(fft_state * fs)903 static void display_fft(fft_state *fs)
904 {
905 fft_info *fp;
906 chan_info *cp;
907 mus_float_t max_freq = 0.0, min_freq = 0.0, max_val, min_val, data_max = 0.0, scale = 1.0;
908 const char *xlabel;
909 fft_info *nfp;
910 mus_float_t *data, *tdata;
911 chan_info *ncp;
912 snd_info *sp;
913 mus_long_t i, lo, hi;
914
915 cp = fs->cp;
916 if ((!cp) || (cp->active < CHANNEL_HAS_AXES)) return;
917 if (cp->transform_graph_type != GRAPH_ONCE) return;
918
919 fp = cp->fft;
920 if (!fp) return; /* can happen if selection transform set, but no selection */
921
922 data = fp->data;
923 if (!data) return;
924
925 sp = cp->sound;
926 if (!fp->xlabel)
927 xlabel = spectro_xlabel(cp);
928 else xlabel = fp->xlabel;
929 /* this only works until the fft data is remade in some way, then the label reverts to "frequency" */
930
931 switch (cp->transform_type)
932 {
933 case FOURIER:
934 max_freq = ((mus_float_t)(snd_srate(sp)) * 0.5 * cp->spectrum_end);
935 if ((cp->fft_log_frequency) && ((snd_srate(sp) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
936 min_freq = log_freq_start(ss);
937 else min_freq = ((mus_float_t)(snd_srate(sp)) * 0.5 * cp->spectrum_start);
938 break;
939
940 case WAVELET: case WALSH: case HAAR:
941 max_freq = fs->size * cp->spectrum_end;
942 min_freq = fs->size * cp->spectrum_start;
943 break;
944
945 case AUTOCORRELATION: case CEPSTRUM:
946 max_freq = fs->size * cp->spectrum_end / 2;
947 min_freq = fs->size * cp->spectrum_start / 2;
948 break;
949
950 default:
951 min_freq = added_transform_lo(cp->transform_type) * fs->size * cp->spectrum_end;
952 max_freq = added_transform_hi(cp->transform_type) * fs->size * cp->spectrum_end;
953 break;
954 }
955
956 if (cp->transform_normalization == DONT_NORMALIZE)
957 {
958 lo = 0;
959 hi = (int)(fp->current_size / 2);
960 }
961 else
962 {
963 if (cp->transform_type == FOURIER)
964 {
965 hi = (int)(fs->size * cp->spectrum_end / 2);
966 lo = (int)(fs->size * cp->spectrum_start / 2);
967 }
968 else
969 {
970 hi = (int)(fs->size * cp->spectrum_end);
971 lo = (int)(fs->size * cp->spectrum_start);
972 }
973 }
974
975 data_max = 0.0;
976 if ((cp->transform_normalization == NORMALIZE_BY_SOUND) ||
977 ((cp->transform_normalization == DONT_NORMALIZE) &&
978 (sp->nchans > 1) &&
979 (sp->channel_style == CHANNELS_SUPERIMPOSED)))
980 {
981 uint32_t j;
982 for (j = 0; j < sp->nchans; j++)
983 {
984 ncp = sp->chans[j];
985 if ((ncp->graph_transform_on) && (ncp->fft)) /* normalize-by-sound but not ffting all chans? */
986 {
987 nfp = ncp->fft;
988 tdata = nfp->data;
989 for (i = lo; i < hi; i++)
990 if (tdata[i] > data_max)
991 data_max = tdata[i];
992 }
993 }
994 }
995 else
996 {
997 if (cp->transform_type == FOURIER)
998 {
999 for (i = lo; i < hi; i++)
1000 if (data[i] > data_max)
1001 data_max = data[i];
1002 }
1003 else
1004 {
1005 for (i = lo; i < hi; i++)
1006 {
1007 if (data[i] > data_max)
1008 data_max = data[i];
1009 else
1010 if (data[i] < -data_max)
1011 data_max = -data[i];
1012 }
1013 }
1014 }
1015
1016 if (data_max == 0.0) data_max = 1.0;
1017 if (cp->transform_normalization != DONT_NORMALIZE)
1018 scale = 1.0 / data_max;
1019 else
1020 {
1021 if (cp->transform_type == FOURIER)
1022 {
1023 int di;
1024 scale = 2.0 / (mus_float_t)(fs->size);
1025 di = (int)(10 * data_max * scale + 1);
1026 if (di == 1)
1027 {
1028 di = (int)(100 * data_max * scale + 1);
1029 if (di == 1)
1030 {
1031 di = (int)(1000 * data_max * scale + 1);
1032 data_max = (mus_float_t)di / 1000.0;
1033 }
1034 else data_max = (mus_float_t)di / 100.0;
1035 }
1036 else data_max = (mus_float_t)di / 10.0;
1037 }
1038 else
1039 {
1040 scale = 1.0;
1041 }
1042 }
1043
1044 if (cp->fft_log_magnitude)
1045 {
1046 /* the DONT_NORMALIZE option is ignored because it really looks dumb in this context */
1047 max_val = 0.0;
1048 min_val = cp->min_dB;
1049 }
1050 else
1051 {
1052 if (cp->transform_normalization == DONT_NORMALIZE)
1053 {
1054 if (cp->transform_type == FOURIER)
1055 min_val = 0.0;
1056 else min_val = -data_max;
1057 max_val = data_max;
1058 }
1059 else
1060 {
1061 if (cp->transform_type == FOURIER)
1062 min_val = 0.0;
1063 else min_val = -1.0;
1064 max_val = 1.0;
1065 }
1066 }
1067
1068 fp->scale = scale;
1069 fp->axis = make_axis_info(cp,
1070 min_freq, max_freq,
1071 min_val, max_val,
1072 xlabel,
1073 min_freq, max_freq,
1074 min_val, max_val,
1075 fp->axis);
1076 }
1077
1078
free_fft_state(fft_state * fs)1079 static fft_state *free_fft_state(fft_state *fs)
1080 {
1081 if (fs)
1082 {
1083 if (fs->window) {free(fs->window); fs->window = NULL;}
1084 free(fs);
1085 }
1086 return(NULL);
1087 }
1088
1089
cp_free_fft_state(chan_info * cp)1090 void cp_free_fft_state(chan_info *cp)
1091 {
1092 if (cp->fft_data)
1093 cp->fft_data = (fft_state *)free_fft_state(cp->fft_data);
1094 }
1095
1096
fft_window_beta_in_use(mus_fft_window_t win)1097 bool fft_window_beta_in_use(mus_fft_window_t win)
1098 {
1099 return((win == MUS_KAISER_WINDOW) ||
1100 (win == MUS_CAUCHY_WINDOW) ||
1101 (win == MUS_POISSON_WINDOW) ||
1102 (win == MUS_GAUSSIAN_WINDOW) ||
1103 (win == MUS_TUKEY_WINDOW) ||
1104 (win == MUS_DOLPH_CHEBYSHEV_WINDOW) ||
1105 (win == MUS_HANN_POISSON_WINDOW) ||
1106 (win == MUS_SAMARAKI_WINDOW) ||
1107 (win == MUS_ULTRASPHERICAL_WINDOW) ||
1108 (win == MUS_DPSS_WINDOW));
1109 }
1110
1111
fft_window_alpha_in_use(mus_fft_window_t win)1112 bool fft_window_alpha_in_use(mus_fft_window_t win)
1113 {
1114 return(win == MUS_ULTRASPHERICAL_WINDOW);
1115 }
1116
1117
make_fft_state(chan_info * cp,bool force_recalc)1118 static fft_state *make_fft_state(chan_info *cp, bool force_recalc)
1119 {
1120 fft_state *fs = NULL;
1121 axis_info *ap;
1122 bool reuse_old = false;
1123 mus_long_t fftsize;
1124 mus_long_t dbeg = 0, dlen = 0;
1125
1126 ap = cp->axis;
1127
1128 if ((show_selection_transform(ss)) &&
1129 (cp->transform_graph_type == GRAPH_ONCE) &&
1130 (selection_is_active_in_channel(cp)))
1131 {
1132 /* override transform_size(ss) in this case (sonograms cover selection but use preset size) */
1133 dbeg = selection_beg(cp);
1134 dlen = selection_len();
1135 /* these need to be handled at the same time, and not re-examined until the next call */
1136 /* if we're sweeping the mouse defining the selection, by the time we get to apply_fft, selection_len() can change */
1137 fftsize = snd_mus_long_t_pow2((int)ceil(log(dlen * (1 + cp->zero_pad) + 1) / log(2.0)));
1138 if (fftsize < 2) fftsize = 2;
1139 cp->selection_transform_size = fftsize;
1140 }
1141 else
1142 {
1143 if ((cp->zero_pad == 0) && (is_power_of_2(cp->transform_size)))
1144 fftsize = cp->transform_size;
1145 else fftsize = snd_mus_long_t_pow2((int)(ceil(log((mus_float_t)(cp->transform_size * (1 + cp->zero_pad))) / log(2.0))));
1146 if (fftsize < 2) fftsize = 2;
1147 cp->selection_transform_size = 0;
1148 }
1149
1150 if ((!force_recalc) && (cp->fft_data) && (cp->selection_transform_size == 0))
1151 {
1152 fs = cp->fft_data;
1153 if ((fs->losamp == ap->losamp) &&
1154 (!(Xen_hook_has_list(before_transform_hook))) &&
1155 (fs->size == fftsize) &&
1156 (fs->transform_type == cp->transform_type) &&
1157 (fs->wintype == cp->fft_window) &&
1158 ((!(fft_window_alpha_in_use(fs->wintype))) || (fs->alpha == cp->fft_window_alpha)) &&
1159 ((!(fft_window_beta_in_use(fs->wintype))) || (fs->beta == cp->fft_window_beta)) &&
1160 (fs->dBing == cp->fft_log_magnitude) &&
1161 (fs->lfreq == cp->fft_log_frequency) &&
1162 (fs->with_phases == cp->fft_with_phases) &&
1163 (fs->pad_zero == cp->zero_pad) &&
1164 (fs->cutoff == cp->spectrum_end) &&
1165 (fs->graph_type == cp->transform_graph_type) &&
1166 (fs->wavelet_choice == cp->wavelet_type) &&
1167 (fs->edit_ctr == cp->edit_ctr))
1168 reuse_old = true;
1169 }
1170
1171 if (!reuse_old)
1172 {
1173 cp_free_fft_state(cp);
1174 fs = (fft_state *)calloc(1, sizeof(fft_state));
1175 fs->cp = cp;
1176 fs->cutoff = cp->spectrum_end;
1177 fs->size = fftsize;
1178 fs->pad_zero = cp->zero_pad;
1179 fs->wintype = cp->fft_window;
1180 fs->dBing = cp->fft_log_magnitude;
1181 fs->lfreq = cp->fft_log_frequency;
1182 fs->with_phases = cp->fft_with_phases;
1183 fs->window = NULL;
1184 fs->losamp = ap->losamp;
1185 fs->edit_ctr = cp->edit_ctr;
1186 fs->wavelet_choice = cp->wavelet_type;
1187 fs->transform_type = cp->transform_type;
1188 fs->graph_type = cp->transform_graph_type;
1189 fs->alpha = cp->fft_window_alpha;
1190 fs->beta = cp->fft_window_beta;
1191 }
1192
1193 fs->done = reuse_old;
1194 fs->beg = 0; /* offset from losamp */
1195 fs->databeg = dbeg;
1196 fs->datalen = dlen;
1197 return(fs);
1198 }
1199
1200
make_fft_info(mus_long_t size,mus_fft_window_t window,mus_float_t alpha,mus_float_t beta)1201 static fft_info *make_fft_info(mus_long_t size, mus_fft_window_t window, mus_float_t alpha, mus_float_t beta)
1202 {
1203 fft_info *fp;
1204 fp = (fft_info *)calloc(1, sizeof(fft_info));
1205 fp->size = size;
1206 fp->window = window;
1207 fp->alpha = alpha;
1208 fp->beta = beta;
1209 fp->xlabel = NULL;
1210 fp->data = (mus_float_t *)calloc(size + 1, sizeof(mus_float_t)); /* + 1 for complex storage or starts at 1 or something */
1211 fp->phases = NULL;
1212 return(fp);
1213 }
1214
1215
set_fft_info_xlabel(chan_info * cp,const char * new_label)1216 void set_fft_info_xlabel(chan_info *cp, const char *new_label)
1217 {
1218 if ((cp) && (cp->fft))
1219 {
1220 if (cp->fft->xlabel) free(cp->fft->xlabel);
1221 if (new_label)
1222 cp->fft->xlabel = mus_strdup(new_label);
1223 else cp->fft->xlabel = NULL;
1224 }
1225 }
1226
1227
free_fft_info(fft_info * fp)1228 fft_info *free_fft_info(fft_info *fp)
1229 {
1230 fp->chan = NULL;
1231 if (fp->data) free(fp->data);
1232 if (fp->phases) free(fp->phases);
1233 if (fp->axis) free_axis_info(fp->axis);
1234 if (fp->xlabel) free(fp->xlabel);
1235 free(fp);
1236 return(NULL);
1237 }
1238
1239
one_fft(fft_state * fs)1240 static void one_fft(fft_state *fs)
1241 {
1242 if (!fs->done)
1243 {
1244 /* allocate arrays if needed */
1245 fft_info *fp;
1246 chan_info *cp;
1247 cp = fs->cp;
1248 fp = cp->fft;
1249 if (!fp) /* associated channel hasn't done any ffts yet, so there's no struct */
1250 {
1251 cp->fft = make_fft_info(fs->size, fs->wintype, fs->alpha, fs->beta);
1252 fp = cp->fft;
1253 }
1254 else
1255 {
1256 if ((!fp->data) ||
1257 (fs->size > fp->size))
1258 {
1259 fp->size = fs->size;
1260 if (fp->data) free(fp->data);
1261 fp->data = (mus_float_t *)calloc(fp->size + 1, sizeof(mus_float_t));
1262 if (fp->phases) free(fp->phases);
1263 fp->phases = NULL;
1264 }
1265 }
1266
1267 if ((cp->fft_with_phases) &&
1268 (!(fp->phases)))
1269 fp->phases = (mus_float_t *)calloc(fp->size + 1, sizeof(mus_float_t));
1270
1271 fp->current_size = fs->size; /* protect against parallel size change via fft size menu */
1272 fs->data = fp->data;
1273 if (!fs->window)
1274 {
1275 static mus_long_t last_size = 0;
1276 static int last_zero = 0;
1277 static mus_fft_window_t last_wintype = MUS_RECTANGULAR_WINDOW;
1278 static mus_float_t last_beta = 0.0;
1279 static mus_float_t last_alpha = 0.0;
1280 static mus_float_t *last_window = NULL;
1281
1282 fs->window = (mus_float_t *)calloc(fs->size, sizeof(mus_float_t));
1283
1284 if ((fs->wintype != last_wintype) ||
1285 (fs->size != last_size) ||
1286 (fs->beta != last_beta) ||
1287 (fs->alpha != last_alpha) ||
1288 (fs->pad_zero != last_zero))
1289 {
1290 if (last_window) free(last_window);
1291 last_window = (mus_float_t *)calloc(fs->size, sizeof(mus_float_t));
1292 if (cp->selection_transform_size > 0)
1293 mus_make_fft_window_with_window(fs->wintype, cp->selection_transform_size,
1294 fs->beta * beta_maxes[fs->wintype],
1295 fs->alpha, last_window);
1296 else mus_make_fft_window_with_window(fs->wintype, cp->transform_size,
1297 fs->beta * beta_maxes[fs->wintype],
1298 fs->alpha, last_window);
1299 last_size = fs->size;
1300 last_alpha = fs->alpha;
1301 last_beta = fs->beta;
1302 last_wintype = fs->wintype;
1303 last_zero = fs->pad_zero;
1304 }
1305 mus_copy_floats(fs->window, last_window, fs->size);
1306 }
1307 apply_fft(fs);
1308 }
1309 display_fft(fs);
1310 }
1311
1312
single_fft(chan_info * cp,bool update_display,bool force_recalc)1313 void single_fft(chan_info *cp, bool update_display, bool force_recalc)
1314 {
1315 if (cp->transform_size < 2) return;
1316 cp->fft_data = make_fft_state(cp, force_recalc);
1317 one_fft(cp->fft_data);
1318 if (update_display) display_channel_fft_data(cp);
1319 }
1320
1321
1322
1323 /* -------------------------------- GRAPH_AS_SONOGRAM -------------------------------- */
1324 /*
1325 * calls calculate_fft for each slice, each bin being a gray-scaled rectangle in the display
1326 */
1327
1328 /* as we run the ffts, we need to save the fft data for subsequent redisplay/printing etc */
1329 /* many of these can be running in parallel so the pointers can't be global */
1330
1331 /* this work proc calls a loop by pixels (hop depends on pixel/samps decision)
1332 each pixel(group) sets up the fft_state pointer with beg reflecting hop
1333 then loops, each time called, calling fft_in_slices until it returns true.
1334 then grab that data, update the channel display, look to see if we're
1335 behind the times, if so cleanup and exit, else jump back to outer loop.
1336 */
1337
1338 typedef enum {SONO_INIT, SONO_RUN, SONO_QUIT, SONO_DONE} sono_slice_t;
1339
1340 typedef struct sonogram_state {
1341 sono_slice_t slice;
1342 int outlim, outer;
1343 fft_state *fs;
1344 chan_info *cp;
1345 int spectrum_size;
1346 sono_info *scp;
1347 mus_long_t beg, losamp, hisamp;
1348 bool done;
1349 double acc_hop, hop;
1350 mus_fft_window_t window;
1351 int msg_ctr;
1352 int edit_ctr;
1353 mus_float_t old_scale, alpha, beta;
1354 graph_type_t graph_type;
1355 int transform_type, w_choice;
1356 bool old_logxing;
1357 bool status_needs_to_be_cleared;
1358 bool force_recalc;
1359 } sonogram_state;
1360
1361
clear_transform_edit_ctrs(chan_info * cp)1362 void clear_transform_edit_ctrs(chan_info *cp)
1363 {
1364 if (cp->fft_data)
1365 {
1366 fft_state *fs;
1367 fs = cp->fft_data;
1368 fs->edit_ctr = -1;
1369 }
1370 if (cp->last_sonogram)
1371 {
1372 sonogram_state *lsg;
1373 lsg = (sonogram_state *)(cp->last_sonogram);
1374 lsg->edit_ctr = -1;
1375 }
1376 }
1377
1378
make_sonogram_state(chan_info * cp,bool force_recalc)1379 void *make_sonogram_state(chan_info *cp, bool force_recalc)
1380 {
1381 sonogram_state *sg;
1382 fft_state *fs;
1383 sg = (sonogram_state *)calloc(1, sizeof(sonogram_state));
1384 sg->cp = cp;
1385 sg->done = false;
1386 sg->force_recalc = force_recalc;
1387 fs = make_fft_state(cp, true);
1388 cp->fft_data = NULL;
1389 sg->fs = fs;
1390 sg->msg_ctr = 8;
1391 sg->transform_type = cp->transform_type;
1392 sg->w_choice = cp->wavelet_type;
1393 sg->status_needs_to_be_cleared = false;
1394 if (cp->temp_sonogram)
1395 {
1396 sonogram_state *temp_sg;
1397 /* we must have restarted fft process without letting the previous run at all */
1398 temp_sg = (sonogram_state *)(cp->temp_sonogram);
1399 if (temp_sg->fs) temp_sg->fs = free_fft_state(temp_sg->fs);
1400 free(temp_sg);
1401 /* cp->last_sonogram = NULL; */
1402 }
1403 cp->temp_sonogram = sg; /* background process may never run, so we need a way to find this pointer at cleanup time */
1404 return((void *)sg);
1405 }
1406
1407
free_sonogram_fft_state(void * ptr)1408 void free_sonogram_fft_state(void *ptr)
1409 {
1410 sonogram_state *sg = (sonogram_state *)ptr;
1411 if (sg->fs) free_fft_state(sg->fs);
1412 sg->fs = NULL;
1413 }
1414
1415
free_sono_info(chan_info * cp)1416 void free_sono_info(chan_info *cp)
1417 {
1418 sono_info *si;
1419 si = cp->sonogram_data;
1420 if (si)
1421 {
1422 if (si->begs) free(si->begs);
1423 if (si->data)
1424 {
1425 int i;
1426 for (i = 0; i < si->total_slices; i++)
1427 if (si->data[i])
1428 free(si->data[i]);
1429 free(si->data);
1430 }
1431 free(si);
1432 cp->sonogram_data = NULL;
1433 }
1434 }
1435
1436
memory_is_available(mus_long_t slices,mus_long_t bins)1437 static bool memory_is_available(mus_long_t slices, mus_long_t bins)
1438 {
1439 /* as far as I can tell, the approved way to make sure we can allocate enough memory is to allocate it... */
1440 mus_long_t bytes_needed; /* "mus_long_t" throughout is vital here */
1441
1442 bytes_needed = (mus_long_t)(slices * (sizeof(mus_long_t) + sizeof(mus_float_t *))) + /* begs + pointer to each slice data */
1443 (mus_long_t)(bins * slices * sizeof(mus_float_t)) + /* data for all the slices */
1444 (mus_long_t)(bins * 2 * sizeof(double)); /* FFT space */
1445
1446 /* apparently Linux always returns a pointer, even when it will fail later, so we have to
1447 * touch the memory to find out if it's there; but this works only if we then try another alloc!
1448 * this is ridiculous...
1449 */
1450
1451 if (bytes_needed > 100000000) /* assume 100 MBytes is ok */
1452 {
1453 char *check_alloc[10];
1454 int i;
1455 mus_long_t bytes_needed_10;
1456
1457 bytes_needed_10 = bytes_needed / 10;
1458 for (i = 0; i < 10; i++)
1459 {
1460 check_alloc[i] = (char *)malloc(bytes_needed_10);
1461 if (!check_alloc[i])
1462 {
1463 int j;
1464 snd_warning("can't allocate enough memory to run this set of FFTS: %" print_mus_long " bytes needed", bytes_needed);
1465 for (j = 0; j < i; j++)
1466 free(check_alloc[j]);
1467 return(false);
1468 }
1469 check_alloc[i][0] = ' '; /* touch it! */
1470 }
1471
1472 for (i = 0; i < 10; i++)
1473 free(check_alloc[i]);
1474 }
1475 return(true);
1476 }
1477
1478
set_up_sonogram(sonogram_state * sg)1479 static sono_slice_t set_up_sonogram(sonogram_state *sg)
1480 {
1481 /* return SONO_RUN to go on, SONO_QUIT to quit early */
1482 sono_info *si;
1483 axis_info *ap;
1484 chan_info *cp;
1485 sonogram_state *lsg = NULL;
1486 int i, dpys = 1;
1487
1488 cp = sg->cp;
1489 if (cp->fft_changed != FFT_CHANGE_LOCKED)
1490 cp->fft_changed = FFT_UNCHANGED;
1491 else cp->fft_changed = FFT_CHANGED;
1492
1493 if ((!(cp->graph_transform_on)) || (cp->transform_size <= 2)) return(SONO_QUIT);
1494 ap = cp->axis;
1495 sg->slice = SONO_INIT;
1496 sg->outer = 0;
1497 sg->beg = ap->losamp;
1498 sg->losamp = ap->losamp;
1499 sg->hisamp = ap->hisamp;
1500 sg->window = cp->fft_window;
1501 sg->alpha = cp->fft_window_alpha;
1502 sg->beta = cp->fft_window_beta;
1503
1504 if (cp->graph_time_on) dpys++;
1505 if (cp->graph_lisp_on) dpys++;
1506
1507 if (cp->transform_graph_type == GRAPH_AS_SPECTROGRAM)
1508 sg->outlim = ap->height / cp->spectro_hop;
1509 else sg->outlim = ap->window_width / dpys;
1510 if (sg->outlim <= 1) return(SONO_QUIT);
1511
1512 /* sg->hop = (int)(ceil((double)(ap->hisamp - ap->losamp + 1) / (double)(sg->outlim))); */
1513 /* this ^ old form causes a noticeable step in the zoom sequence when the hop value changes */
1514 sg->hop = (double)(ap->hisamp - ap->losamp + 1) / (double)(sg->outlim);
1515 sg->acc_hop = 0.0;
1516
1517 /* if fewer samps than pixels, draw rectangles */
1518 if ((cp->transform_type == FOURIER) ||
1519 (cp->transform_type == AUTOCORRELATION) ||
1520 (cp->transform_type == CEPSTRUM))
1521 sg->spectrum_size = sg->fs->size / 2;
1522 else sg->spectrum_size = sg->fs->size;
1523 if (sg->spectrum_size <= 0) return(SONO_QUIT);
1524
1525 sg->edit_ctr = cp->edit_ctr;
1526 si = cp->sonogram_data;
1527
1528 if (!si)
1529 {
1530 si = (sono_info *)calloc(1, sizeof(sono_info));
1531 si->total_bins = sg->spectrum_size;
1532 si->total_slices = snd_to_int_pow2(sg->outlim);
1533
1534 if (!memory_is_available((mus_long_t)(si->total_slices), (mus_long_t)(si->total_bins)))
1535 {
1536 free(si);
1537 return(SONO_QUIT);
1538 }
1539
1540 cp->sonogram_data = si;
1541 si->begs = (mus_long_t *)calloc(si->total_slices, sizeof(mus_long_t));
1542 si->data = (mus_float_t **)calloc(si->total_slices, sizeof(mus_float_t *));
1543 for (i = 0; i < si->total_slices; i++) si->data[i] = (mus_float_t *)calloc(si->total_bins, sizeof(mus_float_t));
1544 }
1545 else
1546 if ((si->total_slices < sg->outlim) ||
1547 (si->total_bins < sg->spectrum_size))
1548 {
1549 int tempsize;
1550
1551 tempsize = snd_to_int_pow2(sg->outlim);
1552 if (!memory_is_available((mus_long_t)tempsize, (mus_long_t)(sg->spectrum_size)))
1553 return(SONO_QUIT);
1554
1555 for (i = 0; i < si->total_slices; i++)
1556 if (si->data[i])
1557 {
1558 free(si->data[i]);
1559 si->data[i] = NULL;
1560 }
1561
1562 if (si->total_slices < tempsize)
1563 {
1564 si->total_slices = tempsize;
1565 free(si->data);
1566 si->begs = (mus_long_t *)realloc(si->begs, si->total_slices * sizeof(mus_long_t));
1567 si->data = (mus_float_t **)calloc(si->total_slices, sizeof(mus_float_t *));
1568 }
1569
1570 if (si->total_bins < sg->spectrum_size) si->total_bins = sg->spectrum_size;
1571 for (i = 0; i < si->total_slices; i++) si->data[i] = (mus_float_t *)calloc(si->total_bins, sizeof(mus_float_t));
1572 }
1573 sg->scp = si;
1574 si->target_bins = sg->spectrum_size;
1575 si->active_slices = 0;
1576 si->target_slices = sg->outlim;
1577 si->scale = 0.0;
1578 if ((!(sg->force_recalc)) && (cp->last_sonogram)) /* there was a previous run */
1579 {
1580 lsg = (sonogram_state *)(cp->last_sonogram);
1581 if ((lsg->done) && /* it completed all ffts */
1582 (lsg->outlim == sg->outlim) && /* the number of ffts is the same */
1583 (lsg->spectrum_size == sg->spectrum_size) && /* ditto fft sizes [fs->size] */
1584 (lsg->losamp == sg->losamp) && /* begins are same */
1585 (lsg->hisamp == sg->hisamp) && /* ends are same */
1586 (lsg->window == sg->window) && /* data windows are same [fs->wintype, cp->fft_window] */
1587 (lsg->transform_type == sg->transform_type) && /* transform types are the same */
1588 (lsg->w_choice == sg->w_choice) && /* wavelets are the same [cp->wavelet_type] */
1589 (lsg->edit_ctr == sg->edit_ctr) && /* underlying data is the same */
1590 ((!(fft_window_alpha_in_use(sg->window))) || (lsg->alpha == sg->alpha)) &&
1591 ((!(fft_window_beta_in_use(sg->window))) || (lsg->beta == sg->beta)))
1592 {
1593 sg->outer = sg->outlim; /* fake up the run */
1594 si->active_slices = si->target_slices;
1595 sg->old_scale = lsg->old_scale;
1596 si->scale = sg->old_scale;
1597 if ((lsg->graph_type != cp->transform_graph_type) ||
1598 (lsg->old_logxing != cp->fft_log_frequency))
1599 make_sonogram_axes(cp); /* may need to fixup frequency axis labels */
1600 sg->graph_type = cp->transform_graph_type;
1601 sg->old_logxing = cp->fft_log_frequency;
1602 return(SONO_QUIT); /* so skip the ffts! */
1603 }
1604 }
1605
1606 cp->fft_changed = FFT_CHANGED;
1607 start_progress_report(cp);
1608 sg->status_needs_to_be_cleared = true;
1609 return(SONO_RUN);
1610 }
1611
1612
run_all_ffts(sonogram_state * sg)1613 static sono_slice_t run_all_ffts(sonogram_state *sg)
1614 {
1615 fft_state *fs;
1616 sono_info *si;
1617 chan_info *cp;
1618 axis_info *ap;
1619 /* check for losamp/hisamp change? */
1620
1621 one_fft((fft_state *)(sg->fs));
1622
1623 fs = sg->fs;
1624 cp = sg->cp;
1625 si = cp->sonogram_data;
1626 if (si->active_slices < si->total_slices)
1627 si->begs[si->active_slices] = sg->beg + fs->beg;
1628 sg->msg_ctr--;
1629
1630 if (sg->msg_ctr == 0)
1631 {
1632 progress_report(cp, ((mus_float_t)(si->active_slices) / (mus_float_t)(si->target_slices)));
1633 sg->status_needs_to_be_cleared = true;
1634 sg->msg_ctr = 8;
1635 if ((!(cp->graph_transform_on)) ||
1636 (cp->active < CHANNEL_HAS_AXES))
1637 return(SONO_QUIT);
1638 }
1639
1640 if (si->active_slices < si->total_slices)
1641 {
1642 int i;
1643 mus_float_t val;
1644 if (cp->transform_type == FOURIER)
1645 {
1646 for (i = 0; i < sg->spectrum_size; i++)
1647 {
1648 val = fs->data[i];
1649 if (val > si->scale) si->scale = val;
1650 si->data[si->active_slices][i] = val;
1651 }
1652 }
1653 else
1654 {
1655 for (i = 0; i < sg->spectrum_size; i++)
1656 {
1657 val = fs->data[i];
1658 if (val < 0.0) val = -val; /* kinda dubious but I can't think of a good alternative */
1659 if (val > si->scale) si->scale = val;
1660 si->data[si->active_slices][i] = val;
1661 }
1662 }
1663 si->active_slices++;
1664 }
1665 sg->outer++;
1666 if ((sg->outer == sg->outlim) || (!(cp->graph_transform_on)) || (cp->transform_graph_type == GRAPH_ONCE)) return(SONO_QUIT);
1667 sg->acc_hop += sg->hop;
1668 fs->beg = (mus_long_t)(sg->acc_hop);
1669 ap = cp->axis;
1670 if ((sg->losamp != ap->losamp) || (sg->hisamp != ap->hisamp))
1671 {
1672 fs->beg = 0;
1673 return(SONO_INIT);
1674 }
1675 return(SONO_RUN);
1676 }
1677
1678
finish_sonogram(sonogram_state * sg)1679 static void finish_sonogram(sonogram_state *sg)
1680 {
1681 if (sg)
1682 {
1683 chan_info *cp;
1684 cp = sg->cp;
1685 if ((cp->active < CHANNEL_HAS_AXES) ||
1686 (!(cp->graph_transform_on)))
1687 {
1688 if (sg->fs)
1689 sg->fs = free_fft_state(sg->fs);
1690 }
1691 else
1692 {
1693 if ((sg->scp) && (sg->outlim > 1))
1694 make_sonogram_axes(cp);
1695 if (sg->fs)
1696 sg->fs = free_fft_state(sg->fs);
1697 cp->fft_data = NULL;
1698 set_chan_fft_in_progress(cp, 0); /* i.e. clear it */
1699 if ((sg->scp) && (sg->outlim > 1))
1700 {
1701 display_channel_fft_data(cp);
1702 if (sg->outer == sg->outlim) sg->done = true;
1703 sg->old_scale = (sg->scp)->scale;
1704 }
1705 else sg->done = true;
1706 if ((cp->last_sonogram) && (cp->last_sonogram != sg))
1707 free(cp->last_sonogram);
1708 cp->last_sonogram = sg;
1709 if (sg->status_needs_to_be_cleared)
1710 {
1711 finish_progress_report(cp);
1712 sg->status_needs_to_be_cleared = false;
1713 }
1714 }
1715 }
1716 }
1717
1718
sonogram_in_slices(void * sono)1719 idle_func_t sonogram_in_slices(void *sono)
1720 {
1721 sonogram_state *sg = (sonogram_state *)sono;
1722 chan_info *cp;
1723 cp = sg->cp;
1724 cp->temp_sonogram = NULL;
1725 if ((cp->active < CHANNEL_HAS_AXES) ||
1726 (!(cp->graph_transform_on)))
1727 {
1728 if ((sg) && (sg->fs)) sg->fs = free_fft_state(sg->fs);
1729 return(BACKGROUND_QUIT);
1730 }
1731 switch (sg->slice)
1732 {
1733 case SONO_INIT:
1734 sg->slice = set_up_sonogram(sg);
1735 break;
1736
1737 case SONO_RUN:
1738 sg->slice = run_all_ffts(sg);
1739 break;
1740
1741 case SONO_QUIT:
1742 default:
1743 finish_sonogram(sg);
1744 return(BACKGROUND_QUIT);
1745 }
1746 return(BACKGROUND_CONTINUE);
1747 }
1748
1749
sono_update(chan_info * cp)1750 void sono_update(chan_info *cp)
1751 {
1752 if (cp->transform_graph_type != GRAPH_ONCE) make_sonogram_axes(cp);
1753 update_graph(cp);
1754 }
1755
1756
spectral_multiply(mus_float_t * rl1,mus_float_t * rl2,mus_long_t n)1757 static void spectral_multiply(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n)
1758 {
1759 mus_long_t j, n2;
1760 mus_float_t invn;
1761
1762 n2 = (int)(n * 0.5);
1763 invn = 0.25 / n;
1764 rl1[0] = ((rl1[0] * rl2[0]) / n);
1765 rl2[0] = 0.0;
1766
1767 for (j = 1; j <= n2; j++)
1768 {
1769 mus_long_t nn2;
1770 mus_float_t rem, rep, aim, aip;
1771 nn2 = n - j;
1772 rep = (rl1[j] + rl1[nn2]);
1773 rem = (rl1[j] - rl1[nn2]);
1774 aip = (rl2[j] + rl2[nn2]);
1775 aim = (rl2[j] - rl2[nn2]);
1776 rl1[j] = invn * (rep * aip + aim * rem);
1777 rl1[nn2] = rl1[j];
1778 rl2[j] = invn * (aim * aip - rep * rem);
1779 rl2[nn2] = -rl2[j];
1780 }
1781 }
1782
1783
c_convolve(const char * fname,mus_float_t amp,int filec,mus_long_t filehdr,int filterc,mus_long_t filterhdr,mus_long_t filtersize,mus_long_t fftsize,int filter_chans,int filter_chan,mus_long_t data_size,snd_info * gsp)1784 void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehdr, int filterc, mus_long_t filterhdr, mus_long_t filtersize,
1785 mus_long_t fftsize, int filter_chans, int filter_chan, mus_long_t data_size, snd_info *gsp)
1786 {
1787 int err;
1788
1789 /* need file to hold convolution output */
1790 err = mus_write_header(fname, MUS_NEXT, DEFAULT_OUTPUT_SRATE, 1, data_size * mus_bytes_per_sample(MUS_OUT_SAMPLE_TYPE), MUS_OUT_SAMPLE_TYPE, "c_convolve temp");
1791 if (err != MUS_NO_ERROR)
1792 snd_error("can't open convolution temp file %s: %s", fname, snd_io_strerror());
1793 else
1794 {
1795 mus_float_t *rl0, *rl1 = NULL;
1796 mus_float_t **pbuffer = NULL, **fbuffer = NULL;
1797 mus_long_t oloc;
1798 oloc = mus_header_data_location();
1799
1800 /* get to start point in the two sound files and allocate space */
1801 lseek(filec, filehdr, SEEK_SET);
1802 lseek(filterc, filterhdr, SEEK_SET);
1803
1804 rl0 = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
1805 if (rl0) rl1 = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
1806 if (rl1) pbuffer = (mus_float_t **)calloc(1, sizeof(mus_float_t *));
1807 if (pbuffer) pbuffer[0] = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
1808 fbuffer = (mus_float_t **)calloc(filter_chans, sizeof(mus_float_t *));
1809 if (fbuffer) fbuffer[filter_chan] = (mus_float_t *)calloc(filtersize, sizeof(mus_float_t));
1810
1811 if ((!rl0) || (!rl1) ||
1812 (!pbuffer) || (!pbuffer[0]) ||
1813 (!fbuffer) || (!fbuffer[filter_chan]))
1814 {
1815 snd_error("not enough memory for convolve of %s (filter size: %" print_mus_long ", fft size: %" print_mus_long ")",
1816 fname, filtersize, fftsize);
1817 }
1818 else
1819 {
1820 mus_float_t *pbuf;
1821 mus_long_t i;
1822 int tempfile;
1823 chan_info *gcp;
1824 gcp = gsp->chans[0];
1825 start_progress_report(gcp);
1826
1827 tempfile = snd_reopen_write(fname);
1828 snd_file_open_descriptors(tempfile, fname, MUS_OUT_SAMPLE_TYPE, oloc, 1, MUS_NEXT);
1829 lseek(tempfile, oloc, SEEK_SET);
1830
1831 /* read in the "impulse response" */
1832 pbuf = pbuffer[0];
1833 mus_file_read_any(filterc, 0, filter_chans, filtersize, fbuffer, fbuffer);
1834 for (i = 0; i < filtersize; i++)
1835 rl1[i] = fbuffer[filter_chan][i];
1836 progress_report(gcp, .1);
1837
1838 /* get the convolution data */
1839 mus_file_read_any(filec, 0, 1, data_size, pbuffer, pbuffer);
1840 for (i = 0; i < data_size; i++) rl0[i] = pbuf[i];
1841
1842 progress_report(gcp, .3);
1843 mus_fft(rl0, rl1, fftsize, 1);
1844 progress_report(gcp, .5);
1845 spectral_multiply(rl0, rl1, fftsize);
1846 progress_report(gcp, .6);
1847 mus_fft(rl0, rl1, fftsize, -1);
1848 progress_report(gcp, .8);
1849
1850 if (amp != 0.0)
1851 {
1852 mus_float_t scl;
1853 /* normalize the results */
1854 scl = 0.0;
1855 for (i = 0; i < data_size; i++)
1856 {
1857 mus_float_t val;
1858 val = fabs(rl0[i]);
1859 if (val > scl) scl = val;
1860 }
1861 if (scl != 0.0) scl = amp / scl;
1862 for (i = 0; i < data_size; i++)
1863 pbuf[i] = (scl * rl0[i]);
1864 }
1865 else
1866 {
1867 /* amp == 0.0 means un-normalized output */
1868 mus_copy_floats(pbuf, rl0, data_size);
1869 }
1870 progress_report(gcp, .9);
1871
1872 /* and save as temp file */
1873 mus_file_write(tempfile, 0, data_size - 1, 1, &(pbuf));
1874 finish_progress_report(gcp);
1875
1876 if (mus_file_close(tempfile) != 0)
1877 snd_error("convolve: can't close temp file %s!", fname);
1878 }
1879 if (rl0) free(rl0);
1880 if (rl1) free(rl1);
1881 if (pbuffer)
1882 {
1883 if (pbuffer[0]) free(pbuffer[0]);
1884 free(pbuffer);
1885 }
1886 if (fbuffer)
1887 {
1888 if (fbuffer[filter_chan]) free(fbuffer[filter_chan]);
1889 free(fbuffer);
1890 }
1891 }
1892 }
1893
1894
1895 /* -------------------------------------------------------------------------------- */
1896
update_log_freq_fft_graph(chan_info * cp)1897 static void update_log_freq_fft_graph(chan_info *cp)
1898 {
1899 if ((cp->active < CHANNEL_HAS_AXES) ||
1900 (!cp->sounds) ||
1901 (!cp->sounds[cp->sound_ctr]) ||
1902 (!(cp->graph_transform_on)) ||
1903 (!(cp->fft_log_frequency)) ||
1904 (chan_fft_in_progress(cp)))
1905 return;
1906 calculate_fft(cp);
1907 }
1908
1909
set_log_freq_start(mus_float_t base)1910 void set_log_freq_start(mus_float_t base)
1911 {
1912 in_set_log_freq_start(base);
1913 for_each_chan(update_log_freq_fft_graph);
1914 }
1915
1916
g_log_freq_start(void)1917 static Xen g_log_freq_start(void) {return(C_double_to_Xen_real(log_freq_start(ss)));}
1918
g_set_log_freq_start(Xen val)1919 static Xen g_set_log_freq_start(Xen val)
1920 {
1921 mus_float_t base;
1922 #define H_log_freq_start "(" S_log_freq_start "): log freq base (default: 25.0)"
1923
1924 Xen_check_type(Xen_is_number(val), val, 1, S_set S_log_freq_start, "a number");
1925 base = Xen_real_to_C_double(val);
1926 if ((base < 0.0) ||
1927 (base > 100000.0))
1928 Xen_out_of_range_error(S_log_freq_start, 1, val, "base should be between 0 and srate/2");
1929
1930 set_log_freq_start(base);
1931 reflect_log_freq_start_in_transform_dialog();
1932
1933 return(C_double_to_Xen_real(log_freq_start(ss)));
1934 }
1935
1936
g_show_selection_transform(void)1937 static Xen g_show_selection_transform(void) {return(C_bool_to_Xen_boolean(show_selection_transform(ss)));}
1938
g_set_show_selection_transform(Xen val)1939 static Xen g_set_show_selection_transform(Xen val)
1940 {
1941 #define H_show_selection_transform "(" S_show_selection_transform "): " PROC_TRUE " if transform display reflects selection, not time-domain window"
1942 Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_selection_transform, "a boolean");
1943 set_show_selection_transform(Xen_boolean_to_C_bool(val));
1944 return(C_bool_to_Xen_boolean(show_selection_transform(ss)));
1945 }
1946
1947
g_transform_framples(Xen snd,Xen chn)1948 static Xen g_transform_framples(Xen snd, Xen chn)
1949 {
1950 #define H_transform_framples "(" S_transform_framples " :optional snd chn): \
1951 return a description of transform graph data in snd's channel chn, based on " S_transform_graph_type ".\
1952 If there is no transform graph, return 0; if " S_graph_once ", return " S_transform_size ",\
1953 and otherwise return a list (spectrum-cutoff time-slices fft-bins)"
1954
1955 chan_info *cp;
1956 sono_info *si;
1957
1958 Snd_assert_channel(S_transform_framples, snd, chn, 1);
1959 cp = get_cp(snd, chn, S_transform_framples);
1960 if (!cp) return(Xen_false);
1961 if (!(cp->graph_transform_on))
1962 return(Xen_integer_zero);
1963
1964 if (cp->transform_graph_type == GRAPH_ONCE)
1965 return(C_int_to_Xen_integer(cp->transform_size));
1966 si = cp->sonogram_data;
1967
1968 if (si) return(Xen_list_3(C_double_to_Xen_real(cp->spectrum_end),
1969 C_llong_to_Xen_llong(si->active_slices),
1970 C_llong_to_Xen_llong(si->target_bins)));
1971 return(Xen_integer_zero);
1972 }
1973
1974
g_transform_sample(Xen bin,Xen slice,Xen snd,Xen chn_n)1975 static Xen g_transform_sample(Xen bin, Xen slice, Xen snd, Xen chn_n)
1976 {
1977 #define H_transform_sample "(" S_transform_sample " :optional (bin 0) (slice 0) snd chn): \
1978 return the current transform sample at bin and slice in snd channel chn (assuming sonogram or spectrogram)"
1979
1980 chan_info *cp;
1981
1982 Xen_check_type(Xen_is_llong_or_unbound(bin), bin, 1, S_transform_sample, "an integer");
1983 Xen_check_type(Xen_is_llong_or_unbound(slice), slice, 2, S_transform_sample, "an integer");
1984
1985 Snd_assert_channel(S_transform_sample, snd, chn_n, 3);
1986 cp = get_cp(snd, chn_n, S_transform_sample);
1987 if (!cp) return(Xen_false);
1988
1989 if (cp->graph_transform_on)
1990 {
1991 fft_info *fp;
1992 fp = cp->fft;
1993 if (fp)
1994 {
1995 mus_long_t fbin = 0;
1996 if (Xen_is_llong(bin)) fbin = Xen_llong_to_C_llong(bin);
1997
1998 if (fbin < fp->current_size)
1999 {
2000 if (cp->transform_graph_type == GRAPH_ONCE)
2001 return(C_double_to_Xen_real(fp->data[fbin]));
2002 else
2003 {
2004 mus_long_t fslice = 0;
2005 sono_info *si;
2006
2007 if (Xen_is_llong(slice)) fslice = Xen_llong_to_C_llong(slice);
2008 si = cp->sonogram_data;
2009
2010 if ((si) &&
2011 (fbin < si->target_bins) &&
2012 (fslice < si->active_slices))
2013 return(C_double_to_Xen_real(si->data[fslice][fbin]));
2014 else Xen_error(Xen_make_error_type("no-such-sample"),
2015 Xen_list_8(C_string_to_Xen_string(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, slice: ~A, max slice: ~A, sound index: ~A (~A), chan: ~A"),
2016 bin,
2017 C_int_to_Xen_integer((si) ? si->target_bins : 0),
2018 slice,
2019 C_int_to_Xen_integer((si) ? si->active_slices : 0),
2020 snd,
2021 C_string_to_Xen_string(cp->sound->short_filename),
2022 chn_n));
2023 }
2024 }
2025 else Xen_error(Xen_make_error_type("no-such-sample"),
2026 Xen_list_6(C_string_to_Xen_string(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, sound index: ~A (~A), chan: ~A"),
2027 bin,
2028 C_int_to_Xen_integer(fp->current_size),
2029 snd,
2030 C_string_to_Xen_string(cp->sound->short_filename),
2031 chn_n));
2032 }
2033 }
2034 return(Xen_false);
2035 }
2036
2037
g_transform_to_vct(Xen snd,Xen chn_n,Xen v)2038 static Xen g_transform_to_vct(Xen snd, Xen chn_n, Xen v)
2039 {
2040 #define H_transform_to_vct "(" S_transform_to_vct " :optional snd chn obj): \
2041 return a " S_vct " (obj if it's passed), with the current transform data from snd's channel chn"
2042
2043 chan_info *cp;
2044 vct *v1;
2045 v1 = xen_to_vct(v);
2046
2047 Snd_assert_channel(S_transform_to_vct, snd, chn_n, 1);
2048 cp = get_cp(snd, chn_n, S_transform_to_vct);
2049 if (!cp) return(Xen_false);
2050
2051 if ((cp->graph_transform_on) &&
2052 (cp->fft))
2053 {
2054 mus_long_t len;
2055 mus_float_t *fvals;
2056
2057 if (cp->transform_graph_type == GRAPH_ONCE)
2058 {
2059 fft_info *fp;
2060 fp = cp->fft;
2061 len = fp->current_size;
2062 if (v1)
2063 fvals = mus_vct_data(v1);
2064 else fvals = (mus_float_t *)malloc(len * sizeof(mus_float_t));
2065 mus_copy_floats(fvals, fp->data, len);
2066 if (v1)
2067 return(v);
2068 else return(xen_make_vct(len, fvals));
2069 }
2070 else
2071 {
2072 sono_info *si;
2073 si = cp->sonogram_data;
2074
2075 if (si)
2076 {
2077 int i, j, k, bins, slices;
2078 slices = si->active_slices;
2079 bins = si->target_bins;
2080 len = bins * slices;
2081 if (v1)
2082 fvals = mus_vct_data(v1);
2083 else fvals = (mus_float_t *)calloc(len, sizeof(mus_float_t));
2084 for (i = 0, k = 0; i < slices; i++)
2085 for (j = 0; j < bins; j++, k++)
2086 fvals[k] = si->data[i][j];
2087 if (v1)
2088 return(v);
2089 else return(xen_make_vct(len, fvals));
2090 }
2091 }
2092 }
2093 return(Xen_false);
2094 }
2095
2096
2097
2098 /* ---------------------------------------- transform objects ---------------------------------------- */
2099
2100 typedef struct {
2101 int n;
2102 } xen_transform;
2103
2104
2105 #define Xen_to_xen_transform(arg) ((xen_transform *)Xen_object_ref(arg))
2106
xen_transform_to_int(Xen n)2107 int xen_transform_to_int(Xen n)
2108 {
2109 xen_transform *col;
2110 col = Xen_to_xen_transform(n);
2111 return(col->n);
2112 }
2113
2114
2115 static Xen_object_type_t xen_transform_tag;
2116
xen_is_transform(Xen obj)2117 bool xen_is_transform(Xen obj)
2118 {
2119 return(Xen_c_object_is_type(obj, xen_transform_tag));
2120 }
2121
2122 #if (!HAVE_SCHEME)
xen_transform_free(xen_transform * v)2123 static void xen_transform_free(xen_transform *v) {if (v) free(v);}
2124
Xen_wrap_free(xen_transform,free_xen_transform,xen_transform_free)2125 Xen_wrap_free(xen_transform, free_xen_transform, xen_transform_free)
2126 #else
2127 static s7_pointer s7_xen_transform_free(s7_scheme *sc, s7_pointer obj)
2128 {
2129 xen_transform *v;
2130 v = (xen_transform *)s7_c_object_value(obj);
2131 if (v) free(v);
2132 return(NULL);
2133 }
2134 #endif
2135
2136 static char *xen_transform_to_string(xen_transform *v)
2137 {
2138 #define TRANSFORM_PRINT_BUFFER_SIZE 64
2139 char *buf;
2140 if (!v) return(NULL);
2141 buf = (char *)calloc(TRANSFORM_PRINT_BUFFER_SIZE, sizeof(char));
2142 snprintf(buf, TRANSFORM_PRINT_BUFFER_SIZE, "#<transform %s>", transform_name(v->n));
2143 return(buf);
2144 }
2145
2146
2147 #if HAVE_FORTH || HAVE_RUBY
Xen_wrap_print(xen_transform,print_xen_transform,xen_transform_to_string)2148 Xen_wrap_print(xen_transform, print_xen_transform, xen_transform_to_string)
2149
2150 static Xen g_xen_transform_to_string(Xen obj)
2151 {
2152 char *vstr;
2153 Xen result;
2154 #define S_xen_transform_to_string "transform->string"
2155 Xen_check_type(xen_is_transform(obj), obj, 1, S_xen_transform_to_string, "a transform");
2156 vstr = xen_transform_to_string(Xen_to_xen_transform(obj));
2157 result = C_string_to_Xen_string(vstr);
2158 free(vstr);
2159 return(result);
2160 }
2161 #else
2162 #if HAVE_SCHEME
g_xen_transform_to_string(s7_scheme * sc,s7_pointer args)2163 static s7_pointer g_xen_transform_to_string(s7_scheme *sc, s7_pointer args)
2164 {
2165 char *vstr;
2166 s7_pointer result;
2167 vstr = xen_transform_to_string(Xen_to_xen_transform(s7_car(args)));
2168 result = C_string_to_Xen_string(vstr);
2169 free(vstr);
2170 return(result);
2171 }
2172 #endif
2173 #endif
2174
2175
2176 #if (!HAVE_SCHEME)
xen_transform_equalp(xen_transform * v1,xen_transform * v2)2177 static bool xen_transform_equalp(xen_transform *v1, xen_transform *v2)
2178 {
2179 return((v1 == v2) ||
2180 (v1->n == v2->n));
2181 }
2182
equalp_xen_transform(Xen obj1,Xen obj2)2183 static Xen equalp_xen_transform(Xen obj1, Xen obj2)
2184 {
2185 if ((!(xen_is_transform(obj1))) || (!(xen_is_transform(obj2)))) return(Xen_false);
2186 return(C_bool_to_Xen_boolean(xen_transform_equalp(Xen_to_xen_transform(obj1), Xen_to_xen_transform(obj2))));
2187 }
2188 #endif
2189
2190
xen_transform_make(int n)2191 static xen_transform *xen_transform_make(int n)
2192 {
2193 xen_transform *new_v;
2194 new_v = (xen_transform *)malloc(sizeof(xen_transform));
2195 new_v->n = n;
2196 return(new_v);
2197 }
2198
2199
new_xen_transform(int n)2200 Xen new_xen_transform(int n)
2201 {
2202 xen_transform *mx;
2203 if (n < 0)
2204 return(Xen_false);
2205
2206 mx = xen_transform_make(n);
2207 return(Xen_make_object(xen_transform_tag, mx, 0, free_xen_transform));
2208 }
2209
2210 #define C_int_to_Xen_transform(Val) new_xen_transform(Val)
2211
2212
2213 #if HAVE_SCHEME
s7_xen_transform_is_equal(s7_scheme * sc,s7_pointer args)2214 static s7_pointer s7_xen_transform_is_equal(s7_scheme *sc, s7_pointer args)
2215 {
2216 s7_pointer p1, p2;
2217 p1 = s7_car(args);
2218 p2 = s7_cadr(args);
2219 if (p1 == p2) return(s7_t(sc));
2220 if (s7_c_object_type(p2) == xen_transform_tag)
2221 return(s7_make_boolean(sc, (((xen_transform *)s7_c_object_value(p1))->n == ((xen_transform *)s7_c_object_value(p2))->n)));
2222 return(s7_f(sc));
2223 }
2224
s7_xen_transform_length(s7_scheme * sc,Xen args)2225 static Xen s7_xen_transform_length(s7_scheme *sc, Xen args)
2226 {
2227 return(C_int_to_Xen_integer(transform_size(ss)));
2228 }
2229 #endif
2230
2231
init_xen_transform(void)2232 static void init_xen_transform(void)
2233 {
2234 #if HAVE_SCHEME
2235 xen_transform_tag = s7_make_c_type(s7, "<transform>");
2236 s7_c_type_set_gc_free(s7, xen_transform_tag, s7_xen_transform_free);
2237 s7_c_type_set_is_equal(s7, xen_transform_tag, s7_xen_transform_is_equal);
2238 s7_c_type_set_length(s7, xen_transform_tag, s7_xen_transform_length);
2239 s7_c_type_set_to_string(s7, xen_transform_tag, g_xen_transform_to_string);
2240 #else
2241 #if HAVE_RUBY
2242 xen_transform_tag = Xen_make_object_type("XenTransform", sizeof(xen_transform));
2243 #else
2244 xen_transform_tag = Xen_make_object_type("Transform", sizeof(xen_transform));
2245 #endif
2246 #endif
2247
2248 #if HAVE_FORTH
2249 fth_set_object_inspect(xen_transform_tag, print_xen_transform);
2250 fth_set_object_dump(xen_transform_tag, g_xen_transform_to_string);
2251 fth_set_object_equal(xen_transform_tag, equalp_xen_transform);
2252 fth_set_object_free(xen_transform_tag, free_xen_transform);
2253 #endif
2254
2255 #if HAVE_RUBY
2256 rb_define_method(xen_transform_tag, "to_s", Xen_procedure_cast print_xen_transform, 0);
2257 rb_define_method(xen_transform_tag, "eql?", Xen_procedure_cast equalp_xen_transform, 1);
2258 rb_define_method(xen_transform_tag, "==", Xen_procedure_cast equalp_xen_transform, 1);
2259 rb_define_method(xen_transform_tag, "to_str", Xen_procedure_cast g_xen_transform_to_string, 0);
2260 #endif
2261 }
2262
2263
g_integer_to_transform(Xen n)2264 static Xen g_integer_to_transform(Xen n)
2265 {
2266 #define H_integer_to_transform "(" S_integer_to_transform " n) returns a transform object corresponding to the given integer"
2267 int type;
2268 Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_transform, "an integer");
2269 type = Xen_integer_to_C_int(n);
2270 if (is_transform(type))
2271 return(new_xen_transform(type));
2272 return(Xen_false);
2273 }
2274
2275
g_transform_to_integer(Xen n)2276 static Xen g_transform_to_integer(Xen n)
2277 {
2278 #define H_transform_to_integer "(" S_transform_to_integer " id) returns the integer corresponding to the given transform"
2279 Xen_check_type(xen_is_transform(n), n, 1, S_transform_to_integer, "a transform");
2280 return(C_int_to_Xen_integer(xen_transform_to_int(n)));
2281 }
2282
2283
g_is_transform(Xen type)2284 static Xen g_is_transform(Xen type)
2285 {
2286 #define H_is_transform "(" S_is_transform " obj): " PROC_TRUE " if 'obj' is a transform object."
2287 return(C_bool_to_Xen_boolean(xen_is_transform(type) &&
2288 is_transform(Xen_transform_to_C_int(type))));
2289 }
2290
2291
g_snd_transform(Xen type,Xen data,Xen hint)2292 static Xen g_snd_transform(Xen type, Xen data, Xen hint)
2293 {
2294 #define H_snd_transform "(snd-transform type data choice) calls whatever FFT is being used by the \
2295 display. 'type' is a transform object such as " S_fourier_transform "; 'data' is a " S_vct ". In the wavelet case, \
2296 'choice' is the wavelet to use."
2297
2298 int trf, hnt;
2299 mus_long_t i, j, n2, vlen;
2300 vct *v;
2301 mus_float_t *dat, *vdata;
2302
2303 Xen_check_type(xen_is_transform(type), type, 1, "snd-transform", "a transform object");
2304 Xen_check_type(mus_is_vct(data), data, 2, "snd-transform", "a " S_vct);
2305
2306 trf = Xen_transform_to_C_int(type);
2307 if ((trf < 0) || (trf > HAAR))
2308 Xen_out_of_range_error("snd-transform", 1, type, "invalid transform choice");
2309
2310 v = Xen_to_vct(data);
2311 vlen = mus_vct_length(v);
2312 vdata = mus_vct_data(v);
2313
2314 switch (trf)
2315 {
2316 case FOURIER:
2317 n2 = vlen / 2;
2318 dat = (mus_float_t *)calloc(vlen, sizeof(mus_float_t));
2319 mus_fft(vdata, dat, vlen, 1);
2320 vdata[0] *= vdata[0];
2321 vdata[n2] *= vdata[n2];
2322 for (i = 1, j = vlen - 1; i < n2; i++, j--)
2323 {
2324 vdata[i] = vdata[i] * vdata[i] + dat[i] * dat[i];
2325 vdata[j] = vdata[i];
2326 }
2327 free(dat);
2328 break;
2329
2330 case WAVELET:
2331 hnt = Xen_integer_to_C_int(hint);
2332 if (hnt < NUM_WAVELETS)
2333 wavelet_transform(vdata, vlen, wavelet_data[hnt], wavelet_sizes[hnt]);
2334 break;
2335
2336 case HAAR:
2337 haar_transform(vdata, vlen);
2338 break;
2339
2340 case CEPSTRUM:
2341 mus_cepstrum(vdata, vlen);
2342 break;
2343
2344 case WALSH:
2345 walsh_transform(vdata, vlen);
2346 break;
2347
2348 case AUTOCORRELATION:
2349 mus_autocorrelate(vdata, vlen);
2350 break;
2351 }
2352 return(data);
2353 }
2354
2355
g_add_transform(Xen name,Xen xlabel,Xen lo,Xen hi,Xen proc)2356 static Xen g_add_transform(Xen name, Xen xlabel, Xen lo, Xen hi, Xen proc)
2357 {
2358 #define H_add_transform "(" S_add_transform " name x-label low high func): add the transform func \
2359 to the transform lists; func should be a function of two arguments, the length of the transform \
2360 and a sampler to get the data, and should return a " S_vct " containing the transform results. \
2361 name is the transform's name, x-label is its x-axis label, and the relevant returned data \
2362 to be displayed goes from low to high (normally 0.0 to 1.0). " S_add_transform " returns the new transform object."
2363
2364 char *errmsg;
2365 errmsg = procedure_ok(proc, 2, S_add_transform, "transform", 5);
2366 if (errmsg)
2367 {
2368 Xen errstr;
2369 errstr = C_string_to_Xen_string(errmsg);
2370 free(errmsg);
2371 return(snd_bad_arity_error(S_add_transform, errstr, proc));
2372 }
2373
2374 #if HAVE_SCHEME
2375 if (mus_is_xen(proc)) /* happens a lot in snd-test.scm, so add a check */
2376 Xen_wrong_type_arg_error(S_add_transform, 5, proc, "a procedure");
2377 #endif
2378
2379 Xen_check_type(Xen_is_string(name), name, 1, S_add_transform, "a string");
2380 Xen_check_type(Xen_is_string(xlabel), xlabel, 2, S_add_transform, "a string");
2381 Xen_check_type(Xen_is_number(lo), lo, 3, S_add_transform, "a number");
2382 Xen_check_type(Xen_is_number(hi), hi, 4, S_add_transform, "a number");
2383 Xen_check_type(Xen_is_procedure(proc), proc, 5, S_add_transform, "a procedure");
2384
2385 return(C_int_to_Xen_transform(add_transform(Xen_string_to_C_string(name),
2386 Xen_string_to_C_string(xlabel),
2387 Xen_real_to_C_double(lo),
2388 Xen_real_to_C_double(hi),
2389 proc)));
2390 }
2391
2392
2393 static int deleted_type = 0;
unset_deleted_transform_type(chan_info * cp)2394 static void unset_deleted_transform_type(chan_info *cp)
2395 {
2396 if (cp->transform_type == deleted_type)
2397 cp->transform_type = DEFAULT_TRANSFORM_TYPE;
2398 }
2399
2400
g_delete_transform(Xen type)2401 static Xen g_delete_transform(Xen type)
2402 {
2403 int typ;
2404 added_transform *af;
2405 #define H_delete_transform "(" S_delete_transform " obj) deletes the specified transform if it was created via " S_add_transform "."
2406
2407 Xen_check_type(xen_is_transform(type), type, 1, S_delete_transform, "a transform");
2408
2409 typ = Xen_transform_to_C_int(type);
2410 if ((typ < NUM_BUILTIN_TRANSFORM_TYPES) || (!is_transform(typ)))
2411 Xen_out_of_range_error(S_delete_transform, 1, type, "an integer (an active added transform)");
2412
2413 af = type_to_transform(typ);
2414 if (af)
2415 {
2416 added_transforms[af->type - NUM_BUILTIN_TRANSFORM_TYPES] = NULL;
2417 free(af->xlabel);
2418 free(af->name);
2419 snd_unprotect_at(af->gc_loc);
2420 af->proc = Xen_false;
2421 free(af);
2422 /* now make sure nobody expects to use that transform */
2423 if (transform_type(ss) == typ) set_transform_type(DEFAULT_TRANSFORM_TYPE);
2424 deleted_type = typ;
2425 for_each_chan(unset_deleted_transform_type);
2426 return(Xen_true);
2427 }
2428 return(Xen_false);
2429 }
2430
2431
Xen_wrap_2_optional_args(g_transform_framples_w,g_transform_framples)2432 Xen_wrap_2_optional_args(g_transform_framples_w, g_transform_framples)
2433 Xen_wrap_4_optional_args(g_transform_sample_w, g_transform_sample)
2434 Xen_wrap_3_optional_args(g_transform_to_vct_w, g_transform_to_vct)
2435 Xen_wrap_5_args(g_add_transform_w, g_add_transform)
2436 Xen_wrap_3_optional_args(g_snd_transform_w, g_snd_transform)
2437 Xen_wrap_1_arg(g_is_transform_w, g_is_transform)
2438 Xen_wrap_1_arg(g_delete_transform_w, g_delete_transform)
2439 Xen_wrap_no_args(g_log_freq_start_w, g_log_freq_start)
2440 Xen_wrap_1_arg(g_set_log_freq_start_w, g_set_log_freq_start)
2441 Xen_wrap_no_args(g_show_selection_transform_w, g_show_selection_transform)
2442 Xen_wrap_1_arg(g_set_show_selection_transform_w, g_set_show_selection_transform)
2443 Xen_wrap_1_arg(g_integer_to_transform_w, g_integer_to_transform)
2444 Xen_wrap_1_arg(g_transform_to_integer_w, g_transform_to_integer)
2445
2446 #if HAVE_SCHEME
2447 static s7_pointer acc_log_freq_start(s7_scheme *sc, s7_pointer args) {return(g_set_log_freq_start(s7_cadr(args)));}
acc_show_selection_transform(s7_scheme * sc,s7_pointer args)2448 static s7_pointer acc_show_selection_transform(s7_scheme *sc, s7_pointer args) {return(g_set_show_selection_transform(s7_cadr(args)));}
2449 #endif
2450
2451 #if (!HAVE_SCHEME)
2452 static Xen transform_temp[6]; /* static for Ruby's sake */
2453 #endif
2454
g_init_fft(void)2455 void g_init_fft(void)
2456 {
2457 #if HAVE_SCHEME
2458 s7_pointer i, b, p, t, fv, r, s, tr, pr;
2459 i = s7_make_symbol(s7, "integer?");
2460 b = s7_make_symbol(s7, "boolean?");
2461 p = s7_make_symbol(s7, "pair?");
2462 fv = s7_make_symbol(s7, "float-vector?");
2463 r = s7_make_symbol(s7, "real?");
2464 s = s7_make_symbol(s7, "string?");
2465 tr = s7_make_symbol(s7, "transform?");
2466 pr = s7_make_symbol(s7, "procedure?");
2467 t = s7_t(s7);
2468 #endif
2469
2470 #if HAVE_SCHEME
2471 #define H_before_transform_hook S_before_transform_hook " (snd chn): called just before a transform is calculated. If it returns \
2472 an integer, it is used as the starting point of the transform. The following \
2473 somewhat brute-force code shows a way to have the transform reflect the position \
2474 of a moving mark:\n\
2475 (define transform-position #f)\n\
2476 (hook-push " S_before_transform_hook "\n\
2477 (lambda (snd chn) transform-position))\n\
2478 (hook-push " S_mark_drag_hook "\n\
2479 (lambda (id)\n\
2480 (set! transform-position (" S_mark_sample " id))\n\
2481 (" S_update_transform_graph ")))"
2482 #endif
2483
2484 #if HAVE_RUBY
2485 #define H_before_transform_hook S_before_transform_hook " (snd chn): called just before a transform is calculated. If it returns \
2486 an integer, it is used as the starting point of the transform. The following \
2487 somewhat brute-force code shows a way to have the transform reflect the position \
2488 of a moving mark:\n\
2489 $transform_position = false\n\
2490 $before_transform_hook.add_hook!(\"snd-fft\") |snd, chn|\n\
2491 $transform_position\n\
2492 end\n\
2493 $mark_drag_hook.add_hook!(\"snd-fft\") |id|\n\
2494 $transform_position = " S_mark_sample "(id)\n\
2495 " S_update_transform_graph "\n\
2496 end"
2497 #endif
2498
2499 #if HAVE_FORTH
2500 #define H_before_transform_hook S_before_transform_hook " (snd chn): called just before a transform is calculated. If it returns \
2501 an integer, it is used as the starting point of the transform. The following \
2502 somewhat brute-force code shows a way to have the transform reflect the position \
2503 of a moving mark:\n\
2504 #f value transform-position\n\
2505 " S_before_transform_hook " lambda: <{ snd chn }> transform-position ; add-hook!\n\
2506 " S_mark_drag_hook " lambda: <{ id }>\n\
2507 id " S_mark_sample " to transform-position\n\
2508 " S_update_transform_graph "\n\
2509 ; add-hook!"
2510 #endif
2511
2512 init_xen_transform();
2513
2514 before_transform_hook = Xen_define_hook(S_before_transform_hook, "(make-hook 'snd 'chn)", 2, H_before_transform_hook);
2515
2516 #if HAVE_SCHEME
2517 s7_define_constant(s7, S_fourier_transform, C_int_to_Xen_transform(FOURIER));
2518 s7_define_constant(s7, S_wavelet_transform, C_int_to_Xen_transform(WAVELET));
2519 s7_define_constant(s7, S_haar_transform, C_int_to_Xen_transform(HAAR));
2520 s7_define_constant(s7, S_cepstrum, C_int_to_Xen_transform(CEPSTRUM));
2521 s7_define_constant(s7, S_walsh_transform, C_int_to_Xen_transform(WALSH));
2522 s7_define_constant(s7, S_autocorrelation, C_int_to_Xen_transform(AUTOCORRELATION));
2523 /* *transform-type* is #<transform Fourier> by default */
2524 #else
2525 Xen_define_variable(S_fourier_transform, transform_temp[0], C_int_to_Xen_transform(FOURIER));
2526 Xen_define_variable(S_wavelet_transform, transform_temp[1], C_int_to_Xen_transform(WAVELET));
2527 Xen_define_variable(S_haar_transform, transform_temp[2], C_int_to_Xen_transform(HAAR));
2528 Xen_define_variable(S_cepstrum, transform_temp[3], C_int_to_Xen_transform(CEPSTRUM));
2529 Xen_define_variable(S_walsh_transform, transform_temp[4], C_int_to_Xen_transform(WALSH));
2530 Xen_define_variable(S_autocorrelation, transform_temp[5], C_int_to_Xen_transform(AUTOCORRELATION));
2531 #endif
2532
2533 #define H_dont_normalize "The value for " S_transform_normalization " that causes the transform to display raw data"
2534 #define H_normalize_by_channel "The value for " S_transform_normalization " that causes the transform to be normalized in each channel independently"
2535 #define H_normalize_by_sound "The value for " S_transform_normalization " that causes the transform to be normalized across a sound's channels"
2536 #define H_normalize_globally "The value for " S_transform_normalization " that causes the transform to be normalized across all sounds"
2537
2538 Xen_define_constant(S_dont_normalize, DONT_NORMALIZE, H_dont_normalize);
2539 Xen_define_constant(S_normalize_by_channel, NORMALIZE_BY_CHANNEL, H_normalize_by_channel);
2540 Xen_define_constant(S_normalize_by_sound, NORMALIZE_BY_SOUND, H_normalize_by_sound);
2541 Xen_define_constant(S_normalize_globally, NORMALIZE_GLOBALLY, H_normalize_globally);
2542
2543 Xen_define_typed_procedure(S_transform_framples, g_transform_framples_w, 0, 2, 0, H_transform_framples,
2544 s7_make_signature(s7, 3, s7_make_signature(s7, 2, i, p), t, t));
2545 Xen_define_typed_procedure(S_transform_sample, g_transform_sample_w, 0, 4, 0, H_transform_sample, s7_make_signature(s7, 5, r, i, i, t, t));
2546 Xen_define_typed_procedure(S_transform_to_vct, g_transform_to_vct_w, 0, 3, 0, H_transform_to_vct, s7_make_signature(s7, 4, fv, t, t, fv));
2547 Xen_define_typed_procedure(S_add_transform, g_add_transform_w, 5, 0, 0, H_add_transform, s7_make_signature(s7, 6, tr, s, s, r, r, pr));
2548 Xen_define_typed_procedure(S_is_transform, g_is_transform_w, 1, 0, 0, H_is_transform, s7_make_signature(s7, 2, b, t));
2549 Xen_define_typed_procedure(S_delete_transform, g_delete_transform_w, 1, 0, 0, H_delete_transform, s7_make_signature(s7, 2, b, tr));
2550 Xen_define_typed_procedure("snd-transform", g_snd_transform_w, 2, 1, 0, H_snd_transform, s7_make_signature(s7, 4, fv, tr, fv, i));
2551
2552 Xen_define_typed_dilambda(S_log_freq_start, g_log_freq_start_w, H_log_freq_start,
2553 S_set S_log_freq_start, g_set_log_freq_start_w, 0, 0, 1, 0,
2554 s7_make_signature(s7, 1, r), s7_make_signature(s7, 2, r, r));
2555
2556 Xen_define_typed_dilambda(S_show_selection_transform, g_show_selection_transform_w, H_show_selection_transform,
2557 S_set S_show_selection_transform, g_set_show_selection_transform_w, 0, 0, 1, 0,
2558 s7_make_signature(s7, 1, b), s7_make_signature(s7, 2, b, b));
2559
2560 Xen_define_typed_procedure(S_integer_to_transform, g_integer_to_transform_w, 1, 0, 0, H_integer_to_transform, s7_make_signature(s7, 2, tr, i));
2561 Xen_define_typed_procedure(S_transform_to_integer, g_transform_to_integer_w, 1, 0, 0, H_transform_to_integer, s7_make_signature(s7, 2, i, tr));
2562
2563 #if HAVE_SCHEME
2564 s7_set_setter(s7, ss->log_freq_start_symbol, s7_make_function(s7, "[acc-" S_log_freq_start "]", acc_log_freq_start, 2, 0, false, "accessor"));
2565 s7_set_setter(s7, ss->show_selection_transform_symbol, s7_make_function(s7, "[acc-" S_show_selection_transform "]", acc_show_selection_transform, 2, 0, false, "accessor"));
2566
2567 s7_set_documentation(s7, ss->log_freq_start_symbol, "*log-freq-start*: log freq base (25.0)");
2568 s7_set_documentation(s7, ss->show_selection_transform_symbol, "*show-selection-transform*: #t if transform display reflects selection, not time-domain window");
2569 #endif
2570 }
2571
2572 /* display by wavelength is not so useful in the context of sound because
2573 * the frequencies span say 8-10 octaves. Even if we place the start point
2574 * at 20Hz, that still puts the (linear) middle at 40 Hz (17 meters->1 inch
2575 * is basically the range); if we goof around with log freq axis, why bother
2576 * with the inverse?
2577 */
2578