|
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286 |
- /* tie CLM module into Scheme, Ruby, or Forth */
-
- /* if the optimizer stops working inexplicably, look for any symbols used before this that
- * might shadow a generator name; one such case was (make-hook 'env...) in snd-env.c
- *
- * (env env) is accepted by the optimizer in error
- */
-
- #include "mus-config.h"
-
- #if USE_SND
- #include "snd.h"
- #endif
-
- #include <stddef.h>
- #include <math.h>
- #include <stdio.h>
- #include <errno.h>
- #include <stdlib.h>
- #include <limits.h>
- #include <string.h>
- #include <stdarg.h>
-
- #ifndef _MSC_VER
- #include <unistd.h>
- #else
- #include <io.h>
- #pragma warning(disable: 4244)
- #endif
-
- #include "_sndlib.h"
- #include "xen.h"
- #include "clm.h"
- #include "sndlib2xen.h"
- #include "vct.h"
- #include "clm2xen.h"
- #include "clm-strings.h"
-
- #ifndef TWO_PI
- #define TWO_PI (2.0 * M_PI)
- #endif
-
- #ifndef PROC_FALSE
- #if HAVE_RUBY
- #define PROC_FALSE "false"
- #define PROC_TRUE "true"
- #else
- #define PROC_FALSE "#f"
- #define PROC_TRUE "#t"
- #endif
- #endif
-
-
- /* -------------------------------------------------------------------------------- */
- #if HAVE_SCHEME
- static bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
- {
- rdout *gen = (rdout *)IO;
- if ((chan < gen->chans) &&
- (samp <= gen->data_end) &&
- (samp >= gen->data_start))
- {
- gen->obufs[chan][samp - gen->data_start] += val;
- if (samp > gen->out_end)
- gen->out_end = samp;
- return(true);
- }
- return(false);
- }
- #endif
-
- /* -------------------------------------------------------------------------------- */
-
- struct mus_xen {
- mus_any *gen;
- int nvcts;
- #if HAVE_SCHEME
- bool free_data;
- #endif
- Xen *vcts; /* one for each accessible mus_float_t array (wrapped up here in a vct) */
- struct mus_xen *next;
- };
-
-
- enum {MUS_DATA_WRAPPER, MUS_INPUT_FUNCTION, MUS_ANALYZE_FUNCTION, MUS_EDIT_FUNCTION, MUS_SYNTHESIZE_FUNCTION, MUS_SAVED_FUNCTION,
- MUS_SELF_WRAPPER, MUS_INPUT_DATA, MUS_MAX_VCTS}; /* order matters, stuff before self_wrapper is GC marked */
-
- static mus_xen *mx_free_lists[9] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL};
-
- static mus_xen *mx_alloc(int vcts)
- {
- mus_xen *p;
- if (mx_free_lists[vcts])
- {
- p = mx_free_lists[vcts];
- mx_free_lists[vcts] = p->next;
- return(p);
- }
- p = (mus_xen *)malloc(sizeof(mus_xen));
- p->nvcts = vcts;
- if (vcts > 0)
- p->vcts = (Xen *)malloc(vcts * sizeof(Xen));
- else p->vcts = NULL;
- #if HAVE_SCHEME
- p->free_data = false;
- #endif
- return(p);
- }
-
-
- static void mx_free(mus_xen *p)
- {
- #if HAVE_SCHEME
- if (p->free_data)
- {
- s7_xf_attach(s7, (void *)(p->vcts[MUS_INPUT_DATA]));
- p->free_data = false;
- }
- #endif
- p->next = mx_free_lists[p->nvcts];
- mx_free_lists[p->nvcts] = p;
- }
-
-
- mus_any *mus_xen_gen(mus_xen *x) {return(x->gen);}
- #define mus_xen_to_mus_any(Gn) (((mus_xen *)Gn)->gen)
-
- #if (!HAVE_SCHEME)
- #define XEN_NULL 0
-
- #define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) \
- if (Xen_is_bound(Xen_Arg)) {if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");}
-
- #define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {C_Val = 0.0; if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");} while (0)
-
- #define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) Xen_real_to_C_double(Xen_Arg)
-
- #define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {if (Xen_is_integer(Xen_Arg)) C_Val = Xen_integer_to_C_int(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
-
- #if (HAVE_FORTH) || (HAVE_RUBY)
- #define Xen_object_ref_checked(Obj, Type) (Xen_c_object_is_type(Obj, Type) ? Xen_object_ref(Obj) : NULL)
- #else
- #define Xen_object_ref_checked(Obj, Type) NULL
- #endif
-
- #else
- #define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) if (Xen_is_bound(Xen_Arg)) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
- #define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
- #define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
-
- #define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
- do {if (s7_is_integer(Xen_Arg)) C_Val = s7_integer(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
-
- #define Xen_object_ref_checked(Obj, Type) s7_object_value_checked(Obj, Type)
- #define XEN_NULL NULL
- #endif
-
-
- static int local_error_type = MUS_NO_ERROR;
- static char *local_error_msg = NULL;
-
- static void local_mus_error(int type, char *msg)
- {
- local_error_type = type;
- if (local_error_msg) free(local_error_msg);
- local_error_msg = mus_strdup(msg);
- }
-
-
- static Xen clm_mus_error(int type, const char *msg, const char *caller)
- {
- /* mus_error returns an int, which is a bother in this context */
- mus_error(type, "%s: %s", caller, msg);
- return(Xen_false);
- }
-
-
- #define CLM_ERROR Xen_make_error_type("mus-error")
-
- static void clm_error(const char *caller, const char *msg, Xen val)
- {
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: ~A ~A"),
- C_string_to_Xen_string(caller),
- C_string_to_Xen_string(msg),
- val));
- }
-
-
-
- /* ---------------- optional-key ---------------- */
-
- int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig)
- {
- /* implement the &optional-key notion in CLM */
- /* "keys" holds the keywords the calling function accepts,
- * upon return, if a key was given in the arglist or its position had a value, the corresponding value is in its keys location
- * "nkeys is the size of "keys"
- * "args" contains the original arguments passed to the function in order
- * it should be of size nkeys * 2, and any trailing (unspecified) args should be Xen_undefined
- * "orig" should be of size nkeys, and will contain upon return the 1-based location of the original keyword value argument
- * (it is intended for error reports)
- */
- int arg_ctr = 0, key_start = 0, rtn_ctr = 0, nargs, nargs_end;
- bool keying = false, key_found = false;
- nargs = nkeys * 2;
- nargs_end = nargs - 1;
-
- while ((arg_ctr < nargs) &&
- (Xen_is_bound(args[arg_ctr])))
- {
- Xen key;
- key = args[arg_ctr];
- if (!(Xen_is_keyword(key)))
- {
- if (keying)
- clm_error(caller, "unmatched value within keyword section?", key);
- /* type checking on the actual values has to be the caller's problem */
-
- if (arg_ctr >= nkeys) /* we aren't handling a keyword arg, so the underlying args should only take nkeys args */
- clm_error(caller, "extra trailing args?", key);
-
- keys[arg_ctr] = key;
- orig[arg_ctr] = arg_ctr + 1;
- arg_ctr++;
- key_start = arg_ctr;
- rtn_ctr++;
- }
- else
- {
- int i;
- Xen val;
- val = args[arg_ctr + 1];
- if ((arg_ctr == nargs_end) ||
- (!(Xen_is_bound(val))))
- clm_error(caller, "keyword without value?", key);
-
- if (Xen_is_keyword(val))
- clm_error(caller, "two keywords in a row?", key);
-
- keying = true;
- key_found = false;
- for (i = key_start; i < nkeys; i++)
- {
- if (Xen_keyword_is_eq(keys[i], key))
- {
- keys[i] = val;
- arg_ctr += 2;
- orig[i] = arg_ctr;
- rtn_ctr++;
- key_found = true;
- break;
- }
- }
-
- if (!key_found)
- {
- /* either there's a redundant keyword pair or a keyword that 'caller' doesn't recognize */
- clm_error(caller, "redundant or invalid key found", key);
- /* normally (all local cases) the error returns */
- arg_ctr += 2;
- }
- }
- }
- return(rtn_ctr);
- }
-
-
- static mus_float_t optkey_float_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "a number");
- return(0.0);
- }
-
- #define Xen_optkey_to_float(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_number(Key)) ? Xen_real_to_C_double(Key) : optkey_float_error(Key, N, Caller)))
-
- mus_float_t mus_optkey_to_float(Xen key, const char *caller, int n, mus_float_t def)
- {
- if (Xen_is_number(key))
- return(Xen_real_to_C_double(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "a number");
- return(def);
- }
-
-
- static int optkey_int_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "an integer");
- return(0);
- }
-
- #define Xen_optkey_to_int(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_integer_to_C_int(Key) : optkey_int_error(Key, N, Caller)))
-
- int mus_optkey_to_int(Xen key, const char *caller, int n, int def)
- {
- if (Xen_is_integer(key))
- return(Xen_integer_to_C_int(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "an integer");
- return(def);
- }
-
-
- bool mus_optkey_to_bool(Xen key, const char *caller, int n, bool def)
- {
- if (Xen_is_boolean(key))
- return(Xen_boolean_to_C_bool(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "#f or #t");
- return(def);
- }
-
-
- static mus_long_t optkey_llong_error(Xen key, int n, const char *caller)
- {
- Xen_check_type(false, key, n, caller, "an integer");
- return(0);
- }
-
- #define Xen_optkey_to_mus_long_t(Original_key, Key, Caller, N, Def) \
- ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_llong_to_C_llong(Key) : optkey_llong_error(Key, N, Caller)))
-
- mus_long_t mus_optkey_to_mus_long_t(Xen key, const char *caller, int n, mus_long_t def)
- {
- if (Xen_is_integer(key))
- return(Xen_llong_to_C_llong(key));
- if (!(Xen_is_keyword(key)))
- Xen_check_type(false, key, n, caller, "a sample number or size");
- return(def);
- }
-
-
- const char *mus_optkey_to_string(Xen key, const char *caller, int n, char *def)
- {
- if (Xen_is_string(key))
- return(Xen_string_to_C_string(key));
- if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a string");
- return(def);
- }
-
-
- static vct *mus_optkey_to_vct(Xen key, const char *caller, int n, vct *def)
- {
- if (mus_is_vct(key))
- return(Xen_to_vct(key));
- if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a " S_vct);
- return(def);
- }
-
-
- static bool local_arity_ok(Xen proc, int args) /* from snd-xen.c minus (inconvenient) gc protection */
- {
- #if HAVE_SCHEME
- return(s7_is_aritable(s7, proc, args));
- #else
- Xen arity;
- int rargs;
- arity = Xen_arity(proc);
- rargs = Xen_integer_to_C_int(arity);
-
- #if HAVE_RUBY
- return(xen_rb_arity_ok(rargs, args));
- #endif
-
- #if HAVE_FORTH
- return(rargs == args);
- #endif
- #endif
- return(true);
- }
-
-
- Xen mus_optkey_to_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
- {
- /* in this case, it's faster to look for the keyword first */
- if ((!(Xen_is_keyword(key))) &&
- (!(Xen_is_false(key))))
- {
- Xen_check_type(Xen_is_procedure(key), key, n, caller, "a procedure");
- if (!(local_arity_ok(key, required_args)))
- Xen_bad_arity_error(caller, n, key, err);
- return(key);
- }
- return(def);
- }
-
-
-
- /* ---------------- clm keywords ---------------- */
-
- static Xen kw_frequency, kw_initial_phase, kw_wave, kw_amplitude,
- kw_r, kw_ratio, kw_size, kw_a0, kw_a1, kw_a2, kw_b1, kw_b2, kw_max_size,
- kw_input, kw_srate, kw_file, kw_channel, kw_start,
- kw_initial_contents, kw_initial_element, kw_scaler, kw_feedforward, kw_feedback,
- kw_radius, kw_partials, kw_a, kw_n,
- kw_order, kw_x_coeffs, kw_y_coeffs, kw_envelope, kw_base, kw_duration, kw_offset, kw_end,
- kw_direction, kw_degree, kw_distance, kw_reverb, kw_output, kw_fft_size,
- kw_expansion, kw_length, kw_hop, kw_ramp, kw_jitter,
- kw_type, kw_channels, kw_filter, kw_revout, kw_width,
- kw_edit, kw_synthesize, kw_analyze, kw_interp, kw_overlap, kw_pitch,
- kw_distribution, kw_coeffs, kw_kind;
-
-
- static void init_keywords(void)
- {
- /* in Ruby there's rb_intern of the symbol -- is it safe? */
- kw_frequency = Xen_make_keyword("frequency");
- kw_initial_phase = Xen_make_keyword("initial-phase");
- kw_wave = Xen_make_keyword("wave");
- kw_amplitude = Xen_make_keyword("amplitude");
- kw_r = Xen_make_keyword("r");
- kw_ratio = Xen_make_keyword("ratio");
- kw_size = Xen_make_keyword("size");
- kw_a0 = Xen_make_keyword("a0");
- kw_a1 = Xen_make_keyword("a1");
- kw_a2 = Xen_make_keyword("a2");
- kw_b1 = Xen_make_keyword("b1");
- kw_b2 = Xen_make_keyword("b2");
- kw_max_size = Xen_make_keyword("max-size");
- kw_input = Xen_make_keyword("input");
- kw_srate = Xen_make_keyword("srate");
- kw_file = Xen_make_keyword("file");
- kw_channel = Xen_make_keyword("channel");
- kw_start = Xen_make_keyword("start"); /* make-readin */
- kw_initial_contents = Xen_make_keyword("initial-contents");
- kw_initial_element = Xen_make_keyword("initial-element");
- kw_scaler = Xen_make_keyword("scaler");
- kw_feedforward = Xen_make_keyword("feedforward");
- kw_feedback = Xen_make_keyword("feedback");
- kw_radius = Xen_make_keyword("radius");
- kw_partials = Xen_make_keyword("partials");
- kw_a = Xen_make_keyword("a");
- kw_n = Xen_make_keyword("n");
- kw_order = Xen_make_keyword("order");
- kw_x_coeffs = Xen_make_keyword("xcoeffs");
- kw_y_coeffs = Xen_make_keyword("ycoeffs");
- kw_envelope = Xen_make_keyword("envelope");
- kw_base = Xen_make_keyword("base");
- kw_duration = Xen_make_keyword("duration");
- kw_offset = Xen_make_keyword("offset");
- kw_end = Xen_make_keyword("end");
- kw_direction = Xen_make_keyword("direction");
- kw_degree = Xen_make_keyword("degree");
- kw_distance = Xen_make_keyword("distance");
- kw_reverb = Xen_make_keyword("reverb");
- kw_output = Xen_make_keyword("output");
- kw_fft_size = Xen_make_keyword("fft-size");
- kw_expansion = Xen_make_keyword("expansion");
- kw_length = Xen_make_keyword("length");
- kw_hop = Xen_make_keyword("hop");
- kw_ramp = Xen_make_keyword("ramp");
- kw_jitter = Xen_make_keyword("jitter");
- kw_type = Xen_make_keyword("type");
- kw_channels = Xen_make_keyword("channels");
- kw_filter = Xen_make_keyword("filter");
- kw_revout = Xen_make_keyword("revout");
- kw_width = Xen_make_keyword("width");
- kw_edit = Xen_make_keyword("edit");
- kw_synthesize = Xen_make_keyword("synthesize");
- kw_analyze = Xen_make_keyword("analyze");
- kw_interp = Xen_make_keyword("interp");
- kw_overlap = Xen_make_keyword("overlap");
- kw_pitch = Xen_make_keyword("pitch");
- kw_distribution = Xen_make_keyword("distribution");
- kw_coeffs = Xen_make_keyword("coeffs");
- kw_kind = Xen_make_keyword("kind");
- }
-
-
-
- /* ---------------- *clm-table-size* ---------------- */
-
- static mus_long_t clm_table_size = MUS_CLM_DEFAULT_TABLE_SIZE;
- #if HAVE_SCHEME
- static s7_pointer clm_table_size_symbol;
- #endif
-
- mus_long_t clm_default_table_size_c(void) {return(clm_table_size);}
-
- static Xen g_clm_table_size(void) {return(C_llong_to_Xen_llong(clm_table_size));}
-
- static Xen g_set_clm_table_size(Xen val)
- {
- mus_long_t size;
- #define H_clm_table_size "(" S_clm_table_size "): the default table size for most generators (512)"
- Xen_check_type(Xen_is_llong(val), val, 1, S_set S_clm_table_size, "an integer");
- size = Xen_llong_to_C_llong(val);
- if ((size <= 0) ||
- (size > mus_max_table_size()))
- Xen_out_of_range_error(S_set S_clm_table_size, 1, val, "invalid size (see mus-max-table-size)");
- clm_table_size = size;
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_table_size_symbol, s7_make_integer(s7, clm_table_size));
- #endif
- return(C_llong_to_Xen_llong(clm_table_size));
- }
-
-
- /* ---------------- *clm-default-frequency* ---------------- */
-
- static mus_float_t clm_default_frequency = MUS_CLM_DEFAULT_FREQUENCY;
- #if HAVE_SCHEME
- static s7_pointer clm_default_frequency_symbol;
- #endif
-
- mus_float_t clm_default_frequency_c(void) {return(clm_default_frequency);}
-
- static Xen g_clm_default_frequency(void) {return(C_double_to_Xen_real(clm_default_frequency));}
-
- static Xen g_set_clm_default_frequency(Xen val)
- {
- #define H_clm_default_frequency "(" S_clm_default_frequency "): the default frequency for most generators (0.0)"
- Xen_check_type(Xen_is_double(val), val, 1, S_set S_clm_default_frequency, "a number");
- clm_default_frequency = Xen_real_to_C_double(val);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_default_frequency_symbol, s7_make_real(s7, clm_default_frequency));
- #endif
- return(val);
- }
-
-
-
- /* ---------------- AM and simple stuff ---------------- */
-
- static const char *fft_window_xen_names[MUS_NUM_FFT_WINDOWS] =
- {S_rectangular_window, S_hann_window, S_welch_window, S_parzen_window, S_bartlett_window,
- S_hamming_window, S_blackman2_window, S_blackman3_window, S_blackman4_window,
- S_exponential_window, S_riemann_window, S_kaiser_window, S_cauchy_window,
- S_poisson_window, S_gaussian_window, S_tukey_window, S_dolph_chebyshev_window,
- S_hann_poisson_window, S_connes_window, S_samaraki_window, S_ultraspherical_window,
- S_bartlett_hann_window, S_bohman_window, S_flat_top_window,
- S_blackman5_window, S_blackman6_window, S_blackman7_window, S_blackman8_window, S_blackman9_window, S_blackman10_window,
- S_rv2_window, S_rv3_window, S_rv4_window, S_mlt_sine_window, S_papoulis_window, S_dpss_window, S_sinc_window
- };
-
-
- const char *mus_fft_window_xen_name(mus_fft_window_t i) {return(fft_window_xen_names[(int)i]);}
-
-
- static Xen g_mus_file_buffer_size(void)
- {
- #define H_mus_file_buffer_size "(" S_mus_file_buffer_size "): current CLM IO buffer size (default is 8192)"
- return(C_llong_to_Xen_llong(mus_file_buffer_size()));
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_file_buffer_size_symbol;
- #endif
-
- static Xen g_mus_set_file_buffer_size(Xen val)
- {
- mus_long_t len;
- Xen_check_type(Xen_is_llong(val), val, 1, S_set S_mus_file_buffer_size, "an integer");
- len = Xen_llong_to_C_llong(val);
- if (len <= 0)
- Xen_out_of_range_error(S_set S_mus_file_buffer_size, 1, val, "must be > 0");
- mus_set_file_buffer_size(len);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_file_buffer_size_symbol, s7_make_integer(s7, len));
- #endif
- return(val);
- }
-
-
- static Xen g_radians_to_hz(Xen val)
- {
- #define H_radians_to_hz "(" S_radians_to_hz " rads): convert radians per sample to frequency in Hz: rads * srate / (2 * pi)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_radians_to_hz, 1);
- return(C_double_to_Xen_real(mus_radians_to_hz(x)));
- }
-
-
- static Xen g_hz_to_radians(Xen val)
- {
- #define H_hz_to_radians "(" S_hz_to_radians " hz): convert frequency in Hz to radians per sample: hz * 2 * pi / srate"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_hz_to_radians, 1);
- return(C_double_to_Xen_real(mus_hz_to_radians(x)));
- }
-
-
- static Xen g_radians_to_degrees(Xen val)
- {
- #define H_radians_to_degrees "(" S_radians_to_degrees " rads): convert radians to degrees: rads * 360 / (2 * pi)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_radians_to_degrees, 1);
- return(C_double_to_Xen_real(mus_radians_to_degrees(x)));
- }
-
-
- static Xen g_degrees_to_radians(Xen val)
- {
- #define H_degrees_to_radians "(" S_degrees_to_radians " deg): convert degrees to radians: deg * 2 * pi / 360"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_degrees_to_radians, 1);
- return(C_double_to_Xen_real(mus_degrees_to_radians(x)));
- }
-
-
- static Xen g_db_to_linear(Xen val)
- {
- #define H_db_to_linear "(" S_db_to_linear " db): convert decibel value db to linear value: pow(10, db / 20)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_db_to_linear, 1);
- return(C_double_to_Xen_real(mus_db_to_linear(x)));
- }
-
-
- static Xen g_linear_to_db(Xen val)
- {
- #define H_linear_to_db "(" S_linear_to_db " lin): convert linear value to decibels: 20 * log10(lin)"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_linear_to_db, 1);
- return(C_double_to_Xen_real(mus_linear_to_db(x)));
- }
-
-
- static Xen g_even_weight(Xen val)
- {
- #define H_even_weight "(" S_even_weight " x): return the even weight of x"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_even_weight, 1);
- return(C_double_to_Xen_real(mus_even_weight(x)));
- }
-
-
- static Xen g_odd_weight(Xen val)
- {
- #define H_odd_weight "(" S_odd_weight " x): return the odd weight of x"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_odd_weight, 1);
- return(C_double_to_Xen_real(mus_odd_weight(x)));
- }
-
-
- static Xen g_even_multiple(Xen val1, Xen val2)
- {
- #define H_even_multiple "(" S_even_multiple " x y): return the even multiple of x and y"
- mus_float_t x, y;
- Xen_to_C_double_or_error(val1, x, S_even_multiple, 1);
- Xen_to_C_double_or_error(val2, y, S_even_multiple, 2);
- return(C_double_to_Xen_real(mus_even_multiple(x, y)));
- }
-
-
- static Xen g_odd_multiple(Xen val1, Xen val2)
- {
- #define H_odd_multiple "(" S_odd_multiple " x y): return the odd multiple of x and y"
- mus_float_t x, y;
- Xen_to_C_double_or_error(val1, x, S_odd_multiple, 1);
- Xen_to_C_double_or_error(val2, y, S_odd_multiple, 2);
- return(C_double_to_Xen_real(mus_odd_multiple(x, y)));
- }
-
-
- static Xen g_seconds_to_samples(Xen val)
- {
- #define H_seconds_to_samples "(" S_seconds_to_samples " secs): use " S_mus_srate " to convert seconds to samples"
- mus_float_t x;
- Xen_to_C_double_or_error(val, x, S_seconds_to_samples, 1);
- return(C_llong_to_Xen_llong(mus_seconds_to_samples(x)));
- }
-
-
- static Xen g_samples_to_seconds(Xen val)
- {
- #define H_samples_to_seconds "(" S_samples_to_seconds " samps): use " S_mus_srate " to convert samples to seconds"
- Xen_check_type(Xen_is_llong(val), val, 1, S_samples_to_seconds, "a number");
- return(C_double_to_Xen_real(mus_samples_to_seconds(Xen_llong_to_C_llong(val))));
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer clm_srate_symbol;
- #endif
-
- static Xen g_mus_srate(void)
- {
- #define H_mus_srate "(" S_mus_srate "): current sampling rate"
- return(C_double_to_Xen_real(mus_srate()));
- }
-
-
- static Xen g_mus_set_srate(Xen val)
- {
- mus_float_t sr;
- Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_srate, "a number");
- sr = Xen_real_to_C_double(val);
- if (sr != mus_srate())
- {
- if (sr <= 0.0)
- Xen_out_of_range_error(S_set S_mus_srate, 1, val, "must be > 0.0");
- mus_set_srate(sr);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, clm_srate_symbol, s7_make_real(s7, sr));
- #endif
- }
- return(val);
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_float_equal_fudge_factor_symbol;
- #endif
-
- static Xen g_mus_float_equal_fudge_factor(void)
- {
- #define H_mus_float_equal_fudge_factor "(" S_mus_float_equal_fudge_factor "): floating point equality fudge factor"
- return(C_double_to_Xen_real(mus_float_equal_fudge_factor()));
- }
-
-
- static Xen g_mus_set_float_equal_fudge_factor(Xen val)
- {
- mus_float_t factor;
- Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_float_equal_fudge_factor, "a number");
- factor = Xen_real_to_C_double(val);
- if (factor != mus_float_equal_fudge_factor())
- {
- mus_set_float_equal_fudge_factor(factor);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_float_equal_fudge_factor_symbol, s7_make_real(s7, factor));
- #endif
- }
- return(val);
- }
-
-
- #if HAVE_SCHEME
- static s7_pointer mus_array_print_length_symbol;
- #endif
-
- static Xen g_mus_array_print_length(void)
- {
- #define H_mus_array_print_length "(" S_mus_array_print_length "): current clm array print length (default is 8). This \
- affects error reporting and generator descriptions. Array (" S_vct ") elements beyond this length are represented by '...'"
- return(C_int_to_Xen_integer(mus_array_print_length()));
- }
-
-
- static Xen g_mus_set_array_print_length(Xen val)
- {
- int len;
- Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mus_array_print_length, "an integer");
- len = Xen_integer_to_C_int(val);
- if (len != mus_array_print_length())
- {
- if (len < 0)
- Xen_out_of_range_error(S_set S_mus_array_print_length, 1, val, "must be >= 0");
- mus_set_array_print_length(len);
- #if HAVE_SCHEME
- s7_symbol_set_value(s7, mus_array_print_length_symbol, s7_make_integer(s7, len));
- #endif
- }
- return(val);
- }
-
-
- static Xen g_ring_modulate(Xen val1, Xen val2)
- {
- #define H_ring_modulate "(" S_ring_modulate " s1 s2): s1 * s2 (sample by sample multiply)"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_ring_modulate, "a number");
- Xen_check_type(Xen_is_number(val2), val2, 2, S_ring_modulate, "a number");
- return(C_double_to_Xen_real(mus_ring_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2))));
- }
-
-
- static Xen g_amplitude_modulate(Xen val1, Xen val2, Xen val3)
- {
- #define H_amplitude_modulate "(" S_amplitude_modulate " carrier in1 in2): in1 * (carrier + in2)"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_amplitude_modulate, "a number");
- Xen_check_type(Xen_is_number(val2), val2, 2, S_amplitude_modulate, "a number");
- Xen_check_type(Xen_is_number(val3), val3, 3, S_amplitude_modulate, "a number");
- return(C_double_to_Xen_real(mus_amplitude_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2), Xen_real_to_C_double(val3))));
- }
-
-
- static Xen g_contrast_enhancement(Xen val1, Xen val2)
- {
- mus_float_t index = 1.0; /* this is the default in clm.html and mus.lisp */
- #define H_contrast_enhancement "(" S_contrast_enhancement " sig (index 1.0)): sin(sig * pi / 2 + index * sin(sig * 2 * pi))"
- Xen_check_type(Xen_is_number(val1), val1, 1, S_contrast_enhancement, "a number");
- if (Xen_is_bound(val2))
- {
- Xen_check_type(Xen_is_number(val2), val2, 2, S_contrast_enhancement, "a number");
- index = Xen_real_to_C_double(val2);
- }
- return(C_double_to_Xen_real(mus_contrast_enhancement(Xen_real_to_C_double(val1), index)));
- }
-
-
- static Xen g_dot_product(Xen val1, Xen val2, Xen size)
- {
- #define H_dot_product "(" S_dot_product " v1 v2 (size)): sum of v1[i] * v2[i] (also named scalar product)"
- vct *v1, *v2;
- mus_long_t len;
-
- Xen_check_type(mus_is_vct(val1), val1, 1, S_dot_product, "a " S_vct);
- Xen_check_type(mus_is_vct(val2), val2, 2, S_dot_product, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_dot_product, "an integer");
-
- v1 = Xen_to_vct(val1);
- v2 = Xen_to_vct(val2);
- if (Xen_is_llong(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len < 0)
- Xen_out_of_range_error(S_dot_product, 3, size, "size < 0?");
- if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
- }
- else len = mus_vct_length(v1);
- if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
-
- return(C_double_to_Xen_real(mus_dot_product(mus_vct_data(v1), mus_vct_data(v2), len)));
- }
-
-
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
-
- #if defined(__sun) && defined(__SVR4)
- #undef _Complex_I
- #define _Complex_I 1.0fi
- #endif
-
- #define S_edot_product "edot-product"
-
- static Xen g_edot_product(Xen val1, Xen val2)
- {
- #define H_edot_product "(" S_edot_product " freq data): sum of (e^freq*i) * data[i]"
- mus_long_t i, len;
- vct *v = NULL;
- complex double freq;
- complex double *vals;
- Xen result;
-
- Xen_check_type(Xen_is_complex(val1), val1, 1, S_edot_product, "complex");
- Xen_check_type((mus_is_vct(val2)) || (Xen_is_vector(val2)), val2, 2, S_edot_product, "a " S_vct);
-
- freq = Xen_complex_to_C_complex(val1);
- if (mus_is_vct(val2))
- {
- v = Xen_to_vct(val2);
- len = mus_vct_length(v);
- }
- else
- {
- len = Xen_vector_length(val2);
- }
- vals = (complex double *)calloc(len, sizeof(complex double));
- if (mus_is_vct(val2))
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(v);
- for (i = 0; i < len; i++)
- vals[i] = vdata[i];
- }
- else
- {
- for (i = 0; i < len; i++)
- vals[i] = Xen_complex_to_C_complex(Xen_vector_ref(val2, i));
- }
- result = C_complex_to_Xen_complex(mus_edot_product(freq, vals, len));
- free(vals);
- return(result);
- }
- #endif
-
- typedef enum {G_RECTANGULAR_POLAR, G_POLAR_RECTANGULAR, G_RECTANGULAR_MAGNITUDES} xclm_window_t;
-
- static Xen g_fft_window_1(xclm_window_t choice, Xen val1, Xen val2, Xen ulen, const char *caller)
- {
- vct *v1, *v2;
- mus_long_t len;
-
- Xen_check_type(mus_is_vct(val1), val1, 1, caller, "a " S_vct);
- Xen_check_type(mus_is_vct(val2), val2, 2, caller, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(ulen), ulen, 3, caller, "an integer");
-
- v1 = Xen_to_vct(val1);
- v2 = Xen_to_vct(val2);
- if (Xen_is_llong(ulen))
- {
- len = Xen_llong_to_C_llong(ulen);
- if (len == 0) return(Xen_false);
- if (len < 0)
- Xen_out_of_range_error(caller, 3, ulen, "size < 0?");
- if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
- }
- else len = mus_vct_length(v1);
- if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
- switch (choice)
- {
- case G_RECTANGULAR_POLAR: mus_rectangular_to_polar(mus_vct_data(v1), mus_vct_data(v2), len); break;
- case G_RECTANGULAR_MAGNITUDES: mus_rectangular_to_magnitudes(mus_vct_data(v1), mus_vct_data(v2), len); break;
- case G_POLAR_RECTANGULAR: mus_polar_to_rectangular(mus_vct_data(v1), mus_vct_data(v2), len); break;
- }
- return(val1);
- }
-
-
- static Xen g_rectangular_to_polar(Xen val1, Xen val2)
- {
- #define H_rectangular_to_polar "(" S_rectangular_to_polar " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from rectangular form (fft output) to polar form (a spectrum)"
-
- return(g_fft_window_1(G_RECTANGULAR_POLAR, val1, val2, Xen_undefined, S_rectangular_to_polar));
- }
-
-
- static Xen g_rectangular_to_magnitudes(Xen val1, Xen val2)
- {
- #define H_rectangular_to_magnitudes "(" S_rectangular_to_magnitudes " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from rectangular form (fft output) to polar form, but ignore the phases"
-
- return(g_fft_window_1(G_RECTANGULAR_MAGNITUDES, val1, val2, Xen_undefined, S_rectangular_to_magnitudes));
- }
-
-
- static Xen g_polar_to_rectangular(Xen val1, Xen val2)
- {
- #define H_polar_to_rectangular "(" S_polar_to_rectangular " rl im): convert real/imaginary \
- data in " S_vct "s rl and im from polar (spectrum) to rectangular (fft)"
-
- return(g_fft_window_1(G_POLAR_RECTANGULAR, val1, val2, Xen_undefined, S_polar_to_rectangular));
- }
-
- #if HAVE_SCHEME
- #if (!WITH_GMP)
- #define PF2_TO_PF(CName, Cfnc) \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _pf_a); \
- return(NULL); \
- }
-
- PF2_TO_PF(rectangular_to_polar, g_rectangular_to_polar(x, y))
- PF2_TO_PF(polar_to_rectangular, g_polar_to_rectangular(x, y))
- PF2_TO_PF(rectangular_to_magnitudes, g_rectangular_to_magnitudes(x, y))
- #endif
- #endif
-
-
- static Xen g_mus_fft(Xen url, Xen uim, Xen len, Xen usign)
- {
- #define H_mus_fft "(" S_mus_fft " rl im (len) (dir 1)): return the fft of " S_vct "s rl and im which contain \
- the real and imaginary parts of the data; len should be a power of 2, dir = 1 for fft, -1 for inverse-fft"
-
- int sign;
- mus_long_t n;
- vct *v1, *v2;
-
- Xen_check_type((mus_is_vct(url)), url, 1, S_mus_fft, "a " S_vct);
- Xen_check_type((mus_is_vct(uim)), uim, 2, S_mus_fft, "a " S_vct);
-
- v1 = Xen_to_vct(url);
- v2 = Xen_to_vct(uim);
-
- if (Xen_is_integer(usign))
- sign = Xen_integer_to_C_int(usign);
- else sign = 1;
-
- if (Xen_is_llong(len))
- {
- n = Xen_llong_to_C_llong(len);
- if (n <= 0)
- Xen_out_of_range_error(S_mus_fft, 3, len, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_mus_fft, 3, len, "size too large (see mus-max-malloc)");
- if (n > mus_vct_length(v1))
- n = mus_vct_length(v1);
- }
- else n = mus_vct_length(v1);
-
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
-
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (mus_long_t)pow(2.0, np);
- }
-
- if (n > 0)
- mus_fft(mus_vct_data(v1), mus_vct_data(v2), n, sign);
- /*
- * in fftw, there's the extra complex array allocation, so for n = 2^29
- * (and doubles for vcts as well as fftw), we need 24.6 Gbytes, and the FFT
- * takes 144 secs on a 2.4 GHz machine. (Similarly, 2^28 needs 12.6 Gb
- * and takes 61 secs).
- */
-
- return(url);
- }
-
-
- static Xen g_make_fft_window(Xen type, Xen size, Xen ubeta, Xen ualpha)
- {
- #if HAVE_SCHEME
- #define make_window_example "(" S_make_fft_window " " S_hamming_window " 256)"
- #endif
- #if HAVE_RUBY
- #define make_window_example "make_fft_window(Hamming_window, 256)"
- #endif
- #if HAVE_FORTH
- #define make_window_example "hamming-window 256 make-fft-window"
- #endif
-
- #define H_make_fft_window "(" S_make_fft_window " type size (beta 0.0) (alpha 0.0)): -> fft data window (a " S_vct "). \
- type is one of the sndlib fft window identifiers such as " S_kaiser_window ", beta \
- is the window family parameter, if any:\n " make_window_example
-
- mus_float_t beta = 0.0, alpha = 0.0;
- mus_long_t n;
- int fft_window;
- mus_float_t *data;
-
- Xen_check_type(Xen_is_integer(type), type, 1, S_make_fft_window, "an integer (window type)");
- Xen_check_type(Xen_is_llong(size), size, 2, S_make_fft_window, "an integer");
-
- if (Xen_is_number(ubeta)) beta = Xen_real_to_C_double(ubeta);
- if (Xen_is_number(ualpha)) alpha = Xen_real_to_C_double(ualpha);
-
- n = Xen_llong_to_C_llong(size);
- if (n <= 0)
- Xen_out_of_range_error(S_make_fft_window, 2, size, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_make_fft_window, 2, size, "size too large (see mus-max-malloc)");
-
- fft_window = Xen_integer_to_C_int(type);
- if (!(mus_is_fft_window(fft_window)))
- Xen_out_of_range_error(S_make_fft_window, 1, type, "unknown fft window");
-
- data = (mus_float_t *)malloc(n * sizeof(mus_float_t));
- mus_make_fft_window_with_window((mus_fft_window_t)fft_window, n, beta, alpha, data);
- return(xen_make_vct(n, data));
- }
-
-
- static Xen g_spectrum(Xen url, Xen uim, Xen uwin, Xen utype)
- {
- #define H_mus_spectrum "(" S_spectrum " rl im window (type 1)): \
- real and imaginary data in " S_vct "s rl and im, returns (in rl) the spectrum thereof; \
- window is the fft data window (a " S_vct " as returned by " S_make_fft_window "), \
- and type determines how the spectral data is scaled:\n\
- 0 = data in dB,\n\
- 1 (default) = linear and normalized\n\
- 2 = linear and un-normalized."
-
- int type;
- mus_long_t n;
- vct *v1, *v2, *v3 = NULL;
-
- Xen_check_type((mus_is_vct(url)), url, 1, S_spectrum, "a " S_vct);
- Xen_check_type((mus_is_vct(uim)), uim, 2, S_spectrum, "a " S_vct);
- if (!Xen_is_false(uwin)) Xen_check_type((mus_is_vct(uwin)), uwin, 3, S_spectrum, "a " S_vct " or " PROC_FALSE);
-
- v1 = Xen_to_vct(url);
- v2 = Xen_to_vct(uim);
- if (!Xen_is_false(uwin)) v3 = Xen_to_vct(uwin);
-
- n = mus_vct_length(v1);
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
- if ((v3) && (n > mus_vct_length(v3)))
- n = mus_vct_length(v3);
-
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (int)pow(2.0, np);
- }
-
- if (Xen_is_integer(utype))
- type = Xen_integer_to_C_int(utype);
- else type = 1; /* linear normalized */
- if ((type < 0) || (type > 2))
- Xen_out_of_range_error(S_spectrum, 4, utype, "type must be 0..2");
-
- if (n > 0)
- mus_spectrum(mus_vct_data(v1), mus_vct_data(v2), (v3) ? (mus_vct_data(v3)) : NULL, n, (mus_spectrum_t)type);
- return(url);
- }
-
-
- static Xen g_autocorrelate(Xen reals)
- {
- #define H_autocorrelate "(" S_autocorrelate " data): in place autocorrelation of data (a " S_vct ")"
- /* assumes length is power of 2 */
- vct *v1 = NULL;
- Xen_check_type(mus_is_vct(reals), reals, 1, S_autocorrelate, "a " S_vct);
- v1 = Xen_to_vct(reals);
- if (mus_vct_length(v1) > 0)
- mus_autocorrelate(mus_vct_data(v1), mus_vct_length(v1));
- return(reals);
- }
-
-
- static Xen g_correlate(Xen data1, Xen data2)
- {
- #define H_correlate "(" S_correlate " data1 data2): in place cross-correlation of data1 and data2 (both " S_vct "s)"
- mus_long_t size;
- vct *v1 = NULL, *v2 = NULL;
-
- Xen_check_type(mus_is_vct(data1), data1, 1, S_correlate, "a " S_vct);
- Xen_check_type(mus_is_vct(data2), data2, 2, S_correlate, "a " S_vct);
-
- v1 = Xen_to_vct(data1);
- v2 = Xen_to_vct(data2);
- if (mus_vct_length(v1) < mus_vct_length(v2))
- size = mus_vct_length(v1);
- else size = mus_vct_length(v2);
-
- if (size > 0)
- mus_correlate(mus_vct_data(v1), mus_vct_data(v2), size);
- return(data1);
- }
-
-
- static Xen g_convolution(Xen url1, Xen url2, Xen un)
- {
- #define H_mus_convolution "(" S_convolution " v1 v2 (len)): convolution \
- of " S_vct "s v1 with v2, using fft of size len (a power of 2), result in v1"
-
- mus_long_t n;
- vct *v1, *v2;
-
- Xen_check_type((mus_is_vct(url1)), url1, 1, S_convolution, "a " S_vct);
- Xen_check_type((mus_is_vct(url2)), url2, 2, S_convolution, "a " S_vct);
-
- v1 = Xen_to_vct(url1);
- v2 = Xen_to_vct(url2);
-
- if (Xen_is_integer(un))
- {
- n = Xen_llong_to_C_llong(un);
- if (n <= 0)
- Xen_out_of_range_error(S_convolution, 3, un, "size <= 0?");
- if (n > mus_max_malloc())
- Xen_out_of_range_error(S_convolution, 3, un, "size too large (see mus-max-malloc)");
- if (n > mus_vct_length(v1))
- n = mus_vct_length(v1);
- }
- else n = mus_vct_length(v1);
- if (n > mus_vct_length(v2))
- n = mus_vct_length(v2);
- if (!(is_power_of_2(n)))
- {
- mus_float_t nf;
- int np;
- nf = (log(n) / log(2.0));
- np = (int)nf;
- n = (int)pow(2.0, np);
- }
- if (n > 0)
- mus_convolution(mus_vct_data(v1), mus_vct_data(v2), n);
- return(url1);
- }
-
-
- static Xen g_polynomial(Xen arr, Xen x)
- {
- #define H_polynomial "(" S_polynomial " coeffs x): evaluate a polynomial at x. coeffs are in order \
- of degree, so coeff[0] is the constant term."
-
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(x), x, 2, S_polynomial, "a number");
- #endif
- if (mus_is_vct(arr))
- {
- vct *v;
- v = Xen_to_vct(arr);
- return(C_double_to_Xen_real(mus_polynomial(mus_vct_data(v), Xen_real_to_C_double_with_caller(x, S_polynomial), mus_vct_length(v))));
- }
-
- Xen_check_type(Xen_is_vector(arr), arr, 1, S_polynomial, "a vector or " S_vct);
- {
- mus_float_t sum, cx;
- int i, ncoeffs;
-
- ncoeffs = Xen_vector_length(arr);
- if (ncoeffs <= 0) return(C_double_to_Xen_real(0.0));
- if (ncoeffs == 1) return(Xen_vector_ref(arr, 0)); /* just a constant term */
-
- cx = Xen_real_to_C_double_with_caller(x, S_polynomial);
- sum = Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, ncoeffs - 1), S_polynomial);
- for (i = ncoeffs - 2; i >= 0; i--)
- sum = (sum * cx) + Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, i), S_polynomial);
- return(C_double_to_Xen_real(sum));
- }
- }
-
-
- static Xen g_array_interp(Xen obj, Xen phase, Xen size) /* opt size */
- {
- #define H_array_interp "(" S_array_interp " v phase (size)): v[phase] \
- taking into account wrap-around (size is size of data), with linear interpolation if phase is not an integer."
-
- mus_long_t len;
- vct *v;
-
- Xen_check_type(mus_is_vct(obj), obj, 1, S_array_interp, "a " S_vct);
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(phase), phase, 2, S_array_interp, "a number");
- #endif
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_array_interp, "an integer");
-
- v = Xen_to_vct(obj);
- if (Xen_is_bound(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len <= 0)
- Xen_out_of_range_error(S_array_interp, 3, size, "size <= 0?");
- if (len > mus_vct_length(v))
- len = mus_vct_length(v);
- }
- else len = mus_vct_length(v);
- if (len == 0)
- return(C_double_to_Xen_real(0.0));
- return(C_double_to_Xen_real(mus_array_interp(mus_vct_data(v), Xen_real_to_C_double_with_caller(phase, S_array_interp), len)));
- }
-
-
- static Xen g_mus_interpolate(Xen type, Xen x, Xen obj, Xen size, Xen yn1)
- {
- #define H_mus_interpolate "(" S_mus_interpolate " type x v (size) (yn1 0.0)): interpolate in \
- data ('v' is a " S_vct ") using interpolation 'type', such as " S_mus_interp_linear "."
-
- mus_long_t len;
- int itype;
- vct *v;
- mus_float_t y = 0.0;
-
- Xen_check_type(Xen_is_integer(type), type, 1, S_mus_interpolate, "an integer (interp type such as " S_mus_interp_all_pass ")");
- Xen_check_type(Xen_is_number(x), x, 2, S_mus_interpolate, "a number");
- Xen_check_type(mus_is_vct(obj), obj, 3, S_mus_interpolate, "a " S_vct);
- Xen_check_type(Xen_is_llong_or_unbound(size), size, 4, S_mus_interpolate, "an integer");
- Xen_check_type(Xen_is_number_or_unbound(yn1), yn1, 5, S_mus_interpolate, "a number");
-
- itype = Xen_integer_to_C_int(type);
- if (!(mus_is_interp_type(itype)))
- Xen_out_of_range_error(S_mus_interpolate, 1, type, "unknown interp type");
-
- v = Xen_to_vct(obj);
-
- if (Xen_is_bound(size))
- {
- len = Xen_llong_to_C_llong(size);
- if (len <= 0)
- Xen_out_of_range_error(S_mus_interpolate, 4, size, "size <= 0?");
- if (len > mus_vct_length(v))
- len = mus_vct_length(v);
- }
- else len = mus_vct_length(v);
- if (len == 0)
- return(C_double_to_Xen_real(0.0));
-
- if (Xen_is_number(yn1))
- y = Xen_real_to_C_double(yn1);
-
- return(C_double_to_Xen_real(mus_interpolate((mus_interp_t)itype, Xen_real_to_C_double(x), mus_vct_data(v), len, y)));
- }
-
-
-
- /* ---------------- mus-xen struct ---------------- */
-
- static Xen_object_type_t mus_xen_tag;
-
- bool mus_is_xen(Xen obj) {return(Xen_c_object_is_type(obj, mus_xen_tag));}
-
- #define Xen_to_C_generator(Xen_Arg, X_Val, C_Val, Checker, Caller, Descr) \
- Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (Checker(C_Val = (mus_any *)mus_xen_to_mus_any(X_Val))), Xen_Arg, 1, Caller, Descr)
-
- #define Xen_to_C_any_generator(Xen_Arg, X_Val, C_Val, Caller, Descr) \
- Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (C_Val = (mus_any *)mus_xen_to_mus_any(X_Val)), Xen_Arg, 1, Caller, Descr)
-
-
-
- static Xen g_is_mus_generator(Xen obj)
- {
- #define H_is_mus_generator "(" S_is_mus_generator " obj): " PROC_TRUE " if 'obj' is a CLM generator."
- return(C_bool_to_Xen_boolean(mus_is_xen(obj)));
- }
-
-
- #if HAVE_SCHEME
- static Xen_object_mark_t mark_mus_xen(void *obj)
- #else
- static Xen_object_mark_t mark_mus_xen(Xen obj)
- #endif
- {
- mus_xen *ms;
- #if HAVE_RUBY || HAVE_SCHEME
- /* rb_gc_mark and scheme_mark_object pass us the actual value, not the Xen wrapper */
- ms = (mus_xen *)obj;
- #endif
- #if HAVE_FORTH
- ms = Xen_to_mus_xen(obj);
- #endif
- if (ms->vcts)
- {
- int i, lim;
- lim = MUS_SELF_WRAPPER;
- if (ms->nvcts < lim) lim = ms->nvcts;
- #if HAVE_SCHEME
- if (ms->free_data) /* set if rf functions are using these two vct slots */
- {
- for (i = 0; i < lim; i++)
- if ((i != MUS_INPUT_FUNCTION) &&
- (i != MUS_INPUT_DATA) &&
- (Xen_is_bound(ms->vcts[i])))
- xen_gc_mark(ms->vcts[i]);
- return;
- }
- #endif
- for (i = 0; i < lim; i++)
- if (Xen_is_bound(ms->vcts[i]))
- xen_gc_mark(ms->vcts[i]);
- }
- #if HAVE_RUBY
- return(NULL);
- #endif
- #if (!HAVE_EXTENSION_LANGUAGE)
- return(0);
- #endif
- }
-
-
- static void mus_xen_free(mus_xen *ms)
- {
- mus_free(ms->gen);
- ms->gen = NULL;
- mx_free(ms);
- }
-
- Xen_wrap_free(mus_xen, free_mus_xen, mus_xen_free)
-
-
- #if HAVE_SCHEME
- static char *print_mus_xen(s7_scheme *sc, void *obj)
- {
- return(mus_describe(((mus_xen *)obj)->gen));
- }
-
- static bool s7_equalp_mus_xen(void *val1, void *val2)
- {
- return(mus_equalp(((mus_xen *)val1)->gen, ((mus_xen *)val2)->gen));
- }
- #endif
-
-
- enum {G_FILTER_STATE, G_FILTER_XCOEFFS, G_FILTER_YCOEFFS};
- /* G_FILTER_STATE must = MUS_DATA_WRAPPER = 0 */
- enum {G_LOCSIG_DATA, G_LOCSIG_REVDATA, G_LOCSIG_OUT, G_LOCSIG_REVOUT};
-
- static Xen mus_xen_copy(mus_xen *ms)
- {
- /* return an object -> copied mus_xen -> copied mus_any gen */
- mus_xen *np;
-
- np = mx_alloc(ms->nvcts);
- np->gen = mus_copy(ms->gen);
- if (ms->nvcts > 0)
- {
- if (ms->nvcts == 1)
- {
- if ((mus_is_env(np->gen)) || /* do the most common case first */
- (mus_is_formant_bank(np->gen)))
- np->vcts[MUS_DATA_WRAPPER] = ms->vcts[MUS_DATA_WRAPPER];
- else
- {
- if ((mus_is_comb_bank(np->gen)) ||
- (mus_is_all_pass_bank(np->gen)) ||
- (mus_is_filtered_comb_bank(np->gen)))
- {
- /* set up objects for new gens so that they will eventually be GC'd */
- Xen v;
- int i, len;
- len = Xen_vector_length(ms->vcts[MUS_DATA_WRAPPER]);
- v = Xen_make_vector(len, Xen_false);
- np->vcts[MUS_DATA_WRAPPER] = v;
- for (i = 0; i < len; i++)
- Xen_vector_set(v, i, mus_xen_to_object(mus_any_to_mus_xen(mus_bank_generator(np->gen, i))));
- }
- else np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- }
- }
- else
- {
- if (ms->nvcts == 2)
- {
- if (mus_is_pulsed_env(np->gen))
- {
- /* mus_free taken care of by copied pulsed_env gen */
- np->vcts[0] = Xen_false;
- np->vcts[1] = Xen_false;
- }
- else
- {
- if (mus_is_filtered_comb(np->gen))
- {
- np->vcts[0] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[1] = Xen_false; /* filt gen but it's not wrapped */
- }
- else
- {
- np->vcts[0] = ms->vcts[0];
- np->vcts[1] = ms->vcts[1];
- }
- }
- }
- else
- {
- if (ms->nvcts == 3)
- {
- if (mus_is_oscil_bank(np->gen))
- {
- np->vcts[0] = ms->vcts[0];
- np->vcts[1] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[2] = ms->vcts[2];
- }
- else
- {
- np->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
- np->vcts[G_FILTER_XCOEFFS] = ms->vcts[G_FILTER_XCOEFFS];
- np->vcts[G_FILTER_YCOEFFS] = ms->vcts[G_FILTER_YCOEFFS];
- }
- }
- else
- {
- int i;
- for (i = 0; i < ms->nvcts; i++)
- np->vcts[i] = ms->vcts[i];
-
- if (mus_is_granulate(np->gen))
- np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(np->gen), mus_data(np->gen));
-
- if ((mus_is_convolve(np->gen)) ||
- (mus_is_src(np->gen)) ||
- (mus_is_granulate(np->gen)) ||
- (mus_is_phase_vocoder(np->gen)))
- {
- Xen c_obj;
- c_obj = mus_xen_to_object(np);
- np->vcts[MUS_SELF_WRAPPER] = c_obj;
- mus_generator_copy_feeders(np->gen, ms->gen);
- return(c_obj);
- }
- }
- }
- }
- }
- return(mus_xen_to_object(np));
- }
-
-
- #if HAVE_RUBY
- static Xen mus_xen_to_s(Xen obj)
- {
- char *str;
- Xen result;
- str = mus_describe(Xen_to_mus_any(obj));
- result = C_string_to_Xen_string(str);
- if (str) free(str);
- return(result);
- }
- #endif
-
-
- #if HAVE_FORTH
- static Xen print_mus_xen(Xen obj)
- {
- char *str;
- Xen result;
- str = mus_describe(Xen_to_mus_any(obj));
- result = fth_make_string_format("#<%s>", str);
- if (str) free(str);
- return(result);
- }
- #endif
-
-
- #if (!HAVE_SCHEME)
- static Xen equalp_mus_xen(Xen obj1, Xen obj2)
- {
- if ((!(mus_is_xen(obj1))) || (!(mus_is_xen(obj2)))) return(Xen_false);
- return(C_bool_to_Xen_boolean(mus_equalp(Xen_to_mus_any(obj1), Xen_to_mus_any(obj2))));
- }
- #endif
-
-
- #if HAVE_RUBY || HAVE_FORTH
- static Xen mus_xen_apply(Xen gen, Xen arg1, Xen arg2)
- {
- #if HAVE_FORTH
- Xen_check_type(mus_is_xen(gen), gen, 1, S_mus_apply, "a generator");
- #endif
- return(C_double_to_Xen_real(mus_run(Xen_to_mus_any(gen),
- (Xen_is_number(arg1)) ? Xen_real_to_C_double(arg1) : 0.0,
- (Xen_is_number(arg2)) ? Xen_real_to_C_double(arg2) : 0.0)));
- }
- #endif
-
- #if HAVE_SCHEME
-
- /* these are for mus_xen_tag, so need not handle float-vectors */
-
- static Xen mus_xen_apply(s7_scheme *sc, Xen gen, Xen args)
- {
- if (s7_is_pair(args))
- {
- mus_float_t arg1, arg2;
- arg1 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
- args = s7_cdr(args);
- if (s7_is_pair(args))
- arg2 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
- else arg2 = 0.0;
- return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), arg1, arg2)));
- }
- return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), 0.0, 0.0)));
- }
-
- static Xen s7_mus_length(s7_scheme *sc, Xen obj)
- {
- return(g_mus_length(obj));
- }
-
- static Xen g_mus_copy(Xen gen);
- static Xen s7_mus_copy(s7_scheme *sc, Xen args)
- {
- return(g_mus_copy(s7_car(args)));
- }
-
- #endif
-
-
- Xen mus_xen_to_object(mus_xen *gn) /* global for user-defined gens */
- {
- return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
- }
-
-
- Xen mus_xen_to_object_with_vct(mus_xen *gn, Xen v) /* global for user-defined gens */
- {
- gn->vcts[MUS_DATA_WRAPPER] = v;
- return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
- }
-
-
- mus_any *mus_optkey_to_mus_any(Xen key, const char *caller, int n, mus_any *def)
- {
- /* from Michael Scholz's sndins.c */
- if (!(Xen_is_keyword(key)))
- {
- Xen_check_type(mus_is_xen(key), key, n, caller, "a clm generator or keyword");
- return(Xen_to_mus_any(key));
- }
- return(def);
- }
-
-
- static Xen mus_optkey_to_input_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
- {
- if (Xen_is_procedure(key))
- {
- if (!(local_arity_ok(key, required_args)))
- Xen_bad_arity_error(caller, n, key, err);
- return(key);
- }
-
- if (mus_is_xen(key))
- {
- if (!(mus_is_input(Xen_to_mus_any(key))))
- Xen_wrong_type_arg_error(caller, n, key, "an input generator");
- return(key);
- }
-
- if ((!(Xen_is_keyword(key))) &&
- (!(Xen_is_false(key))))
- Xen_check_type(false, key, n, caller, "a procedure or input generator");
- return(def);
- }
-
-
-
- /* ---------------- wrappers ---------------- */
-
- mus_xen *mus_any_to_mus_xen(mus_any *ge)
- {
- mus_xen *gn;
- gn = mx_alloc(0);
- gn->gen = ge;
- return(gn);
- }
-
-
- mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, Xen v)
- {
- mus_xen *gn;
- gn = mx_alloc(1);
- gn->gen = ge;
- gn->vcts[MUS_DATA_WRAPPER] = v;
- return(gn);
- }
-
-
- mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, Xen v1, Xen v2)
- {
- mus_xen *gn;
- gn = mx_alloc(2);
- gn->gen = ge;
- gn->vcts[MUS_DATA_WRAPPER] = v1;
- gn->vcts[MUS_INPUT_FUNCTION] = v2;
- return(gn);
- }
-
-
-
- /* ---------------- generic functions ---------------- */
-
-
- static Xen g_mus_reset(Xen gen)
- {
- #define H_mus_reset "(" S_mus_reset " gen): clear out gen, setting it to its default starting state"
- mus_xen *ms;
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_reset(ms->gen);
- return(gen);
- }
- #if HAVE_SCHEME
- if (s7_is_float_vector(gen))
- {
- s7_int len;
- len = s7_vector_length(gen);
- if (len > 0)
- memset((void *)s7_float_vector_elements(gen), 0, len * sizeof(s7_double));
- return(gen);
- }
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-reset"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_reset, "a generator");
- return(gen);
- }
-
- #if HAVE_SCHEME
- static s7_pointer mus_copy_symbol, copy_function;
- #endif
-
- static Xen g_mus_copy(Xen gen)
- {
- #define H_mus_copy "(" S_mus_copy " gen): return a copy of gen"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- return(mus_xen_copy(ms));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, mus_copy_symbol);
- if (func == copy_function)
- return(s7_copy(s7, s7_list(s7, 1, gen)));
- if (func != Xen_undefined)
- return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_copy, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_run(Xen gen, Xen arg1, Xen arg2)
- {
- #define H_mus_run "(" S_mus_run " gen (arg1 0.0) (arg2 0.0)): apply gen to arg1 and arg2"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_float_t a1 = 0.0, a2 = 0.0;
- Xen_real_to_C_double_if_bound(arg1, a1, S_mus_run, 2);
- Xen_real_to_C_double_if_bound(arg2, a2, S_mus_run, 3);
- return(C_double_to_Xen_real(mus_run(ms->gen, a1, a2)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-run"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 3, gen, arg1, arg2)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_run, "a generator");
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_mus_apply(Xen arglist)
- {
- #define H_mus_apply "(" S_mus_apply " gen args...): apply gen to args"
- mus_xen *ms;
- Xen gen;
- int arglist_len;
-
- arglist_len = Xen_list_length(arglist);
- if ((arglist_len > 3) || (arglist_len == 0))
- return(C_double_to_Xen_real(0.0));
-
- gen = Xen_car(arglist);
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_any *g;
- g = ms->gen;
-
- if (arglist_len == 1)
- return(C_double_to_Xen_real(mus_apply(g, 0.0, 0.0)));
-
- if (arglist_len == 2)
- return(C_double_to_Xen_real(mus_apply(g, Xen_real_to_C_double(Xen_cadr(arglist)), 0.0)));
-
- return(C_double_to_Xen_real(mus_apply(g,
- Xen_real_to_C_double_with_caller(Xen_cadr(arglist), "mus-apply"),
- Xen_real_to_C_double_with_caller(Xen_caddr(arglist), "mus-apply"))));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-apply"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, arglist));
- }
- #endif
- Xen_check_type(false, Xen_car(arglist), 1, S_mus_apply, "a generator");
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_mus_describe(Xen gen)
- {
- #define H_mus_describe "(" S_mus_describe " gen): return a string describing the state of CLM generator generator"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- Xen result;
- char *str;
- str = mus_describe(ms->gen);
- result = C_string_to_Xen_string(str);
- if (str) free(str);
- return(result);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-describe"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_describe, "a generator");
- return(gen);
- }
-
-
- #if HAVE_SCHEME
- #define mus_double_generic(Caller, CLM_case, Symbol) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_double_to_Xen_real(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, Symbol); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #define mus_set_double_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
- if (gn) {CLM_case(gn->gen, Xen_real_to_C_double(val)); return(val);} \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
- Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- return(val);
-
- #define mus_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_llong_to_Xen_llong(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #define mus_set_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- Xen_check_type(Xen_is_integer(val), val, 2, Caller, "an integer"); \
- if (gn) {CLM_case(gn->gen, Xen_llong_to_C_llong(val)); return(val);} \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(val);
-
- #define mus_int_generic(Caller, CLM_case) \
- mus_xen *gn; \
- s7_pointer func; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (gn) return(C_int_to_Xen_integer(CLM_case(gn->gen))); \
- func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
- Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(gen);
-
- #else
-
- #define mus_double_generic(Caller, CLM_case, Symbol) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_double_to_Xen_real(CLM_case(gn->gen)));
-
- #define mus_set_double_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
- CLM_case(gn->gen, Xen_real_to_C_double(val)); \
- return(val);
-
- #define mus_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_llong_to_Xen_llong(CLM_case(gn->gen)));
-
- #define mus_set_long_long_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
- Xen_check_type(Xen_is_integer(val), val, 2, S_set Caller, "an integer"); \
- CLM_case(gn->gen, Xen_llong_to_C_llong(val)); \
- return(val);
-
- #define mus_int_generic(Caller, CLM_case) \
- mus_xen *gn; \
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
- if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
- return(C_int_to_Xen_integer(CLM_case(gn->gen)));
-
- #endif
-
- #if HAVE_SCHEME
- static Xen sym_frequency, sym_phase, sym_scaler, sym_increment, sym_width, sym_offset, sym_feedforward, sym_feedback;
- #endif
-
- static Xen g_mus_frequency(Xen gen)
- {
- #define H_mus_frequency "(" S_mus_frequency " gen): gen's frequency (Hz)"
- mus_double_generic(S_mus_frequency, mus_frequency, sym_frequency);
- }
-
- static Xen g_mus_set_frequency(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_frequency, mus_set_frequency);
- }
-
-
- static Xen g_mus_phase(Xen gen)
- {
- #define H_mus_phase "(" S_mus_phase " gen): gen's current phase (radians)"
- mus_double_generic(S_mus_phase, mus_phase, sym_phase);
- }
-
- static Xen g_mus_set_phase(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_phase, mus_set_phase);
- }
-
-
- static Xen g_mus_scaler(Xen gen)
- {
- #define H_mus_scaler "(" S_mus_scaler " gen): gen's scaler, if any. This is often an amplitude adjustment of some sort."
- mus_double_generic(S_mus_scaler, mus_scaler, sym_scaler);
- }
-
- static Xen g_mus_set_scaler(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_scaler, mus_set_scaler);
- }
-
-
- static Xen g_mus_feedforward(Xen gen)
- {
- #define H_mus_feedforward "(" S_mus_feedforward " gen): gen's feedforward field"
- mus_double_generic(S_mus_feedforward, mus_scaler, sym_feedforward);
- }
-
- static Xen g_mus_set_feedforward(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_feedforward, mus_set_scaler);
- }
-
-
- static Xen g_mus_feedback(Xen gen)
- {
- #define H_mus_feedback "(" S_mus_feedback " gen): gen's " S_mus_feedback " field"
- mus_double_generic(S_mus_feedback, mus_increment, sym_feedback);
- }
-
- static Xen g_mus_set_feedback(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_feedback, mus_set_increment);
- }
-
-
- static Xen g_mus_width(Xen gen)
- {
- #define H_mus_width "(" S_mus_width " gen): gen's width, if any. This is usually a table size."
- mus_double_generic(S_mus_width, mus_width, sym_width);
- }
-
- static Xen g_mus_set_width(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_width, mus_set_width);
- }
-
-
- static Xen g_mus_offset(Xen gen)
- {
- #define H_mus_offset "(" S_mus_offset " gen): gen's offset, if any"
- mus_double_generic(S_mus_offset, mus_offset, sym_offset);
- }
-
- static Xen g_mus_set_offset(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_offset, mus_set_offset);
- }
-
-
- static Xen g_mus_increment(Xen gen)
- {
- #define H_mus_increment "(" S_mus_increment " gen): gen's " S_mus_increment " field, if any"
- mus_double_generic(S_mus_increment, mus_increment, sym_increment);
- }
-
- static Xen g_mus_set_increment(Xen gen, Xen val)
- {
- mus_set_double_generic(S_mus_increment, mus_set_increment);
- }
-
-
- static Xen g_mus_hop(Xen gen)
- {
- #define H_mus_hop "(" S_mus_hop " gen): gen's " S_mus_hop " field"
- mus_long_long_generic(S_mus_hop, mus_hop);
- }
-
- static Xen g_mus_set_hop(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_hop, mus_set_hop);
- }
-
-
- static Xen g_mus_ramp(Xen gen)
- {
- #define H_mus_ramp "(" S_mus_ramp " gen): granulate generator's " S_mus_ramp " field"
- mus_long_long_generic(S_mus_ramp, mus_ramp);
- }
-
- static Xen g_mus_set_ramp(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_ramp, mus_set_ramp);
- }
-
-
- static Xen g_mus_location(Xen gen)
- {
- #define H_mus_location "(" S_mus_location " gen): gen's " S_mus_location " field, if any"
- mus_long_long_generic(S_mus_location, mus_location);
- }
-
- static Xen g_mus_set_location(Xen gen, Xen val)
- {
- mus_set_long_long_generic(S_mus_location, mus_set_location);
- }
-
-
- static Xen g_mus_order(Xen gen)
- {
- #define H_mus_order "(" S_mus_order " gen): gen's order, if any"
- mus_long_long_generic(S_mus_order, mus_length);
- }
-
-
- static Xen g_mus_channel(Xen gen)
- {
- #define H_mus_channel "(" S_mus_channel " gen): gen's " S_mus_channel " field, if any"
- mus_int_generic(S_mus_channel, mus_channel);
- }
-
-
- static Xen g_mus_interp_type(Xen gen)
- {
- #define H_mus_interp_type "(" S_mus_interp_type " gen): gen's " S_mus_interp_type " field, if any"
- mus_int_generic(S_mus_interp_type, mus_channels);
- }
-
-
- static Xen g_mus_type(Xen gen)
- {
- #define H_mus_type "(" S_mus_type " gen): gen's type"
- mus_int_generic(S_mus_type, mus_type);
- }
-
-
- static Xen g_mus_name(Xen gen)
- {
- #define H_mus_name "(" S_mus_name " gen): gen's (type) name, if any"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- return(C_string_to_Xen_string(mus_name(mus_xen_to_mus_any(ms))));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-name"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_name, "a generator");
- return(gen);
- }
-
-
- Xen g_mus_file_name(Xen gen)
- {
- #define H_mus_file_name "(" S_mus_file_name " gen): file associated with gen, if any"
- mus_xen *gn;
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_string_to_Xen_string(mus_file_name(gn->gen)));
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_file_name));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_file_name, "a generator");
- return(gen);
- }
-
-
- Xen g_mus_data(Xen gen)
- {
- #define H_mus_data "(" S_mus_data " gen): gen's internal data (a " S_vct "), if any"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- if (ms->vcts)
- return(ms->vcts[MUS_DATA_WRAPPER]);
- else return(Xen_false);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_data));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_data, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_set_data(Xen gen, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- Xen_check_type((mus_is_vct(val)), val, 2, S_set S_mus_data, "a " S_vct);
- if (ms->vcts)
- {
- vct *v;
- mus_any *ma;
- v = Xen_to_vct(val);
- ma = ms->gen;
- mus_set_data(ma, mus_vct_data(v)); /* TO REMEMBER: if allocated, should have freed, and set to not allocated */
- ms->vcts[MUS_DATA_WRAPPER] = val;
- return(val);
- }
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-data"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_set S_mus_data, "a generator with a data field");
- return(Xen_false);
- }
-
-
- static Xen c_xcoeffs(mus_xen *ms)
- {
- mus_any *g;
- g = ms->gen;
- if (ms->vcts)
- {
- if (mus_is_polywave(g))
- return(ms->vcts[0]);
- if (ms->nvcts > G_FILTER_XCOEFFS)
- return(ms->vcts[G_FILTER_XCOEFFS]);
- }
- if ((mus_is_one_zero(g)) ||
- (mus_is_one_pole(g)) ||
- (mus_is_two_zero(g)) ||
- (mus_is_two_pole(g)))
- return(xen_make_vct_wrapper(3, mus_xcoeffs(g)));
- return(Xen_false);
- }
-
- static Xen g_mus_xcoeffs(Xen gen)
- {
- #define H_mus_xcoeffs "(" S_mus_xcoeffs " gen): gen's filter xcoeffs (" S_vct " of coefficients on inputs)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms) return(c_xcoeffs(ms));
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeffs"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_xcoeffs, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_ycoeffs(Xen gen)
- {
- #define H_mus_ycoeffs "(" S_mus_ycoeffs " gen): gen's filter ycoeffs (" S_vct " of coefficients on outputs)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_any *g;
- g = ms->gen;
- if (ms->vcts)
- {
- if ((mus_is_polywave(Xen_to_mus_any(gen))) && (ms->nvcts == 2))
- return(ms->vcts[1]);
- if (ms->nvcts > G_FILTER_YCOEFFS)
- return(ms->vcts[G_FILTER_YCOEFFS]);
- }
- if ((mus_is_one_zero(g)) ||
- (mus_is_one_pole(g)) ||
- (mus_is_two_zero(g)) ||
- (mus_is_two_pole(g)))
- return(xen_make_vct_wrapper(3, mus_ycoeffs(g)));
- return(Xen_false);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeffs"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_ycoeffs, "a generator");
- return(gen);
- }
-
-
- static Xen g_mus_xcoeff(Xen gen, Xen index)
- {
- #define H_mus_xcoeff "(" S_mus_xcoeff " gen index): gen's filter xcoeff value at index (0-based)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- Xen_to_C_integer_or_error(index, ind, S_mus_xcoeff, 2);
- if (ind < 0)
- Xen_out_of_range_error(S_mus_xcoeff, 2, index, "index must be non-negative");
- return(C_double_to_Xen_real(mus_xcoeff(mus_xen_to_mus_any(ms), ind)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_xcoeff, "a generator");
- return(index);
- }
-
-
- static Xen g_mus_set_xcoeff(Xen gen, Xen index, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- mus_float_t x;
- Xen_to_C_integer_or_error(index, ind, S_set S_mus_xcoeff, 2);
- Xen_to_C_double_or_error(val, x, S_set S_mus_xcoeff, 3);
- if (ind < 0)
- Xen_out_of_range_error(S_set S_mus_xcoeff, 2, index, "index must be non-negative");
- mus_set_xcoeff(mus_xen_to_mus_any(ms), ind, x);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_xcoeff, "a generator");
- return(val);
- }
-
-
- static Xen g_mus_ycoeff(Xen gen, Xen index)
- {
- #define H_mus_ycoeff "(" S_mus_ycoeff " gen index): gen's filter ycoeff value at index (0-based)"
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- Xen_to_C_integer_or_error(index, ind, S_mus_ycoeff, 2);
- if (ind < 0)
- Xen_out_of_range_error(S_mus_ycoeff, 2, index, "index must be non-negative");
- return(C_double_to_Xen_real(mus_ycoeff(mus_xen_to_mus_any(ms), ind)));
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_mus_ycoeff, "a generator");
- return(index);
- }
-
-
- static Xen g_mus_set_ycoeff(Xen gen, Xen index, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- int ind = 0;
- mus_float_t x;
- Xen_to_C_integer_or_error(index, ind, S_set S_mus_ycoeff, 2);
- Xen_to_C_double_or_error(val, x, S_set S_mus_ycoeff, 3);
- if (ind < 0)
- Xen_out_of_range_error(S_set S_mus_ycoeff, 2, index, "index must be non-negative");
- mus_set_ycoeff(mus_xen_to_mus_any(ms), ind, x);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_ycoeff, "a generator");
- return(val);
- }
-
-
- Xen g_mus_channels(Xen gen)
- {
- #define H_mus_channels "(" S_mus_channels " gen): gen's " S_mus_channels " field, if any"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_int_to_Xen_integer(mus_channels(gn->gen)));
-
- #if HAVE_SCHEME
- if (mus_is_vct(gen))
- {
- if (Xen_vector_rank(gen) > 1)
- return(C_int_to_Xen_integer(s7_vector_dimensions(gen)[0]));
- else return(C_int_to_Xen_integer(1));
- }
- #else
- if (mus_is_vct(gen))
- return(C_int_to_Xen_integer(1));
- #endif
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-channels"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_mus_channels, "an output generator, " S_vct ", or sound-data object");
- return(Xen_false); /* make compiler happy */
- }
-
-
- Xen g_mus_length(Xen gen)
- {
- #define H_mus_length "(" S_mus_length " gen): gen's length, if any"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (gn)
- return(C_llong_to_Xen_llong(mus_length(gn->gen)));
-
- if (mus_is_vct(gen))
- return(C_int_to_Xen_integer(mus_vct_length(Xen_to_vct(gen))));
-
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
- if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
- }
- #endif
-
- Xen_check_type(false, gen, 1, S_mus_length, "a generator, " S_vct ", or sound-data object");
- return(Xen_false); /* make compiler happy */
- }
-
-
- static Xen g_mus_set_length(Xen gen, Xen val)
- {
- mus_xen *ms;
-
- ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
- if (ms)
- {
- mus_long_t len = 0;
- mus_any *ptr = NULL;
-
- Xen_to_C_integer_or_error(val, len, S_set S_mus_length, 2);
- if (len <= 0)
- Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be > 0");
-
- ptr = ms->gen;
- if ((!mus_is_env(ptr)) && (!mus_is_src(ptr))) /* set length doesn't refer to data vct here */
- {
- if ((ms->vcts) && (!(Xen_is_eq(ms->vcts[MUS_DATA_WRAPPER], Xen_undefined))))
- {
- vct *v;
- v = Xen_to_vct(ms->vcts[MUS_DATA_WRAPPER]);
- if ((v) && (len > mus_vct_length(v)))
- Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be <= current data size");
- /* set_offset refers only to env, set_width only to square_wave et al, set_location only readin */
- /* filters are protected by keeping allocated_size and not allowing arrays to be set */
- }
- }
- mus_set_length(ptr, len);
- return(val);
- }
- #if HAVE_SCHEME
- {
- s7_pointer func;
- func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
- if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
- return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
- }
- #endif
- Xen_check_type(false, gen, 1, S_set S_mus_length, "a generator");
- return(val);
- }
-
-
-
-
-
- /* ---------------- oscil ---------------- */
-
- static Xen g_make_oscil(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_oscil "(" S_make_oscil " (frequency *clm-default-frequency*) (initial-phase 0.0)): return a new " S_oscil " (sinewave) generator"
- mus_any *ge;
- mus_float_t freq, phase = 0.0;
-
- freq = clm_default_frequency;
- if (Xen_is_bound(arg1))
- {
- if (!Xen_is_bound(arg2))
- {
- Xen_check_type(Xen_is_number(arg1), arg1, 1, S_make_oscil, "a number");
- freq = Xen_real_to_C_double(arg1);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_oscil, 1, arg1, "freq > srate/2?");
- }
- else
- {
- int vals;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
-
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(S_make_oscil, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_oscil, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_oscil, orig_arg[0], keys[0], "freq > srate/2?");
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_oscil, orig_arg[1], phase);
- }
- }
- }
-
- ge = mus_make_oscil(freq, phase);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_oscil(Xen osc, Xen fm, Xen pm)
- {
- #define H_oscil "(" S_oscil " gen (fm 0.0) (pm 0.0)): next sample from " S_oscil " gen: val = sin(phase + pm); phase += (freq + fm)"
- #define Q_oscil s7_make_circular_signature(s7, 2, 3, s7_make_symbol(s7, "float?"), s7_make_symbol(s7, S_is_oscil), s7_make_symbol(s7, "real?"))
-
- mus_float_t fm1;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(osc, gn, g, mus_is_oscil, S_oscil, "an oscil");
- if (!Xen_is_bound(fm))
- return(C_double_to_Xen_real(mus_oscil_unmodulated(g)));
- if (!Xen_is_bound(pm))
- return(C_double_to_Xen_real(mus_oscil_fm(g, Xen_real_to_C_double(fm))));
- fm1 = Xen_real_to_C_double(fm);
- if (fm1 == 0.0)
- return(C_double_to_Xen_real(mus_oscil_pm(g, Xen_real_to_C_double(pm))));
- return(C_double_to_Xen_real(mus_oscil(g, fm1, Xen_real_to_C_double(pm))));
- }
-
-
- static Xen g_is_oscil(Xen os)
- {
- #define H_is_oscil "(" S_is_oscil " gen): " PROC_TRUE " if gen is an " S_oscil
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_make_oscil_bank(Xen freqs, Xen phases, Xen amps, XEN stable)
- {
- #define H_make_oscil_bank "(" S_make_oscil_bank " freqs phases amps stable): return a new oscil-bank generator. (freqs in radians)"
-
- mus_any *ge = NULL;
- vct *f, *p, *a = NULL;
- mus_xen *gn;
-
- Xen_check_type(mus_is_vct(freqs), freqs, 1, S_make_oscil_bank, "a " S_vct);
- Xen_check_type(mus_is_vct(phases), phases, 2, S_make_oscil_bank, "a " S_vct);
- Xen_check_type(Xen_is_boolean_or_unbound(stable), stable, 3, S_make_oscil_bank, "a boolean");
-
- f = Xen_to_vct(freqs);
- p = Xen_to_vct(phases);
- if (mus_is_vct(amps)) a = Xen_to_vct(amps);
-
- ge = mus_make_oscil_bank(mus_vct_length(f), mus_vct_data(f), mus_vct_data(p), (a) ? mus_vct_data(a) : NULL, Xen_is_true(stable));
- /* Xen_is_true looks specifically for #t */
-
- gn = mx_alloc(3);
- gn->gen = ge;
- gn->vcts[0] = freqs;
- gn->vcts[1] = phases;
- gn->vcts[2] = amps;
-
- return(mus_xen_to_object(gn));
- }
-
-
- static Xen g_is_oscil_bank(Xen os)
- {
- #define H_is_oscil_bank "(" S_is_oscil_bank " gen): " PROC_TRUE " if gen is an " S_oscil_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_oscil_bank(Xen g)
- {
- #define H_oscil_bank "(" S_oscil_bank " bank): sum an array of oscils"
- mus_any *ob = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(g, gn, ob, mus_is_oscil_bank, S_oscil_bank, "an oscil-bank generator");
- return(C_double_to_Xen_real(mus_oscil_bank(ob)));
- }
-
-
-
-
- /* ---------------- delay ---------------- */
-
-
- typedef enum {G_DELAY, G_COMB, G_NOTCH, G_ALL_PASS, G_FCOMB} xclm_delay_t;
-
- static Xen g_make_delay_1(xclm_delay_t choice, Xen arglist)
- {
- mus_any *ge = NULL, *filt = NULL;
- const char *caller = NULL;
- Xen args[18];
- Xen keys[9];
- Xen xen_filt = Xen_false;
- int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, (int)MUS_INTERP_NONE, 0};
- int vals, i, argn = 0;
- mus_long_t max_size = -1, size = -1;
- int interp_type = (int)MUS_INTERP_NONE;
- mus_float_t *line = NULL;
- mus_float_t scaler = 0.0, feedback = 0.0, feedforward = 0.0;
- vct *initial_contents = NULL;
- Xen orig_v = Xen_false; /* initial-contents can be a vct */
- mus_float_t initial_element = 0.0;
- int scaler_key = -1, feedback_key = -1, feedforward_key = -1, size_key = -1, initial_contents_key = -1;
- int initial_element_key = -1, max_size_key = -1, interp_type_key = -1, filter_key = -1;
-
- switch (choice)
- {
- case G_DELAY: caller = S_make_delay; break;
- case G_COMB: caller = S_make_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_FCOMB: caller = S_make_filtered_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_NOTCH: caller = S_make_notch; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_ALL_PASS:
- caller = S_make_all_pass;
- feedback_key = argn;
- keys[argn++] = kw_feedback;
- feedforward_key = argn;
- keys[argn++] = kw_feedforward;
- break;
- }
-
- size_key = argn; keys[argn++] = kw_size;
- initial_contents_key = argn; keys[argn++] = kw_initial_contents;
- initial_element_key = argn; keys[argn++] = kw_initial_element;
- max_size_key = argn; keys[argn++] = kw_max_size;
- interp_type_key = argn; keys[argn++] = kw_type;
- filter_key = argn; keys[argn++] = kw_filter;
-
- {
- Xen p;
- int a2, arglist_len;
- a2 = argn * 2;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > a2) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < a2; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
-
- if (vals > 0)
- {
- bool size_set = false, max_size_set = false;
- /* try to catch obvious type/range errors before allocations
- * a major complication here is that size can be 0
- */
-
- if (!(Xen_is_keyword(keys[size_key])))
- {
- size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
- if (size < 0)
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
- size_set = true;
- }
-
- if (!(Xen_is_keyword(keys[max_size_key])))
- {
- max_size = Xen_optkey_to_mus_long_t(kw_max_size, keys[max_size_key], caller, orig_arg[max_size_key], max_size); /* -1 = unset */
- if (max_size <= 0)
- Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size <= 0?");
- if (max_size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size too large (see mus-max-table-size)");
- max_size_set = true;
- }
-
- if (Xen_is_keyword(keys[interp_type_key]))
- {
- /* if type not given, if max_size, assume linear interp (for possible tap), else no interp */
- if ((max_size_set) && (max_size != size))
- interp_type = (int)MUS_INTERP_LINEAR;
- else interp_type = (int)MUS_INTERP_NONE;
- }
- else
- {
- interp_type = Xen_optkey_to_int(kw_type, keys[interp_type_key], caller, orig_arg[interp_type_key], (int)MUS_INTERP_LINEAR);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(caller, orig_arg[interp_type_key], keys[interp_type_key], "no such interp-type");
- }
-
- initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
-
- switch (choice)
- {
- case G_DELAY:
- break;
-
- case G_COMB: case G_NOTCH: case G_FCOMB:
- scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
- break;
-
- case G_ALL_PASS:
- feedback = Xen_optkey_to_float(kw_feedback, keys[feedback_key], caller, orig_arg[feedback_key], feedback);
- feedforward = Xen_optkey_to_float(kw_feedforward, keys[feedforward_key], caller, orig_arg[feedforward_key], feedforward);
- break;
- }
-
- if (!(Xen_is_keyword(keys[filter_key])))
- {
- if (choice != G_FCOMB)
- clm_error(caller, "filter arg passed??", keys[filter_key]);
-
- Xen_check_type(mus_is_xen(keys[filter_key]), keys[filter_key], orig_arg[filter_key], caller, "filter arg must be a generator");
- xen_filt = keys[filter_key];
- filt = Xen_to_mus_any(xen_filt);
- }
-
- if (!(Xen_is_keyword(keys[initial_contents_key])))
- {
- if (!(Xen_is_keyword(keys[initial_element_key])))
- Xen_out_of_range_error(caller,
- orig_arg[initial_contents_key],
- keys[initial_contents_key],
- "initial-contents and initial-element in same call?");
- if (mus_is_vct(keys[initial_contents_key]))
- {
- initial_contents = Xen_to_vct(keys[initial_contents_key]);
- orig_v = keys[initial_contents_key];
- }
- else
- {
- if (Xen_is_list(keys[initial_contents_key]))
- {
- int len;
- len = Xen_list_length(keys[initial_contents_key]);
- if (len <= 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
- C_string_to_Xen_string(caller)));
-
- orig_v = xen_list_to_vct(keys[initial_contents_key]);
- initial_contents = Xen_to_vct(orig_v);
- /* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
- }
- else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
- keys[initial_contents_key],
- orig_arg[initial_contents_key],
- caller, "a " S_vct " or a list");
- }
- if (initial_contents)
- {
- if (size_set)
- {
- if (size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
- }
- else size = mus_vct_length(initial_contents);
- if (max_size_set)
- {
- if (max_size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "max-size > initial-contents length");
- }
- else max_size = mus_vct_length(initial_contents);
- }
- }
- }
- /* here size can be (user-set to) 0, but max_size needs to be a reasonable allocation size */
- if (size < 0) size = 1;
- if (max_size < size)
- {
- if (size == 0)
- max_size = 1;
- else max_size = size;
- }
-
- if (initial_contents == NULL)
- {
- line = (mus_float_t *)malloc(max_size * sizeof(mus_float_t));
- if (line == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
- orig_v = xen_make_vct(max_size, line);
- if (initial_element != 0.0)
- {
- for (i = 0; i < max_size; i++)
- line[i] = initial_element;
- }
- else memset((void *)line, 0, max_size * sizeof(mus_float_t));
- }
- else
- {
- line = mus_vct_data(initial_contents);
- }
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- switch (choice)
- {
- case G_DELAY: ge = mus_make_delay(size, line, max_size, (mus_interp_t)interp_type); break;
- case G_COMB: ge = mus_make_comb(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_NOTCH: ge = mus_make_notch(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_ALL_PASS: ge = mus_make_all_pass(feedback, feedforward, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_FCOMB: ge = mus_make_filtered_comb(scaler, size, line, max_size, (mus_interp_t)interp_type, filt); break;
- }
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- if (choice != G_FCOMB)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_v, xen_filt)));
- }
- return(clm_mus_error(local_error_type, local_error_msg, caller));
- }
-
-
- static Xen g_make_delay(Xen args)
- {
- #define H_make_delay "(" S_make_delay " (size) (initial-contents) (initial-element 0.0) (max-size) (type mus-interp-linear)): \
- return a new delay line of size elements. \
- If the delay length will be changing at run-time, max-size sets its maximum length, so\n\
- (" S_make_delay " len :max-size (+ len 10))\n\
- provides 10 extra elements of delay for subsequent phasing or flanging. \
- initial-contents can be either a list or a " S_vct "."
-
- if ((Xen_is_pair(args)) && (!Xen_is_pair(Xen_cdr(args))))
- {
- Xen val, v;
- mus_any *ge;
- mus_long_t size, max_size;
- mus_float_t *line;
- mus_error_handler_t *old_error_handler;
-
- val = Xen_car(args);
- Xen_check_type(Xen_is_integer(val), val, 1, S_make_delay, "an integer");
- size = Xen_integer_to_C_int(val);
- if (size < 0)
- Xen_out_of_range_error(S_make_delay, 1, val, "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(S_make_delay, 1, val, "size too large (see mus-max-table-size)");
- if (size == 0) max_size = 1; else max_size = size;
-
- line = (mus_float_t *)calloc(max_size, sizeof(mus_float_t));
- v = xen_make_vct(max_size, line); /* we need this for mus-data */
-
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_delay(size, line, max_size, MUS_INTERP_NONE);
- mus_error_set_handler(old_error_handler);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, v)));
- return(clm_mus_error(local_error_type, local_error_msg, S_make_delay));
- }
-
- return(g_make_delay_1(G_DELAY, args));
- }
-
-
- static Xen g_make_comb(Xen args)
- {
- #define H_make_comb "(" S_make_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new comb filter (a delay line with a scaler on the feedback) of size elements. \
- If the comb length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_COMB, args));
- }
-
-
- static Xen g_make_filtered_comb(Xen args)
- {
- #define H_make_filtered_comb "(" S_make_filtered_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ") :filter): \
- return a new filtered comb filter (a delay line with a scaler and a filter on the feedback) of size elements. \
- If the comb length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_FCOMB, args));
- }
-
-
- static Xen g_make_notch(Xen args)
- {
- #define H_make_notch "(" S_make_notch " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new notch filter (a delay line with a scaler on the feedforward) of size elements. \
- If the notch length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_NOTCH, args));
- }
-
-
- static Xen g_make_all_pass(Xen args)
- {
- #define H_make_all_pass "(" S_make_all_pass " (feedback) (feedforward) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
- return a new allpass filter (a delay line with a scalers on both the feedback and the feedforward). \
- If the " S_all_pass " length will be changing at run-time, max-size sets its maximum length. \
- initial-contents can be either a list or a " S_vct "."
-
- return(g_make_delay_1(G_ALL_PASS, args));
- }
-
-
- typedef enum {G_MOVING_AVERAGE, G_MOVING_MAX, G_MOVING_NORM} xclm_moving_t;
-
- static Xen g_make_moving_any(xclm_moving_t choice, const char *caller, Xen arglist)
- {
- mus_any *ge = NULL;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals, i, argn = 0, arglist_len;
- mus_long_t size = -1;
- mus_float_t scaler = 1.0, sum = 0.0;
- vct *initial_contents = NULL;
- Xen orig_v = Xen_false, p;
- mus_float_t initial_element = 0.0;
- mus_float_t *line = NULL;
- int scaler_key = -1, size_key, initial_contents_key, initial_element_key;
- mus_error_handler_t *old_error_handler;
-
- size_key = argn;
- keys[argn++] = kw_size;
- if (choice == G_MOVING_NORM)
- {
- scaler_key = argn;
- keys[argn++] = kw_scaler;
- }
- initial_contents_key = argn;
- keys[argn++] = kw_initial_contents;
- initial_element_key = argn;
- keys[argn++] = kw_initial_element;
-
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < argn * 2; i++) args[i] = Xen_undefined;
- vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
-
- if (vals > 0)
- {
- bool size_set = false;
- if (!(Xen_is_keyword(keys[size_key])))
- {
- size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
- if (size < 0)
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
- if (size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
- size_set = true;
- }
-
- if (choice == G_MOVING_NORM)
- scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
-
- initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
- if (!(Xen_is_keyword(keys[initial_contents_key])))
- {
- if (!(Xen_is_keyword(keys[initial_element_key])))
- Xen_out_of_range_error(caller,
- orig_arg[initial_contents_key],
- keys[initial_contents_key],
- "initial-contents and initial-element in same call?");
- if (mus_is_vct(keys[initial_contents_key]))
- {
- initial_contents = Xen_to_vct(keys[initial_contents_key]);
- orig_v = keys[initial_contents_key];
- }
- else
- {
- if (Xen_is_list(keys[initial_contents_key]))
- {
- int len;
- len = Xen_list_length(keys[initial_contents_key]);
- if (len <= 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
- C_string_to_Xen_string(caller)));
-
- orig_v = xen_list_to_vct(keys[initial_contents_key]);
- initial_contents = Xen_to_vct(orig_v);
- /* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
- }
- else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
- keys[initial_contents_key],
- orig_arg[initial_contents_key],
- caller, "a " S_vct " or a list");
- }
- if (initial_contents)
- {
- if (size_set)
- {
- if (size > mus_vct_length(initial_contents))
- Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
- }
- else size = mus_vct_length(initial_contents);
- }
- }
- }
-
- if (size < 0) size = 1;
- if (size == 0)
- Xen_out_of_range_error(caller, 0, C_llong_to_Xen_llong(size), "size = 0?");
-
- if (initial_contents == NULL)
- {
- line = (mus_float_t *)malloc(size * sizeof(mus_float_t));
- if (line == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
- orig_v = xen_make_vct(size, line);
- if (initial_element != 0.0)
- {
- for (i = 0; i < size; i++)
- line[i] = initial_element;
- sum = initial_element * size;
- }
- else memset((void *)line, 0, size * sizeof(mus_float_t));
- }
- else
- {
- line = mus_vct_data(initial_contents);
- if ((line) && (choice == G_MOVING_AVERAGE))
- {
- sum = line[0];
- for (i = 1; i < size; i++)
- sum += line[i];
- }
- }
-
- old_error_handler = mus_error_set_handler(local_mus_error);
- switch (choice)
- {
- case G_MOVING_AVERAGE: ge = mus_make_moving_average_with_initial_sum(size, line, sum); break;
- case G_MOVING_MAX: ge = mus_make_moving_max(size, line); break;
- case G_MOVING_NORM: ge = mus_make_moving_norm(size, line, scaler); break;
- }
- mus_error_set_handler(old_error_handler);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(clm_mus_error(local_error_type, local_error_msg, caller));
- }
-
-
- static Xen g_make_moving_average(Xen args)
- {
- #define H_make_moving_average "(" S_make_moving_average " (size) (initial-contents) (initial-element 0.0)): \
- return a new moving_average generator. initial-contents can be either a list or a " S_vct "."
-
- return(g_make_moving_any(G_MOVING_AVERAGE, S_make_moving_average, args));
- }
-
-
- static Xen g_make_moving_max(Xen args)
- {
- #define H_make_moving_max "(" S_make_moving_max " (size) (initial-contents) (initial-element 0.0)): \
- return a new moving-max generator. initial-contents can be either a list or a " S_vct "."
-
- return(g_make_moving_any(G_MOVING_MAX, S_make_moving_max, args));
- }
-
-
- static Xen g_make_moving_norm(Xen args)
- {
- #define H_make_moving_norm "(" S_make_moving_norm " (size (scaler 1.0))): return a new moving-norm generator."
-
- return(g_make_moving_any(G_MOVING_NORM, S_make_moving_norm, args));
- }
-
-
- static Xen g_delay(Xen obj, Xen input, Xen pm)
- {
- #define H_delay "(" S_delay " gen (val 0.0) (pm 0.0)): \
- delay val according to the delay line's length and pm ('phase-modulation'). \
- If pm is greater than 0.0, the max-size argument used to create gen should have accommodated its maximum value."
-
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay, "a delay line");
- if (!Xen_is_bound(input))
- return(C_double_to_Xen_real(mus_delay_unmodulated(g, 0.0)));
- if (!Xen_is_bound(pm))
- return(C_double_to_Xen_real(mus_delay_unmodulated(g, Xen_real_to_C_double(input))));
- return(C_double_to_Xen_real(mus_delay(g, Xen_real_to_C_double(input), Xen_real_to_C_double(pm))));
- }
-
-
- static Xen g_delay_tick(Xen obj, Xen input)
- {
- #define H_delay_tick "(" S_delay_tick " gen (val 0.0)): \
- delay val according to the delay line's length. This merely 'ticks' the delay line forward.\
- The argument 'val' is returned."
-
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay_tick, "a delay line");
- Xen_real_to_C_double_if_bound(input, in1, S_delay_tick, 2);
-
- return(C_double_to_Xen_real(mus_delay_tick(g, in1)));
- }
-
-
- static Xen g_notch(Xen obj, Xen input, Xen pm)
- {
- #define H_notch "(" S_notch " gen (val 0.0) (pm 0.0)): notch filter val, pm changes the delay length."
-
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_notch, S_notch, "a notch filter");
- Xen_real_to_C_double_if_bound(input, in1, S_notch, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_notch, 3);
-
- return(C_double_to_Xen_real(mus_notch(g, in1, pm1)));
- }
-
-
- static Xen g_comb(Xen obj, Xen input, Xen pm)
- {
- #define H_comb "(" S_comb " gen (val 0.0) (pm 0.0)): comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_comb, S_comb, "a comb generator");
- Xen_real_to_C_double_if_bound(input, in1, S_comb, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_comb, 3);
-
- return(C_double_to_Xen_real(mus_comb(g, in1, pm1)));
- }
-
-
- static Xen g_make_comb_bank(Xen arg)
- {
- #define H_make_comb_bank "(" S_make_comb_bank " gens): return a new comb-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_comb_bank, "a vector of comb generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_comb(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_comb_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_comb_bank(Xen os)
- {
- #define H_is_comb_bank "(" S_is_comb_bank " gen): " PROC_TRUE " if gen is a " S_comb_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_comb_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_comb_bank(Xen gens, Xen inp)
- {
- #define H_comb_bank "(" S_comb_bank " bank inval): sum an array of " S_comb " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_comb_bank, S_comb_bank, "a comb-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_comb_bank, 2);
-
- return(C_double_to_Xen_real(mus_comb_bank(bank, x)));
- }
-
-
-
- static Xen g_filtered_comb(Xen obj, Xen input, Xen pm)
- {
- #define H_filtered_comb "(" S_filtered_comb " gen (val 0.0) (pm 0.0)): filtered comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_filtered_comb, S_filtered_comb, "a filtered-comb generator");
- Xen_real_to_C_double_if_bound(input, in1, S_filtered_comb, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_filtered_comb, 3);
-
- return(C_double_to_Xen_real(mus_filtered_comb(g, in1, pm1)));
- }
-
-
- static Xen g_make_filtered_comb_bank(Xen arg)
- {
- #define H_make_filtered_comb_bank "(" S_make_filtered_comb_bank " gens): return a new filtered_comb-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_filtered_comb_bank, "a vector of filtered_comb generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_filtered_comb(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_filtered_comb_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_filtered_comb_bank(Xen os)
- {
- #define H_is_filtered_comb_bank "(" S_is_filtered_comb_bank " gen): " PROC_TRUE " if gen is a " S_filtered_comb_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_filtered_comb_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_filtered_comb_bank(Xen gens, Xen inp)
- {
- #define H_filtered_comb_bank "(" S_filtered_comb_bank " bank inval): sum an array of " S_filtered_comb " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_filtered_comb_bank, S_filtered_comb_bank, "a filtered-comb-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_filtered_comb_bank, 2);
-
- return(C_double_to_Xen_real(mus_filtered_comb_bank(bank, x)));
- }
-
-
-
- static Xen g_all_pass(Xen obj, Xen input, Xen pm)
- {
- #define H_all_pass "(" S_all_pass " gen (val 0.0) (pm 0.0)): all-pass filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_all_pass, S_all_pass, "an all-pass filter");
- Xen_real_to_C_double_if_bound(input, in1, S_all_pass, 2);
- Xen_real_to_C_double_if_bound(pm, pm1, S_all_pass, 3);
-
- return(C_double_to_Xen_real(mus_all_pass(g, in1, pm1)));
- }
-
-
- static Xen g_make_all_pass_bank(Xen arg)
- {
- #define H_make_all_pass_bank "(" S_make_all_pass_bank " gens): return a new all_pass-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
-
- Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_all_pass_bank, "a vector of all_pass generators");
-
- size = Xen_vector_length(arg);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(arg, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_all_pass(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_all_pass_bank(j, gens);
- free(gens);
-
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
- return(Xen_false);
- }
-
-
- static Xen g_is_all_pass_bank(Xen os)
- {
- #define H_is_all_pass_bank "(" S_is_all_pass_bank " gen): " PROC_TRUE " if gen is a " S_all_pass_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_all_pass_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_all_pass_bank(Xen gens, Xen inp)
- {
- #define H_all_pass_bank "(" S_all_pass_bank " bank inval): sum an array of " S_all_pass " filters."
- mus_any *bank = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_all_pass_bank, S_all_pass_bank, "an all-pass-bank generator");
- Xen_real_to_C_double_if_bound(inp, x, S_all_pass_bank, 2);
-
- return(C_double_to_Xen_real(mus_all_pass_bank(bank, x)));
- }
-
-
-
- static Xen g_moving_average(Xen obj, Xen input)
- {
- #define H_moving_average "(" S_moving_average " gen (val 0.0)): moving window average."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_average, S_moving_average, "a moving-average generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_average, 2);
-
- return(C_double_to_Xen_real(mus_moving_average(g, in1)));
- }
-
-
- static Xen g_moving_max(Xen obj, Xen input)
- {
- #define H_moving_max "(" S_moving_max " gen (val 0.0)): moving window max."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_max, S_moving_max, "a moving-max generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_max, 2);
-
- return(C_double_to_Xen_real(mus_moving_max(g, in1)));
- }
-
-
- static Xen g_moving_norm(Xen obj, Xen input)
- {
- #define H_moving_norm "(" S_moving_norm " gen (val 0.0)): moving window norm."
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_moving_norm, S_moving_norm, "a moving-norm generator");
- Xen_real_to_C_double_if_bound(input, in1, S_moving_norm, 2);
-
- return(C_double_to_Xen_real(mus_moving_norm(g, in1)));
- }
-
-
- static Xen g_tap(Xen obj, Xen loc)
- {
- #define H_tap "(" S_tap " gen (pm 0.0)): tap the " S_delay " generator offset by pm"
- mus_float_t dloc = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_tap, S_tap, "a delay line tap");
- Xen_real_to_C_double_if_bound(loc, dloc, S_tap, 3);
-
- return(C_double_to_Xen_real(mus_tap(g, dloc)));
- }
-
-
- static Xen g_is_tap(Xen obj)
- {
- #define H_is_tap "(" S_is_tap " gen): " PROC_TRUE " if gen is a delay line tap"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_tap(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_delay(Xen obj)
- {
- #define H_is_delay "(" S_is_delay " gen): " PROC_TRUE " if gen is a delay line"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_delay(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_comb(Xen obj)
- {
- #define H_is_comb "(" S_is_comb " gen): " PROC_TRUE " if gen is a comb filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_comb(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_filtered_comb(Xen obj)
- {
- #define H_is_filtered_comb "(" S_is_filtered_comb " gen): " PROC_TRUE " if gen is a filtered-comb filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filtered_comb(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_notch(Xen obj)
- {
- #define H_is_notch "(" S_is_notch " gen): " PROC_TRUE " if gen is a notch filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_notch(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_all_pass(Xen obj)
- {
- #define H_is_all_pass "(" S_is_all_pass " gen): " PROC_TRUE " if gen is an all-pass filter"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_all_pass(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_average(Xen obj)
- {
- #define H_is_moving_average "(" S_is_moving_average " gen): " PROC_TRUE " if gen is a moving-average generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_average(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_max(Xen obj)
- {
- #define H_is_moving_max "(" S_is_moving_max " gen): " PROC_TRUE " if gen is a moving-max generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_max(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_moving_norm(Xen obj)
- {
- #define H_is_moving_norm "(" S_is_moving_norm " gen): " PROC_TRUE " if gen is a moving-norm generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_norm(Xen_to_mus_any(obj)))));
- }
-
-
- /* -------- ncos -------- */
-
- static Xen g_is_ncos(Xen obj)
- {
- #define H_is_ncos "(" S_is_ncos " gen): " PROC_TRUE " if gen is an " S_ncos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_ncos(Xen_to_mus_any(obj)))));
- }
-
- static Xen g_make_ncos(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_ncos "(" S_make_ncos " (frequency *clm-default-frequency*) (n 1)): \
- return a new " S_ncos " generator, producing a sum of 'n' equal amplitude cosines."
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals, n = 1;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_n;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_ncos, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ncos, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_ncos, orig_arg[0], keys[0], "freq > srate/2?");
-
- n = Xen_optkey_to_int(kw_n, keys[1], S_make_ncos, orig_arg[1], n);
- if (n <= 0)
- Xen_out_of_range_error(S_make_ncos, orig_arg[1], keys[1], "n <= 0?");
- }
-
- ge = mus_make_ncos(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
- static Xen g_ncos(Xen obj, Xen fm)
- {
- #define H_ncos "(" S_ncos " gen (fm 0.0)): get the next sample from 'gen', an " S_ncos " generator"
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_ncos, S_ncos, "an ncos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_ncos, 2);
-
- return(C_double_to_Xen_real(mus_ncos(g, fm1)));
- }
-
-
-
- /* -------- nsin -------- */
-
- static Xen g_is_nsin(Xen obj)
- {
- #define H_is_nsin "(" S_is_nsin " gen): " PROC_TRUE " if gen is an " S_nsin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nsin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_nsin(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_nsin "(" S_make_nsin " (frequency *clm-default-frequency*) (n 1)): \
- return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines"
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals, n = 1;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_n;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_nsin, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_nsin, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_nsin, orig_arg[0], keys[0], "freq > srate/2?");
-
- n = Xen_optkey_to_int(kw_n, keys[1], S_make_nsin, orig_arg[1], n);
- if (n <= 0)
- Xen_out_of_range_error(S_make_nsin, orig_arg[1], keys[1], "n <= 0?");
- }
-
- ge = mus_make_nsin(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_nsin(Xen obj, Xen fm)
- {
- #define H_nsin "(" S_nsin " gen (fm 0.0)): get the next sample from 'gen', an " S_nsin " generator"
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nsin, S_nsin, "an nsin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nsin, 2);
-
- return(C_double_to_Xen_real(mus_nsin(g, fm1)));
- }
-
-
-
- /* ---------------- rand, rand_interp ---------------- */
-
- #define RANDOM_DISTRIBUTION_TABLE_SIZE 512
- #define RANDOM_DISTRIBUTION_ENVELOPE_SIZE 50
-
- static mus_float_t *inverse_integrate(Xen dist, int data_size)
- {
- /* e = env possibly starting < 0 */
- int e_size = RANDOM_DISTRIBUTION_ENVELOPE_SIZE;
- mus_float_t *e, *data;
- int i, e_len, lim, e_loc = 2;
- Xen ex0, ex1, ey0, ey1;
- mus_float_t x, x0, x1, xincr, y0, y1, sum, first_sum, last_sum = 0.0;
-
- lim = (e_size + 1) * 2;
- e = (mus_float_t *)calloc(lim, sizeof(mus_float_t));
-
- e_len = Xen_list_length(dist);
- ex0 = Xen_list_ref(dist, 0);
- ex1 = Xen_list_ref(dist, e_len - 2);
- x0 = Xen_real_to_C_double(ex0);
- /* get x range first */
- x1 = Xen_real_to_C_double(ex1);
- xincr = (x1 - x0) / (mus_float_t)e_size;
- /* now true x1 */
- ex1 = Xen_list_ref(dist, 2);
- x1 = Xen_real_to_C_double(ex1);
- ey0 = Xen_list_ref(dist, 1);
- ey1 = Xen_list_ref(dist, 3);
- y0 = Xen_real_to_C_double(ey0);
- y1 = Xen_real_to_C_double(ey1);
- sum = y0;
- first_sum = sum;
-
- for (i = 0, x = x0; i < lim; i += 2, x += xincr)
- {
- e[i] = sum;
- last_sum = sum;
- e[i + 1] = x;
- while ((x >= x1) && ((e_loc + 2) < e_len))
- {
- x0 = x1;
- y0 = y1;
- e_loc += 2;
- ex1 = Xen_list_ref(dist, e_loc);
- ey1 = Xen_list_ref(dist, e_loc + 1);
- x1 = Xen_real_to_C_double(ex1);
- y1 = Xen_real_to_C_double(ey1);
- }
- if ((x == x0) || (x0 == x1))
- sum += y0;
- else sum += (y0 + (y1 - y0) * (x - x0) / (x1 - x0));
- }
-
- xincr = (last_sum - first_sum) / (mus_float_t)(data_size - 1);
- data = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
- x0 = e[0];
- x1 = e[2];
- y0 = e[1];
- y1 = e[3];
- e_len = lim;
- e_loc = 2;
-
- for (i = 0, x = first_sum; i < data_size; i++, x += xincr)
- {
- while ((x >= x1) && ((e_loc + 2) < e_len))
- {
- x0 = x1;
- y0 = y1;
- e_loc += 2;
- x1 = e[e_loc];
- y1 = e[e_loc + 1];
- }
- if ((x == x0) || (x0 == x1))
- data[i] = y0;
- else data[i] = (y0 + (y1 - y0) * (x - x0) / (x1 - x0));
- }
- free(e);
- return(data);
- }
-
-
- static Xen g_make_noi(bool rand_case, const char *caller, Xen arglist)
- {
- mus_any *ge = NULL;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals;
- mus_float_t freq, base = 1.0;
- mus_float_t *distribution = NULL;
- Xen orig_v = Xen_false;
- int distribution_size = RANDOM_DISTRIBUTION_TABLE_SIZE;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_amplitude;
- keys[2] = kw_envelope;
- keys[3] = kw_distribution;
- keys[4] = kw_size;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > mus_srate())
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
-
- distribution_size = Xen_optkey_to_int(kw_size, keys[4], caller, orig_arg[4], distribution_size);
- if (distribution_size <= 0)
- Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size <= 0?");
- if (distribution_size > mus_max_table_size())
- Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size too large (see mus-max-table-size)");
-
- if (!(Xen_is_keyword(keys[2]))) /* i.e. envelope arg was specified */
- {
- int len;
- Xen_check_type(Xen_is_list(keys[2]), keys[2], orig_arg[2], caller, "an envelope");
- len = Xen_list_length(keys[2]);
- if ((len < 4) || (len & 1))
- clm_error(caller, "bad distribution envelope", keys[2]);
- /* envelope and distribution are incompatible */
- if (!(Xen_is_keyword(keys[3])))
- clm_error(caller, ":envelope and :distribution in same call?", keys[3]);
- distribution = inverse_integrate(keys[2], distribution_size);
- orig_v = xen_make_vct(distribution_size, distribution);
- }
- else
- {
- if (!(Xen_is_keyword(keys[3]))) /* i.e. distribution arg was specified */
- {
- Xen_check_type(mus_is_vct(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], caller, "a " S_vct);
- if (mus_is_vct(keys[3]))
- {
- vct *v = NULL;
- orig_v = keys[3];
- v = mus_optkey_to_vct(orig_v, caller, orig_arg[3], NULL);
- distribution_size = mus_vct_length(v);
- distribution = mus_vct_data(v);
- }
- }
- }
- }
- if (!distribution)
- {
- if (rand_case)
- ge = mus_make_rand(freq, base);
- else ge = mus_make_rand_interp(freq, base);
- }
- else
- {
- if (rand_case)
- ge = mus_make_rand_with_distribution(freq, base, distribution, distribution_size);
- else ge = mus_make_rand_interp_with_distribution(freq, base, distribution, distribution_size);
- }
- if (ge)
- {
- if (mus_is_vct(orig_v))
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_make_rand_interp(Xen arglist)
- {
- #define H_make_rand_interp "(" S_make_rand_interp " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
- return a new " S_rand_interp " generator, producing linearly interpolated random numbers. \
- frequency is the rate at which new end-points are chosen."
-
- return(g_make_noi(false, S_make_rand_interp, arglist));
- }
-
-
- static Xen g_make_rand(Xen arglist)
- {
- #define H_make_rand "(" S_make_rand " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
- return a new " S_rand " generator, producing a sequence of random numbers (a step function). \
- frequency is the rate at which new numbers are chosen."
-
- return(g_make_noi(true, S_make_rand, arglist));
- }
-
-
- static Xen g_rand(Xen obj, Xen fm)
- {
- #define H_rand "(" S_rand " gen (fm 0.0)): gen's current random number. \
- fm modulates the rate at which the current number is changed."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rand, S_rand, "a rand generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rand, 2);
-
- return(C_double_to_Xen_real(mus_rand(g, fm1)));
- }
-
-
- static Xen g_is_rand(Xen obj)
- {
- #define H_is_rand "(" S_is_rand " gen): " PROC_TRUE " if gen is a " S_rand
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_rand_interp(Xen obj, Xen fm)
- {
- #define H_rand_interp "(" S_rand_interp " gen (fm 0.0)): gen's current (interpolating) random number. \
- fm modulates the rate at which new segment end-points are chosen."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rand_interp, S_rand_interp, "a rand-interp generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rand_interp, 2);
-
- return(C_double_to_Xen_real(mus_rand_interp(g, fm1)));
- }
-
-
- static Xen g_is_rand_interp(Xen obj)
- {
- #define H_is_rand_interp "(" S_is_rand_interp " gen): " PROC_TRUE " if gen is a " S_rand_interp
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand_interp(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_mus_random(Xen a)
- {
- #define H_mus_random "(" S_mus_random " val): a random number between -val and val. \
- the built-in 'random' function returns values between 0 and its argument"
- mus_float_t x;
-
- Xen_to_C_double_or_error(a, x, S_mus_random, 1);
- return(C_double_to_Xen_real(mus_random(x)));
- }
-
-
- static Xen g_mus_rand_seed(void)
- {
- #define H_mus_rand_seed "(" S_mus_rand_seed "): the random number seed; \
- this can be used to re-run a particular random number sequence."
-
- return(C_int_to_Xen_integer(mus_rand_seed()));
- }
-
-
- static Xen g_mus_set_rand_seed(Xen a)
- {
- Xen_check_type(Xen_is_integer(a), a, 1, S_set S_mus_rand_seed, "an integer");
- mus_set_rand_seed((unsigned long)Xen_integer_to_C_int(a));
- return(a);
- }
-
-
-
- /* ---------------- table lookup ---------------- */
-
- static Xen g_is_table_lookup(Xen obj)
- {
- #define H_is_table_lookup "(" S_is_table_lookup " gen): " PROC_TRUE " if gen is a " S_table_lookup
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_table_lookup(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_partials_to_wave(Xen partials, Xen utable, Xen normalize)
- {
- #define H_partials_to_wave "(" S_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
- take a list or " S_vct " of partials (harmonic number and associated amplitude) and produce \
- a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
- a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n\
- (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0 2 .5))))"
-
- vct *f;
- Xen table;
- mus_float_t *partial_data = NULL;
- mus_long_t len = 0;
- bool partials_allocated = true;
- #if HAVE_SCHEME
- int gc_loc;
- #endif
-
- Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_partials_to_wave, "a list or a " S_vct);
- Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_partials_to_wave, "a " S_vct " or " PROC_FALSE);
- Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_partials_to_wave, "a boolean");
-
- if (mus_is_vct(partials))
- {
- vct *v;
- v = Xen_to_vct(partials);
- partial_data = mus_vct_data(v);
- len = mus_vct_length(v);
- partials_allocated = false;
- }
- else
- {
- len = Xen_list_length(partials);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
- C_string_to_Xen_string(S_partials_to_wave)));
-
- if (!(Xen_is_number(Xen_car(partials))))
- Xen_check_type(false, partials, 1, S_partials_to_wave, "a list of numbers (partial numbers with amplitudes)");
- }
- if (len & 1)
- Xen_error(BAD_TYPE,
- Xen_list_3(C_string_to_Xen_string("~A: odd length partials list? ~A"),
- C_string_to_Xen_string(S_partials_to_wave),
- partials));
-
- if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
- {
- mus_float_t *wave;
- wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_partials_to_wave));
- table = xen_make_vct(clm_table_size, wave);
- }
- else table = utable;
-
- #if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, table);
- #endif
-
- f = Xen_to_vct(table);
-
- if (!partial_data)
- {
- Xen lst;
- int i;
- partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_partials_to_wave));
- for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
- partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
- }
-
- mus_partials_to_wave(partial_data, len / 2, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
-
- if (partials_allocated)
- free(partial_data);
-
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
- #endif
-
- return(table);
- }
-
-
- static Xen g_phase_partials_to_wave(Xen partials, Xen utable, Xen normalize)
- {
- vct *f;
- Xen table;
- mus_float_t *partial_data = NULL;
- mus_long_t len = 0;
- bool partials_allocated = true;
- #if HAVE_SCHEME
- int gc_loc;
- #endif
-
- #if HAVE_SCHEME
- #define pp2w_example "(" S_make_table_lookup " 440.0 :wave (" S_phase_partials_to_wave " (list 1 .75 0.0 2 .25 (* 3.14159 .5))))"
- #endif
- #if HAVE_RUBY
- #define pp2w_example "make_table_lookup(440.0, :wave, phase_partials2wave([1.0, 0.75, 0.0, 2.0, 0.25, 3.14159 * 0.5]))"
- #endif
- #if HAVE_FORTH
- #define pp2w_example "440.0 0.0 '( 1.0 0.75 0.0 2.0 0.25 3.14159 0.5 f* ) #f #f phase-partials->wave make-table-lookup"
- #endif
-
- #define H_phase_partials_to_wave "(" S_phase_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
- take a list or " S_vct " of partials (harmonic number, amplitude, initial phase) and produce \
- a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
- a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n " pp2w_example
-
- Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_phase_partials_to_wave, "a list or a " S_vct);
- Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_phase_partials_to_wave, "a " S_vct " or " PROC_FALSE);
- Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_phase_partials_to_wave, "a boolean");
-
- if (mus_is_vct(partials))
- {
- vct *v;
- v = Xen_to_vct(partials);
- partial_data = mus_vct_data(v);
- len = mus_vct_length(v);
- partials_allocated = false;
- }
- else
- {
- len = Xen_list_length(partials);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
- C_string_to_Xen_string(S_phase_partials_to_wave)));
-
- if (!(Xen_is_number(Xen_car(partials))))
- Xen_check_type(false, partials, 1, S_phase_partials_to_wave, "a list of numbers (partial numbers with amplitudes and phases)");
- }
- if ((len % 3) != 0)
- Xen_error(Xen_make_error_type("wrong-type-arg"),
- Xen_list_3(C_string_to_Xen_string("~A: partials list, ~A, should have 3 entries for each harmonic (number amp phase)"),
- C_string_to_Xen_string(S_phase_partials_to_wave),
- partials));
-
- if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
- {
- mus_float_t *wave;
- wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_phase_partials_to_wave));
- table = xen_make_vct(clm_table_size, wave);
- }
- else table = utable;
-
- #if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, table);
- #endif
-
- f = Xen_to_vct(table);
-
- if (!partial_data)
- {
- int i;
- Xen lst;
- partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_phase_partials_to_wave));
- for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
- partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
- }
-
- mus_phase_partials_to_wave(partial_data, len / 3, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
-
- if (partials_allocated)
- free(partial_data);
-
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
- #endif
-
- return(table);
- }
-
-
- static Xen g_make_table_lookup(Xen arglist)
- {
- #define H_make_table_lookup "(" S_make_table_lookup " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
- return a new " S_table_lookup " generator. \
- The default table size is 512; use :size to set some other size, or pass your own " S_vct " as the 'wave'.\n\
- (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0))))\n\
- is the same in effect as " S_make_oscil ". 'type' sets the interpolation choice which defaults to " S_mus_interp_linear "."
-
- mus_any *ge;
- int vals;
- mus_long_t table_size = clm_table_size;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
- mus_float_t freq, phase = 0.0;
- mus_float_t *table = NULL;
- Xen orig_v = Xen_false;
- int interp_type = (int)MUS_INTERP_LINEAR;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_wave;
- keys[3] = kw_size;
- keys[4] = kw_type;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_table_lookup, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_table_lookup, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_table_lookup, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_table_lookup, orig_arg[1], phase);
- if (phase < 0.0)
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[1], keys[1], "initial phase <= 0.0?"); /* is this actually an error? */
-
- v = mus_optkey_to_vct(keys[2], S_make_table_lookup, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- table = mus_vct_data(v);
- table_size = mus_vct_length(v);
- }
-
- table_size = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_table_lookup, orig_arg[3], table_size);
- if (table_size <= 0)
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size <= 0?");
- if (table_size > mus_max_table_size())
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
- if ((v) && (table_size > mus_vct_length(v)))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "table size > wave size");
-
- interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_table_lookup, orig_arg[4], interp_type);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(S_make_table_lookup, orig_arg[4], keys[4], "no such interp-type");
- }
-
- if (!(mus_is_vct(orig_v)))
- {
- table = (mus_float_t *)calloc(table_size, sizeof(mus_float_t));
- if (table == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate table-lookup table", S_make_table_lookup));
- orig_v = xen_make_vct(table_size, table);
- }
- ge = mus_make_table_lookup(freq, phase, table, table_size, (mus_interp_t)interp_type);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- }
-
-
- static Xen g_table_lookup(Xen obj, Xen fm)
- {
- #define H_table_lookup "(" S_table_lookup " gen (fm 0.0)): interpolated table-lookup \
- with 'wrap-around' when gen's phase marches off either end of its table."
-
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_table_lookup, S_table_lookup, "a table-lookup generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_table_lookup, 2);
-
- return(C_double_to_Xen_real(mus_table_lookup(g, fm1)));
- }
-
-
-
- /* ---------------- sawtooth et al ---------------- */
-
- typedef enum {G_SAWTOOTH_WAVE, G_SQUARE_WAVE, G_TRIANGLE_WAVE, G_PULSE_TRAIN} xclm_wave_t;
-
- static Xen g_make_sw(xclm_wave_t type, mus_float_t def_phase, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- mus_any *ge = NULL;
- const char *caller = NULL;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t freq, base = 1.0, phase;
-
- freq = clm_default_frequency;
- phase = def_phase;
-
- switch (type)
- {
- case G_SAWTOOTH_WAVE: caller = S_make_sawtooth_wave; break;
- case G_SQUARE_WAVE: caller = S_make_square_wave; break;
- case G_TRIANGLE_WAVE: caller = S_make_triangle_wave; break;
- case G_PULSE_TRAIN: caller = S_make_pulse_train; break;
- }
-
- keys[0] = kw_frequency;
- keys[1] = kw_amplitude;
- keys[2] = kw_initial_phase;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
-
- vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > mus_srate())
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
- phase = Xen_optkey_to_float(kw_initial_phase, keys[2], caller, orig_arg[2], phase);
- }
-
- switch (type)
- {
- case G_SAWTOOTH_WAVE: ge = mus_make_sawtooth_wave(freq, base, phase); break;
- case G_SQUARE_WAVE: ge = mus_make_square_wave(freq, base, phase); break;
- case G_TRIANGLE_WAVE: ge = mus_make_triangle_wave(freq, base, phase); break;
- case G_PULSE_TRAIN: ge = mus_make_pulse_train(freq, base, phase); break;
- }
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_sawtooth_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_sawtooth_wave "(" S_make_sawtooth_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_sawtooth_wave " generator."
-
- return(g_make_sw(G_SAWTOOTH_WAVE, M_PI, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_square_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_square_wave "(" S_make_square_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_square_wave " generator."
-
- return(g_make_sw(G_SQUARE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_triangle_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_triangle_wave "(" S_make_triangle_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_triangle_wave " generator."
-
- return(g_make_sw(G_TRIANGLE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_pulse_train(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_pulse_train "(" S_make_pulse_train " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
- return a new " S_pulse_train " generator. This produces a sequence of impulses."
-
- return(g_make_sw(G_PULSE_TRAIN, TWO_PI, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_sawtooth_wave(Xen obj, Xen fm)
- {
- #define H_sawtooth_wave "(" S_sawtooth_wave " gen (fm 0.0)): next sawtooth sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_sawtooth_wave, S_sawtooth_wave, "a sawtooth-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_sawtooth_wave, 2);
-
- return(C_double_to_Xen_real(mus_sawtooth_wave(g, fm1)));
- }
-
-
- static Xen g_square_wave(Xen obj, Xen fm)
- {
- #define H_square_wave "(" S_square_wave " gen (fm 0.0)): next square wave sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_square_wave, S_square_wave, "a square-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_square_wave, 2);
-
- return(C_double_to_Xen_real(mus_square_wave(g, fm1)));
- }
-
-
- static Xen g_triangle_wave(Xen obj, Xen fm)
- {
- #define H_triangle_wave "(" S_triangle_wave " gen (fm 0.0)): next triangle wave sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_triangle_wave, S_triangle_wave, "a triangle-wave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_triangle_wave, 2);
-
- return(C_double_to_Xen_real(mus_triangle_wave(g, fm1)));
- }
-
-
- static Xen g_pulse_train(Xen obj, Xen fm)
- {
- #define H_pulse_train "(" S_pulse_train " gen (fm 0.0)): next pulse train sample from generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_pulse_train, S_pulse_train, "a pulse-train generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_pulse_train, 2);
-
- return(C_double_to_Xen_real(mus_pulse_train(g, fm1)));
- }
-
-
- static Xen g_is_sawtooth_wave(Xen obj)
- {
- #define H_is_sawtooth_wave "(" S_is_sawtooth_wave " gen): " PROC_TRUE " if gen is a " S_sawtooth_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sawtooth_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_square_wave(Xen obj)
- {
- #define H_is_square_wave "(" S_is_square_wave " gen): " PROC_TRUE " if gen is a " S_square_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_square_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_triangle_wave(Xen obj)
- {
- #define H_is_triangle_wave "(" S_is_triangle_wave " gen): " PROC_TRUE " if gen is a " S_triangle_wave
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_triangle_wave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_pulse_train(Xen obj)
- {
- #define H_is_pulse_train "(" S_is_pulse_train " gen): " PROC_TRUE " if gen is a " S_pulse_train
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_pulse_train(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- asymmetric-fm ---------------- */
-
- static Xen g_make_asymmetric_fm(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
- {
- #define H_make_asymmetric_fm "(" S_make_asymmetric_fm " (frequency *clm-default-frequency*) (initial-phase 0.0) (r 1.0) (ratio 1.0)): \
- return a new " S_asymmetric_fm " generator."
-
- mus_any *ge;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals;
- mus_float_t freq, phase = 0.0, r = 1.0, ratio = 1.0;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_r;
- keys[3] = kw_ratio;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = arg7; args[7] = arg8;
-
- vals = mus_optkey_unscramble(S_make_asymmetric_fm, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_asymmetric_fm, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_asymmetric_fm, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_asymmetric_fm, orig_arg[1], phase);
-
- r = Xen_optkey_to_float(kw_r, keys[2], S_make_asymmetric_fm, orig_arg[2], r);
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[3], S_make_asymmetric_fm, orig_arg[3], ratio);
- }
-
- ge = mus_make_asymmetric_fm(freq, phase, r, ratio);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
-
- static Xen g_asymmetric_fm(Xen obj, Xen index, Xen fm)
- {
- #define H_asymmetric_fm "(" S_asymmetric_fm " gen (index 0.0) (fm 0.0)): next sample from asymmetric fm generator"
- mus_float_t fm1 = 0.0, index1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_asymmetric_fm, S_asymmetric_fm, "an asymmetric-fm generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_asymmetric_fm, 2);
- Xen_real_to_C_double_if_bound(index, index1, S_asymmetric_fm, 3);
-
- return(C_double_to_Xen_real(mus_asymmetric_fm(g, index1, fm1)));
- }
-
-
- static Xen g_is_asymmetric_fm(Xen obj)
- {
- #define H_is_asymmetric_fm "(" S_is_asymmetric_fm " gen): " PROC_TRUE " if gen is a " S_asymmetric_fm
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_asymmetric_fm(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- simple filters ---------------- */
-
- typedef enum {G_ONE_POLE, G_ONE_ZERO, G_TWO_POLE, G_TWO_ZERO} xclm_filter_t;
-
- static const char *smpflts[6] = {S_make_one_pole, S_make_one_zero, S_make_two_pole, S_make_two_zero};
-
-
- static Xen g_make_smpflt_1(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- mus_any *gen = NULL;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals;
- mus_float_t a0 = 0.0;
- mus_float_t a1 = 0.0;
-
- switch (choice)
- {
- case G_ONE_ZERO: keys[0] = kw_a0; keys[1] = kw_a1; break;
- case G_ONE_POLE: keys[0] = kw_a0; keys[1] = kw_b1; break;
- default: keys[0] = kw_frequency; keys[1] = kw_radius; break;
- }
-
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(smpflts[choice], 2, keys, args, orig_arg);
- if (vals > 0)
- {
- a0 = mus_optkey_to_float(keys[0], smpflts[choice], orig_arg[0], a0);
- a1 = mus_optkey_to_float(keys[1], smpflts[choice], orig_arg[1], a1);
- }
-
- switch (choice)
- {
- case G_ONE_ZERO: gen = mus_make_one_zero(a0, a1); break;
- case G_ONE_POLE: gen = mus_make_one_pole(a0, a1); break;
- case G_TWO_ZERO: gen = mus_make_two_zero_from_frequency_and_radius(a0, a1); break;
- case G_TWO_POLE: gen = mus_make_two_pole_from_frequency_and_radius(a0, a1); break;
- default: break;
- }
- if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(Xen_false);
- }
-
-
- static Xen g_make_one_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_one_zero "(" S_make_one_zero " a0 a1): return a new " S_one_zero " filter; a0*x(n) + a1*x(n-1)"
- return(g_make_smpflt_1(G_ONE_ZERO, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_make_one_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_one_pole "(" S_make_one_pole " a0 b1): return a new " S_one_pole " filter; a0*x(n) - b1*y(n-1)"
- return(g_make_smpflt_1(G_ONE_POLE, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_make_smpflt_2(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- mus_any *gen = NULL;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t a0 = 0.0;
- mus_float_t a1 = 0.0;
- mus_float_t a2 = 0.0;
- if (choice == G_TWO_ZERO)
- {
- keys[0] = kw_a0;
- keys[1] = kw_a1;
- keys[2] = kw_a2;
- }
- else
- {
- keys[0] = kw_a0;
- keys[1] = kw_b1;
- keys[2] = kw_b2;
- }
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
- vals = mus_optkey_unscramble(smpflts[choice], 3, keys, args, orig_arg);
- if (vals > 0)
- {
- a0 = Xen_optkey_to_float(kw_a0, keys[0], smpflts[choice], orig_arg[0], a0);
- a1 = mus_optkey_to_float(keys[1], smpflts[choice], orig_arg[1], a1);
- a2 = mus_optkey_to_float(keys[2], smpflts[choice], orig_arg[2], a2);
- }
- if (choice == G_TWO_ZERO)
- gen = mus_make_two_zero(a0, a1, a2);
- else gen = mus_make_two_pole(a0, a1, a2);
- if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(Xen_false);
- }
-
-
- static bool found_polar_key(Xen arg)
- {
- return((Xen_is_keyword(arg)) &&
- ((Xen_keyword_is_eq(arg, kw_radius)) ||
- (Xen_keyword_is_eq(arg, kw_frequency))));
- }
-
-
- static bool found_coeff_key(Xen arg)
- {
- return((Xen_is_keyword(arg)) &&
- (!(Xen_keyword_is_eq(arg, kw_radius))) &&
- (!(Xen_keyword_is_eq(arg, kw_frequency))));
- }
-
-
- static Xen g_make_two_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_two_zero "(" S_make_two_zero " a0 a1 a2) or (" S_make_two_zero " frequency radius): return a new " S_two_zero " filter; \
- a0*x(n) + a1*x(n-1) + a2*x(n-2)"
-
- if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
- (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
- {
- if ((found_polar_key(arg1)) ||
- (found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(Xen_is_bound(arg3))) && /* make a guess that if 2 args, no keys, and a0 > 20, it is intended as a frequency */
- (!(found_coeff_key(arg1))) &&
- ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 20.0))))
- return(g_make_smpflt_1(G_TWO_ZERO, arg1, arg2, arg3, arg4));
- }
-
- return(g_make_smpflt_2(G_TWO_ZERO, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_two_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_two_pole "(" S_make_two_pole " a0 b1 b2) or (" S_make_two_pole " frequency radius): return a new " S_two_pole " filter; \
- a0*x(n) - b1*y(n-1) - b2*y(n-2)"
-
- if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
- (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
- {
- if ((found_polar_key(arg1)) ||
- (found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(Xen_is_bound(arg3))) &&
- (!(found_coeff_key(arg1))) &&
- ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 2.0))))
- return(g_make_smpflt_1(G_TWO_POLE, arg1, arg2, arg3, arg4));
- }
-
- return(g_make_smpflt_2(G_TWO_POLE, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_one_zero(Xen obj, Xen fm)
- {
- #define H_one_zero "(" S_one_zero " gen (input 0.0)): one zero filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_one_zero, S_one_zero, "a one-zero filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_one_zero, 2);
-
- return(C_double_to_Xen_real(mus_one_zero(g, fm1)));
- }
-
-
- static Xen g_one_pole(Xen obj, Xen fm)
- {
- #define H_one_pole "(" S_one_pole " gen (input 0.0)): one pole filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_one_pole, S_one_pole, "a one-pole filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_one_pole, 2);
-
- return(C_double_to_Xen_real(mus_one_pole(g, fm1)));
- }
-
-
- static Xen g_two_zero(Xen obj, Xen fm)
- {
- #define H_two_zero "(" S_two_zero " gen (input 0.0)): two zero filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_two_zero, S_two_zero, "a two-zero filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_two_zero, 2);
-
- return(C_double_to_Xen_real(mus_two_zero(g, fm1)));
- }
-
-
- static Xen g_two_pole(Xen obj, Xen fm)
- {
- #define H_two_pole "(" S_two_pole " gen (input 0.0)): two pole filter of input"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_two_pole, S_two_pole, "a two-pole filter");
- Xen_real_to_C_double_if_bound(fm, fm1, S_two_pole, 2);
-
- return(C_double_to_Xen_real(mus_two_pole(g, fm1)));
- }
-
-
- static Xen g_is_one_zero(Xen obj)
- {
- #define H_is_one_zero "(" S_is_one_zero " gen): " PROC_TRUE " if gen is a " S_one_zero
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_zero(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_one_pole(Xen obj)
- {
- #define H_is_one_pole "(" S_is_one_pole " gen): " PROC_TRUE " if gen is a " S_one_pole
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_pole(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_two_zero(Xen obj)
- {
- #define H_is_two_zero "(" S_is_two_zero " gen): " PROC_TRUE " if gen is a " S_two_zero
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_zero(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_two_pole(Xen obj)
- {
- #define H_is_two_pole "(" S_is_two_pole " gen): " PROC_TRUE " if gen is a " S_two_pole
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_pole(Xen_to_mus_any(obj)))));
- }
-
-
-
-
- /* ---------------- formant ---------------- */
-
- static Xen g_make_frm(bool formant_case, const char *caller, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- mus_any *ge;
- int vals;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- mus_float_t freq = 0.0, radius = 0.0;
-
- keys[0] = kw_frequency;
- keys[1] = kw_radius;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(caller, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- radius = Xen_optkey_to_float(kw_radius, keys[1], caller, orig_arg[1], radius);
- }
-
- if (formant_case)
- {
- ge = mus_make_formant(freq, radius);
- if (ge)
- {
- mus_xen *gn;
- gn = mus_any_to_mus_xen(ge);
- return(mus_xen_to_object(gn));
- }
- }
- else
- {
- ge = mus_make_firmant(freq, radius);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_formant(Xen gen, Xen input, Xen freq)
- {
- #define H_formant "(" S_formant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_formant, "a formant generator");
-
- Xen_real_to_C_double_if_bound(input, in1, S_formant, 2);
- if (Xen_is_bound(freq))
- return(C_double_to_Xen_real(mus_formant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
-
- return(C_double_to_Xen_real(mus_formant(g, in1)));
- }
-
-
- static Xen g_make_formant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_formant "(" S_make_formant " frequency radius): \
- return a new formant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
- frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(true, S_make_formant, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_is_formant(Xen os)
- {
- #define H_is_formant "(" S_is_formant " gen): " PROC_TRUE " if gen is a " S_formant
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_set_formant_radius_and_frequency(Xen gen, Xen rad, Xen frq)
- {
- #define H_mus_set_formant_radius_and_frequency "(" S_mus_set_formant_radius_and_frequency " gen radius frequency): set " S_formant " \
- generator gen's radius and frequency"
- mus_any *g = NULL;
- mus_float_t radius, frequency;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_radius_and_frequency, "a formant generator");
-
- Xen_to_C_double_or_error(rad, radius, S_mus_set_formant_radius_and_frequency, 2);
- Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_radius_and_frequency, 3);
-
- mus_set_formant_radius_and_frequency(g, radius, frequency);
- return(rad);
- }
-
-
- static Xen g_set_formant_frequency(Xen gen, Xen frq)
- {
- #define H_mus_set_formant_frequency "(" S_mus_set_formant_frequency " gen frequency): set " S_formant " generator gen's frequency"
- mus_any *g = NULL;
- mus_float_t frequency;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_frequency, "a formant generator");
- Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_frequency, 2);
-
- mus_set_formant_frequency(g, frequency);
- return(frq);
- }
-
-
- static Xen g_make_formant_bank(Xen frms, Xen amps)
- {
- #define H_make_formant_bank "(" S_make_formant_bank " gens amps): return a new formant-bank generator."
-
- mus_any *ge = NULL;
- mus_any **gens;
- int i, j, size;
- vct *v = NULL;
-
- Xen_check_type(Xen_is_vector(frms), frms, 1, S_make_formant_bank, "a vector of formant generators");
- /* need size and elements -> mus_any */
-
- size = Xen_vector_length(frms);
- if (size == 0) return(Xen_false);
- gens = (mus_any **)calloc(size, sizeof(mus_any *));
-
- if (Xen_is_bound(amps))
- {
- v = Xen_to_vct(amps);
- if (!v) Xen_check_type(false, amps, 2, S_make_formant_bank, "a " S_vct " if anything");
- }
-
- for (i = 0, j = 0; i < size; i++)
- {
- Xen g;
- g = Xen_vector_ref(frms, i);
- if (mus_is_xen(g))
- {
- mus_any *fg;
- fg = Xen_to_mus_any(g);
- if (mus_is_formant(fg))
- gens[j++] = fg;
- }
- }
- if (j > 0)
- ge = mus_make_formant_bank(j, gens, (v) ? mus_vct_data(v) : NULL);
- free(gens);
-
- if (ge)
- {
- if (v)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, frms, amps)));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, frms)));
- }
- return(Xen_false);
- }
-
-
- static Xen g_is_formant_bank(Xen os)
- {
- #define H_is_formant_bank "(" S_is_formant_bank " gen): " PROC_TRUE " if gen is a " S_formant_bank
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant_bank(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_formant_bank(Xen gens, Xen inp)
- {
- #define H_formant_bank "(" S_formant_bank " gens inval): sum a bank of " S_formant " generators"
- mus_any *bank = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gens, gn, bank, mus_is_formant_bank, S_formant_bank, "a formant-bank generator");
- if (mus_is_vct(inp))
- return(C_double_to_Xen_real(mus_formant_bank_with_inputs(bank, mus_vct_data(Xen_to_vct(inp)))));
-
- if (Xen_is_number(inp))
- return(C_double_to_Xen_real(mus_formant_bank(bank, Xen_real_to_C_double(inp))));
-
- if (!Xen_is_bound(inp))
- return(C_double_to_Xen_real(mus_formant_bank(bank, 0.0)));
-
- Xen_check_type(false, inp, 2, S_formant_bank, "a number or a " S_vct);
- return(Xen_false);
- }
-
-
-
-
- /* ---------------- one-pole-all-pass ---------------- */
-
- static Xen g_make_one_pole_all_pass(Xen arg1, Xen arg2)
- {
- #define H_make_one_pole_all_pass "(" S_make_one_pole_all_pass " size coeff): return a new one-pole-all-pass generator."
-
- mus_any *ge = NULL;
- int size;
- mus_float_t coeff;
-
- Xen_check_type(Xen_is_integer(arg1), arg1, 1, S_make_one_pole_all_pass, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(arg2), arg2, 2, S_make_one_pole_all_pass, "a number");
- #endif
-
- size = Xen_integer_to_C_int(arg1);
- if (size < 0)
- Xen_out_of_range_error(S_make_one_pole_all_pass, 1, arg1, "size < 0?");
- if (size == 0) return(Xen_false);
- coeff = Xen_real_to_C_double(arg2);
-
- ge = mus_make_one_pole_all_pass(size, coeff);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_is_one_pole_all_pass(Xen os)
- {
- #define H_is_one_pole_all_pass "(" S_is_one_pole_all_pass " gen): " PROC_TRUE " if gen is a " S_one_pole_all_pass
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_one_pole_all_pass(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_one_pole_all_pass(Xen gen, Xen fm)
- {
- #define H_one_pole_all_pass "(" S_one_pole_all_pass " gen (input 0.0)): run a one-pole-all-pass generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_one_pole_all_pass, S_one_pole_all_pass, "a one-pole-all-pass generator");
- Xen_real_to_C_double_if_bound(fm, in1, S_one_pole_all_pass, 2);
- return(C_double_to_Xen_real(mus_one_pole_all_pass(g, in1)));
- }
-
-
-
-
- /* ---------------- firmant ---------------- */
-
- static Xen g_make_firmant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_firmant "(" S_make_firmant " frequency radius): \
- return a new firmant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
- frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(false, S_make_firmant, arg1, arg2, arg3, arg4));
- }
-
-
- static Xen g_is_firmant(Xen os)
- {
- #define H_is_firmant "(" S_is_firmant " gen): " PROC_TRUE " if gen is a " S_firmant " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_firmant(Xen_to_mus_any(os)))));
- }
-
-
- static Xen g_firmant(Xen gen, Xen input, Xen freq)
- {
- #define H_firmant "(" S_firmant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
- mus_float_t in1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(gen, gn, g, mus_is_firmant, S_firmant, "a firmant generator");
-
- Xen_real_to_C_double_if_bound(input, in1, S_firmant, 2);
- if (Xen_is_bound(freq))
- return(C_double_to_Xen_real(mus_firmant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
-
- return(C_double_to_Xen_real(mus_firmant(g, in1)));
- }
-
-
- static mus_float_t mus_pink_noise(vct *v)
- {
- int i, size;
- mus_float_t sum = 0.0, amp, x;
- mus_float_t *data;
-
- size = mus_vct_length(v);
- data = mus_vct_data(v);
- amp = data[0];
-
- for (i = 2, x = 0.5; i < size; i += 2, x *= 0.5)
- {
- sum += data[i];
- data[i + 1] -= x;
- if (data[i + 1] < 0.0)
- {
- data[i] = mus_random(amp);
- data[i + 1] += 1.0;
- }
- }
- return(sum + mus_random(amp));
- }
-
- #define S_pink_noise "pink-noise"
- static Xen g_pink_noise(Xen gens)
- {
- #define H_pink_noise "(pink-noise gens) generates an approximation to pink noise."
- int size;
- vct *v;
-
- Xen_check_type((mus_is_vct(gens)) && (Xen_vector_rank(gens) == 1), gens, 1, S_pink_noise, "a " S_vct);
- v = Xen_to_vct(gens);
- size = mus_vct_length(v);
- if (size == 0)
- return(XEN_ZERO); /* needs to be upper case for Forth/Ruby */
- Xen_check_type((size & 1) == 0, gens, 1, S_pink_noise, "an even length " S_vct);
-
- return(C_double_to_Xen_real(mus_pink_noise(v)));
- }
-
- #if HAVE_SCHEME
- static s7_double piano_noise(s7_int *g, s7_double noi)
- {
- g[0] = ((g[0] * 1103515245) + 12345) & 0xffffffff;
- noi *= (((s7_double)g[0] * 4.6566128730774e-10) - 1.0);
- return(noi);
- }
-
- #define S_piano_noise "piano-noise"
- static Xen g_piano_noise(Xen gen, XEN amp)
- {
- #define H_piano_noise "(piano-noise gen amp) generates the noise used in the piano instrument."
-
- if (!s7_is_int_vector(gen)) s7_wrong_type_arg_error(s7, S_piano_noise, 1, gen, "an int-vector");
- if (!s7_is_real(amp)) s7_wrong_type_arg_error(s7, S_piano_noise, 2, amp, "a real");
-
- return(C_double_to_Xen_real(piano_noise(s7_int_vector_elements(gen), Xen_real_to_C_double(amp))));
- }
-
-
- #define S_singer_filter "singer-filter"
- static Xen g_singer_filter(Xen start, Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
- {
- #define H_singer_filter "this is an optimization for the singer instrument"
- int j, k, beg, lim;
- s7_double *d1, *d2, *cf;
- s7_double temp;
-
- if (!s7_is_integer(start)) s7_wrong_type_arg_error(s7, S_singer_filter, 1, start, "an integer");
- if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_filter, 2, end, "an integer");
- if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_filter, 3, tmp, "a real");
- if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_filter, 4, dline1, "a float-vector");
- if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_filter, 5, dline2, "a float-vector");
- if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_filter, 6, coeffs, "a float-vector");
-
- beg = s7_integer(start);
- lim = s7_integer(end);
- d1 = s7_float_vector_elements(dline1);
- d2 = s7_float_vector_elements(dline2);
- cf = s7_float_vector_elements(coeffs);
- temp = s7_number_to_real(s7, tmp);
-
- for (k = beg, j = beg + 1; j < lim; k++, j++)
- {
- s7_double temp1, x;
- x = d2[j + 1];
- d2[j] = x + (cf[j] * (d1[k] - x));
- temp1 = temp;
- temp = d1[k] + d2[j] - x;
- d1[k] = temp1;
- }
- return(s7_make_real(s7, temp));
- }
-
-
- #define S_singer_nose_filter "singer-nose-filter"
- static Xen g_singer_nose_filter(Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
- {
- #define H_singer_nose_filter "this is an optimization for the singer instrument"
- int j, k, lim;
- s7_double *d1, *d2, *cf;
- s7_double temp;
-
- if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 1, end, "an integer");
- if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 2, tmp, "a real");
- if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 3, dline1, "a float-vector");
- if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 4, dline2, "a float-vector");
- if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 5, coeffs, "a float-vector");
-
- lim = s7_integer(end);
- d1 = s7_float_vector_elements(dline1);
- d2 = s7_float_vector_elements(dline2);
- cf = s7_float_vector_elements(coeffs);
- temp = s7_number_to_real(s7, tmp);
-
- for (k = 1, j = 2; j < lim; k++, j++)
- {
- s7_double t1, reftemp;
- reftemp = cf[j] * (d1[k] - d2[j + 1]);
- d2[j] = d2[j + 1] + reftemp;
- t1 = temp;
- temp = d1[k] + reftemp;
- d1[k] = t1;
- }
-
- return(s7_make_real(s7, temp));
- }
-
- #endif
-
-
-
- /* ---------------- wave-train ---------------- */
-
- static Xen g_make_wave_train(Xen arglist)
- {
- #define H_make_wave_train "(" S_make_wave_train " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
- return a new wave-train generator (an extension of pulse-train). Frequency is \
- the repetition rate of the wave found in wave. Successive waves can overlap."
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
- int vals;
- mus_long_t wsize = clm_table_size;
- Xen orig_v = Xen_false;
- mus_float_t freq, phase = 0.0;
- mus_float_t *wave = NULL;
- int interp_type = (int)MUS_INTERP_LINEAR;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_wave;
- keys[3] = kw_size;
- keys[4] = kw_type;
-
- {
- Xen p;
- int i, arglist_len;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_wave_train, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_wave_train, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_wave_train, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq > srate/2?");
- if (freq < 0.0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq < 0.0?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_wave_train, orig_arg[1], phase);
- if (phase < 0.0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[1], keys[1], "phase < 0.0?");
-
- v = mus_optkey_to_vct(keys[2], S_make_wave_train, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- wave = mus_vct_data(v);
- wsize = mus_vct_length(v);
- }
-
- wsize = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_wave_train, orig_arg[3], wsize);
- if (wsize <= 0)
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size <= 0?");
- if (wsize > mus_max_table_size())
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
- if ((v) && (wsize > mus_vct_length(v)))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "table size > wave size");
-
- interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_wave_train, orig_arg[4], interp_type);
- if (!(mus_is_interp_type(interp_type)))
- Xen_out_of_range_error(S_make_wave_train, orig_arg[4], keys[4], "no such interp-type");
- }
-
- if (wave == NULL)
- {
- wave = (mus_float_t *)calloc(wsize, sizeof(mus_float_t));
- if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave-train table", S_make_wave_train));
- orig_v = xen_make_vct(wsize, wave);
- }
- ge = mus_make_wave_train(freq, phase, wave, wsize, (mus_interp_t)interp_type);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- }
-
-
- static Xen g_wave_train(Xen obj, Xen fm)
- {
- #define H_wave_train "(" S_wave_train " gen (fm 0.0)): next sample of " S_wave_train
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_wave_train, S_wave_train, "a wave-train generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_wave_train, 2);
-
- return(C_double_to_Xen_real(mus_wave_train(g, fm1)));
- }
-
-
- static Xen g_is_wave_train(Xen obj)
- {
- #define H_is_wave_train "(" S_is_wave_train " gen): " PROC_TRUE " if gen is a " S_wave_train
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_wave_train(Xen_to_mus_any(obj)))));
- }
-
-
-
- /* ---------------- waveshaping ---------------- */
-
- enum {NO_PROBLEM_IN_LIST, NULL_LIST, ODD_LENGTH_LIST, NON_NUMBER_IN_LIST, NEGATIVE_NUMBER_IN_LIST, HUGE_NUMBER_IN_LIST};
-
- static const char *list_to_partials_error_to_string(int code)
- {
- switch (code)
- {
- case NO_PROBLEM_IN_LIST: return("~A: nothing wrong with partials list?? ~A"); break;
- case NULL_LIST: return("~A: partials list is null, ~A"); break;
- case ODD_LENGTH_LIST: return("~A: partials list has an odd number of elements: ~A"); break;
- case NON_NUMBER_IN_LIST: return("~A: partials list has a non-numerical element: ~A"); break;
- case NEGATIVE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is negative: ~A"); break;
- case HUGE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is too large: ~A"); break;
- }
- return("~A: unknown error, ~A");
- }
-
-
- static mus_float_t *list_to_partials(Xen harms, int *npartials, int *error_code)
- {
- int listlen, i, maxpartial = 0, curpartial;
- mus_float_t *partials = NULL;
- Xen lst;
-
- listlen = Xen_list_length(harms);
- if (listlen == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
-
- if (listlen & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
-
- if (!(Xen_is_number(Xen_car(harms))))
- {
- (*error_code) = NON_NUMBER_IN_LIST;
- return(NULL);
- }
- /* the list is '(partial-number partial-amp ... ) */
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
- {
- if ((!(Xen_is_integer(Xen_car(lst)))) ||
- (!(Xen_is_number(Xen_cadr(lst)))))
- {
- (*error_code) = NON_NUMBER_IN_LIST;
- return(NULL);
- }
- curpartial = Xen_integer_to_C_int(Xen_car(lst));
- if (curpartial < 0)
- {
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- return(NULL);
- }
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- }
-
- if (maxpartial > 10000000)
- {
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- return(NULL);
- }
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- /* here and elsewhere? this won't be null until we touch it in linux, but that gloms up all our
- * code with once-in-a-billion-years error checks.
- */
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
- {
- curpartial = Xen_integer_to_C_int(Xen_car(lst));
- partials[curpartial] = (mus_float_t)Xen_real_to_C_double(Xen_cadr(lst));
- }
- return(partials);
- }
-
-
- static mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
- {
- int len, i, maxpartial, curpartial;
- mus_float_t *partials = NULL, *vdata;
-
- len = mus_vct_length(v);
- if (len == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
- if (len & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- vdata = mus_vct_data(v);
- maxpartial = (int)(vdata[0]);
- if (maxpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- else
- {
- for (i = 2; i < len; i += 2)
- {
- curpartial = (int)(vdata[i]);
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- if (curpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- }
- }
- if ((*error_code) != NO_PROBLEM_IN_LIST)
- return(NULL);
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0; i < len; i += 2)
- {
- curpartial = (int)(vdata[i]);
- partials[curpartial] = vdata[i + 1];
- }
- return(partials);
- }
-
-
- static mus_float_t *mus_vector_to_partials(Xen v, int *npartials, int *error_code)
- {
- int len, i, maxpartial, curpartial;
- mus_float_t *partials = NULL;
-
- len = Xen_vector_length(v);
- if (len == 0)
- {
- (*error_code) = NULL_LIST;
- return(NULL);
- }
- if (len & 1)
- {
- (*error_code) = ODD_LENGTH_LIST;
- return(NULL);
- }
- (*error_code) = NO_PROBLEM_IN_LIST;
-
- maxpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, 0)));
- if (maxpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- else
- {
- for (i = 2; i < len; i += 2)
- {
- curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
- if (curpartial > maxpartial)
- maxpartial = curpartial;
- if (curpartial < 0)
- (*error_code) = NEGATIVE_NUMBER_IN_LIST;
- }
- }
- if ((*error_code) != NO_PROBLEM_IN_LIST)
- return(NULL);
-
- partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
- if (partials == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
- (*npartials) = maxpartial + 1;
-
- for (i = 0; i < len; i += 2)
- {
- curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
- partials[curpartial] = Xen_real_to_C_double(Xen_vector_ref(v, i + 1));
- }
- return(partials);
- }
-
-
- static Xen g_partials_to_polynomial(Xen amps, Xen ukind)
- {
- #if HAVE_SCHEME
- #define p2p_example "(let ((v0 (partials->polynomial '(1 1.0 2 1.0)))\n (os (make-oscil)))\n (polynomial v0 (oscil os)))"
- #endif
- #if HAVE_RUBY
- #define p2p_example "v0 = partials2polynomial([1, 1.0, 2, 1.0])\n os = make_oscil()\n polynomial(v0, oscil(os))"
- #endif
- #if HAVE_FORTH
- #define p2p_example "'( 1 1.0 2 1.0 ) partials->polynomial value v0\n make-oscil value os\n v0 os 0.0 0.0 oscil polynomial"
- #endif
-
- #define H_partials_to_polynomial "(" S_partials_to_polynomial " partials (kind " S_mus_chebyshev_first_kind ")): \
- produce a Chebyshev polynomial suitable for use with the " S_polynomial " generator \
- to create (via waveshaping) the harmonic spectrum described by the partials argument:\n " p2p_example
-
- int npartials = 0;
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- mus_float_t *partials = NULL, *wave;
- int error = NO_PROBLEM_IN_LIST;
-
- Xen_check_type(mus_is_vct(amps) || Xen_is_list(amps), amps, 1, S_partials_to_polynomial, "a list or a " S_vct);
- Xen_check_type(Xen_is_integer_or_unbound(ukind), ukind, 2, S_partials_to_polynomial, "either " S_mus_chebyshev_first_kind " or " S_mus_chebyshev_second_kind);
-
- if (Xen_is_integer(ukind))
- {
- int ck;
- ck = Xen_integer_to_C_int(ukind);
- if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
- kind = (mus_polynomial_t)ck;
- else Xen_out_of_range_error(S_partials_to_polynomial, 2, ukind, "unknown Chebyshev polynomial kind");
- }
-
- if (mus_is_vct(amps))
- partials = mus_vct_to_partials(Xen_to_vct(amps), &npartials, &error);
- else partials = list_to_partials(amps, &npartials, &error);
-
- if (partials == NULL)
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_partials_to_polynomial),
- amps));
-
- wave = mus_partials_to_polynomial(npartials, partials, kind); /* wave == partials; in both vct and list cases, partials is newly allocated */
- return(xen_make_vct(npartials, wave));
- }
-
-
- static Xen g_normalize_partials(Xen partials)
- {
- #define H_normalize_partials "(" S_normalize_partials " partials) scales the \
- partial amplitudes in the " S_vct " or list 'partials' by the inverse of their sum (so that they add to 1.0)."
-
- vct *v;
- Xen xv = Xen_false;
-
- Xen_check_type(((Xen_is_list(partials)) && (!Xen_is_null(partials))) || (mus_is_vct(partials)), partials, 1, S_normalize_partials, "a " S_vct " or (non-empty) list");
-
- if (mus_is_vct(partials))
- xv = partials;
- else xv = xen_list_to_vct(partials);
- v = Xen_to_vct(xv);
-
- if ((mus_vct_length(v) > 1) &&
- ((mus_vct_length(v) & 1) == 0))
- mus_normalize_partials(mus_vct_length(v) / 2, mus_vct_data(v));
- else Xen_error(BAD_TYPE,
- Xen_list_3(C_string_to_Xen_string("~A: partials, ~A, must be a non-empty list or " S_vct " of even length (partial-number partial-amp ...)"),
- C_string_to_Xen_string(S_normalize_partials),
- partials));
- return(xv);
- }
-
-
- static mus_float_t *vector_to_float_array(Xen v)
- {
- mus_float_t *data;
- mus_long_t i, len;
- len = Xen_vector_length(v);
- data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- for (i = 0; i < len; i++)
- data[i] = Xen_real_to_C_double(Xen_vector_ref(v, i));
- return(data);
- }
-
- static Xen g_chebyshev_tu_sum(Xen x, Xen tn, Xen un)
- {
- #define H_chebyshev_tu_sum "(" S_mus_chebyshev_tu_sum " x tn un) returns the sum of the weighted\
- Chebyshev polynomials Tn and Un (vectors or " S_vct "s), with phase x."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *tdata = NULL, *udata = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_tu_sum, "a float");
-
- if ((mus_is_vct(tn)) &&
- (mus_is_vct(un)))
- {
- vct *Tn, *Un;
- Tn = Xen_to_vct(tn);
- tdata = mus_vct_data(Tn);
- Un = Xen_to_vct(un);
- udata = mus_vct_data(Un);
- len = mus_vct_length(Tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len != mus_vct_length(Un)) return(C_double_to_Xen_real(0.0));
- }
- else
- {
- if ((Xen_is_vector(tn)) &&
- (Xen_is_vector(un)))
- {
- len = Xen_vector_length(tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- if (len != Xen_vector_length(un)) return(C_double_to_Xen_real(0.0));
- tdata = vector_to_float_array(tn);
- udata = vector_to_float_array(un);
- need_free = true;
- }
- else
- {
- Xen_check_type(false, tn, 1, S_mus_chebyshev_tu_sum, "both arrays should be either " S_vct "s or vectors");
- }
- }
-
- result = C_double_to_Xen_real(mus_chebyshev_tu_sum(Xen_real_to_C_double(x), len, tdata, udata));
- if (need_free)
- {
- free(tdata);
- free(udata);
- }
-
- return(result);
- }
-
-
- static Xen g_chebyshev_t_sum(Xen x, Xen tn)
- {
- #define H_chebyshev_t_sum "(" S_mus_chebyshev_t_sum " x tn) returns the sum of the weighted \
- Chebyshev polynomials Tn (a " S_vct ")."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *data = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_t_sum, "a float");
- if (mus_is_vct(tn))
- {
- vct *Tn;
- Tn = Xen_to_vct(tn);
- data = mus_vct_data(Tn);
- len = mus_vct_length(Tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- }
- else
- {
- if (Xen_is_vector(tn))
- {
- len = Xen_vector_length(tn);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = vector_to_float_array(tn);
- need_free = true;
- }
- else Xen_check_type(false, tn, 1, S_mus_chebyshev_t_sum, "a " S_vct " or a vector");
- }
- result = C_double_to_Xen_real(mus_chebyshev_t_sum(Xen_real_to_C_double(x), len, data));
- if (need_free)
- free(data);
- return(result);
- }
-
-
- static Xen g_chebyshev_u_sum(Xen x, Xen un)
- {
- #define H_chebyshev_u_sum "(" S_mus_chebyshev_u_sum " x un) returns the sum of the weighted \
- Chebyshev polynomials Un (a " S_vct ")."
-
- bool need_free = false;
- int len = 0;
- mus_float_t *data = NULL;
- Xen result;
-
- Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_u_sum, "a float");
-
- if (mus_is_vct(un))
- {
- vct *Un;
- Un = Xen_to_vct(un);
- len = mus_vct_length(Un);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = mus_vct_data(Un);
- }
- else
- {
- if (Xen_is_vector(un))
- {
- len = Xen_vector_length(un);
- if (len == 0) return(C_double_to_Xen_real(0.0));
- data = vector_to_float_array(un);
- need_free = true;
- }
- else Xen_check_type(false, un, 1, S_mus_chebyshev_u_sum, "a " S_vct " or a vector");
- }
- result = C_double_to_Xen_real(mus_chebyshev_u_sum(Xen_real_to_C_double(x), len, data));
- if (need_free)
- free(data);
- return(result);
- }
-
-
-
-
- /* ---------------- polyshape ---------------- */
-
- static Xen g_polyshape(Xen obj, Xen index, Xen fm)
- {
- #define H_polyshape "(" S_polyshape " gen (index 1.0) (fm 0.0)): next sample of polynomial-based waveshaper"
- mus_float_t fm1 = 0.0, index1 = 1.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_polyshape, S_polyshape, "a polyshape generator");
- Xen_real_to_C_double_if_bound(index, index1, S_polyshape, 2);
- Xen_real_to_C_double_if_bound(fm, fm1, S_polyshape, 3);
-
- return(C_double_to_Xen_real(mus_polyshape(g, index1, fm1)));
- }
-
-
- static Xen g_is_polyshape(Xen obj)
- {
- #define H_is_polyshape "(" S_is_polyshape " gen): " PROC_TRUE " if gen is a " S_polyshape
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polyshape(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_polyshape(Xen arglist)
- {
- #define H_make_polyshape "(" S_make_polyshape " (frequency *clm-default-frequency*) (initial-phase 0.0) (coeffs) (partials '(1 1)) (kind " S_mus_chebyshev_first_kind ")): \
- return a new polynomial-based waveshaping generator:\n\
- (" S_make_polyshape " :coeffs (" S_partials_to_polynomial " '(1 1.0)))\n\
- is the same in effect as " S_make_oscil
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, csize = 0, npartials = 0;
- Xen orig_v = Xen_false;
- mus_float_t freq, phase = 0.0;
- /*
- * if we followed the definition directly, the initial phase default would be M_PI_2 (pi/2) so that
- * we drive the Tn's with a cosine. But I've always used sine instead, so I think I'll leave
- * it that way. There is no difference in the output waveform except an overall phase
- * offset. So, with sine, the phases rotate through cos sin -cos -sin... rather than being all cos,
- * but these add to exactly the same actual wave -- what you'd expect since Tn doesn't know
- * where we started. This also does not affect "signification".
- */
- mus_float_t *coeffs = NULL;
-
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
- keys[2] = kw_coeffs;
- keys[3] = kw_partials;
- keys[4] = kw_kind;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_polyshape, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_polyshape, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v = NULL;
- int ck;
-
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polyshape, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_polyshape, orig_arg[0], keys[0], "freq > srate/2?");
-
- phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_polyshape, orig_arg[2], phase);
-
- ck = Xen_optkey_to_int(kw_kind, keys[4], S_make_polyshape, orig_arg[4], (int)kind);
- if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
- kind = (mus_polynomial_t)ck;
- else Xen_out_of_range_error(S_make_polyshape, orig_arg[4], keys[4], "unknown Chebyshev polynomial kind");
-
- v = mus_optkey_to_vct(keys[2], S_make_polyshape, orig_arg[2], NULL);
- if (v)
- {
- orig_v = keys[2];
- coeffs = mus_vct_data(v);
- csize = mus_vct_length(v);
- }
- else
- {
- if (!(Xen_is_keyword(keys[3])))
- {
- mus_float_t *partials = NULL;
- int error = NO_PROBLEM_IN_LIST;
- if (mus_is_vct(keys[3]))
- partials = mus_vct_to_partials(Xen_to_vct(keys[3]), &npartials, &error);
- else
- {
- Xen_check_type(Xen_is_list(keys[3]), keys[3], orig_arg[3], S_make_polyshape, "a list or a " S_vct);
- partials = list_to_partials(keys[3], &npartials, &error);
- }
- if (partials == NULL)
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_make_polyshape),
- keys[3]));
- coeffs = mus_partials_to_polynomial(npartials, partials, kind);
- csize = npartials;
- /* coeffs = partials here, so don't delete */
- }
- }
- }
-
- if (!coeffs)
- {
- /* clm.html says '(1 1) is the default */
- mus_float_t *data;
- data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
- data[0] = 0.0;
- data[1] = 1.0;
- coeffs = mus_partials_to_polynomial(2, data, kind);
- csize = 2;
- }
-
- if (Xen_is_false(orig_v))
- orig_v = xen_make_vct(csize, coeffs);
-
- ge = mus_make_polyshape(freq, phase, coeffs, csize, kind);
- if (ge)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(Xen_false);
- }
-
-
-
- /* ---------------- polywave ---------------- */
-
- static Xen g_polywave(Xen obj, Xen fm)
- {
- #define H_polywave "(" S_polywave " gen (fm 0.0)): next sample of polywave waveshaper"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_polywave, S_polywave, "a polywave generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_polywave, 3);
-
- return(C_double_to_Xen_real(mus_polywave(g, fm1)));
- }
-
-
- static Xen g_is_polywave(Xen obj)
- {
- #define H_is_polywave "(" S_is_polywave " gen): " PROC_TRUE " if gen is a " S_polywave " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polywave(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_polywave(Xen arglist)
- {
- #define H_make_polywave "(" S_make_polywave " (frequency *clm-default-frequency*) (partials '(1 1)) (type " S_mus_chebyshev_first_kind ") xcoeffs ycoeffs): \
- return a new polynomial-based waveshaping generator. (" S_make_polywave " :partials (float-vector 1 1.0)) is the same in effect as " S_make_oscil "."
-
- mus_any *ge;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, n = 0, npartials = 0;
- Xen orig_x = Xen_false, orig_y = Xen_false;
- mus_float_t freq;
- mus_float_t *xcoeffs = NULL, *ycoeffs = NULL, *partials = NULL;
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- int error = NO_PROBLEM_IN_LIST;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_partials;
- keys[2] = kw_type;
- keys[3] = kw_x_coeffs;
- keys[4] = kw_y_coeffs;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_polywave, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_polywave, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- vct *v;
- int type;
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polywave, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_polywave, orig_arg[0], keys[0], "freq > srate/2?");
-
- type = Xen_optkey_to_int(kw_type, keys[2], S_make_polywave, orig_arg[2], (int)kind);
- if ((type >= MUS_CHEBYSHEV_EITHER_KIND) &&
- (type <= MUS_CHEBYSHEV_BOTH_KINDS))
- kind = (mus_polynomial_t)type;
- else Xen_out_of_range_error(S_make_polywave, orig_arg[2], keys[2], "unknown Chebyshev polynomial kind");
-
- if (!(Xen_is_keyword(keys[1]))) /* partials were supplied */
- {
- if (mus_is_vct(keys[1]))
- partials = mus_vct_to_partials(Xen_to_vct(keys[1]), &npartials, &error);
- else
- {
- if (Xen_is_vector(keys[1]))
- partials = mus_vector_to_partials(keys[1], &npartials, &error);
- else
- {
- Xen_check_type(Xen_is_list(keys[1]), keys[1], orig_arg[1], S_make_polywave, "a list or a " S_vct);
- partials = list_to_partials(keys[1], &npartials, &error);
- }
- }
- if (partials == NULL) /* here if null, something went wrong in the translation functions */
- Xen_error(NO_DATA,
- Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
- C_string_to_Xen_string(S_make_polywave),
- keys[1]));
-
- xcoeffs = partials;
- n = npartials;
- orig_x = xen_make_vct(n, xcoeffs);
- /* xcoeffs = partials here, so don't delete */
- }
-
- if (!(Xen_is_keyword(keys[3])))
- {
- Xen_check_type(mus_is_vct(keys[3]), keys[3], orig_arg[3], S_make_polywave, "a " S_vct);
- orig_x = keys[3];
- v = Xen_to_vct(orig_x);
- n = mus_vct_length(v);
- xcoeffs = mus_vct_data(v);
- }
-
- if (!(Xen_is_keyword(keys[4])))
- {
- /* make-polyoid in generators.scm */
- int yn;
- Xen_check_type(mus_is_vct(keys[4]), keys[4], orig_arg[4], S_make_polywave, "a " S_vct);
- orig_y = keys[4];
- v = Xen_to_vct(orig_y);
- yn = mus_vct_length(v);
- if ((n == 0) || (yn < n))
- n = yn;
- ycoeffs = mus_vct_data(v);
- }
- }
-
- if (!xcoeffs)
- {
- /* clm.html says '(1 1) is the default but table-lookup is 0? */
- mus_float_t *data;
- data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
- data[0] = 0.0;
- data[1] = 1.0;
- xcoeffs = data;
- n = 2;
- orig_x = xen_make_vct(n, xcoeffs);
- }
-
- if (ycoeffs)
- {
- ge = mus_make_polywave_tu(freq, xcoeffs, ycoeffs, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_x, orig_y)));
- }
- ge = mus_make_polywave(freq, xcoeffs, n, kind);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_x)));
- return(Xen_false);
- }
-
-
- /* ---------------- nrxysin and nrxycos ---------------- */
-
- static Xen g_is_nrxysin(Xen obj)
- {
- #define H_is_nrxysin "(" S_is_nrxysin " gen): " PROC_TRUE " if gen is an " S_nrxysin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nrxysin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_nrxycos(Xen obj)
- {
- #define H_is_nrxycos "(" S_is_nrxycos " gen): " PROC_TRUE " if gen is an " S_nrxycos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_nrxycos(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_nrxysin(Xen obj, Xen fm)
- {
- #define H_nrxysin "(" S_nrxysin " gen (fm 0.0)): next sample of nrxysin generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nrxysin, S_nrxysin, "an nrxysin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nrxysin, 2);
-
- return(C_double_to_Xen_real(mus_nrxysin(g, fm1)));
- }
-
- static Xen g_nrxycos(Xen obj, Xen fm)
- {
- #define H_nrxycos "(" S_nrxycos " gen (fm 0.0)): next sample of nrxycos generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_nrxycos, S_nrxycos, "an nrxycos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_nrxycos, 2);
-
- return(C_double_to_Xen_real(mus_nrxycos(g, fm1)));
- }
-
-
- static Xen g_make_nrxy(bool sin_case, const char *caller, Xen arglist)
- {
- mus_any *ge;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- int vals;
- mus_float_t freq, r = 0.5, ratio = 1.0;
- int n = 1;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_ratio;
- keys[2] = kw_n;
- keys[3] = kw_r;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 8; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
-
- n = Xen_optkey_to_int(kw_n, keys[2], caller, orig_arg[2], n);
- if (n < 0)
- Xen_out_of_range_error(caller, orig_arg[2], keys[2], "n (sidebands) < 0?");
-
- r = Xen_optkey_to_float(kw_r, keys[3], caller, orig_arg[3], r);
- if ((r >= 1.0) ||
- (r <= -1.0))
- Xen_out_of_range_error(caller, orig_arg[3], keys[3], "r (sideband amp ratio) not within -1.0 to 1.0?");
- /* if not with doubles, this actually maxes out around .99999999 because mus_optkey_to_float (apparently) rounds up */
- }
- if (sin_case)
- ge = mus_make_nrxysin(freq, ratio, n, r);
- else ge = mus_make_nrxycos(freq, ratio, n, r);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_nrxysin(Xen arglist)
- {
- #define H_make_nrxysin "(" S_make_nrxysin " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
- return a new nrxysin generator."
-
- return(g_make_nrxy(true, S_make_nrxysin, arglist));
- }
-
- static Xen g_make_nrxycos(Xen arglist)
- {
- #define H_make_nrxycos "(" S_make_nrxycos " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
- return a new nrxycos generator."
-
- return(g_make_nrxy(false, S_make_nrxycos, arglist));
- }
-
-
-
- /* ---------------- rxyksin and rxykcos ---------------- */
-
- static Xen g_is_rxyksin(Xen obj)
- {
- #define H_is_rxyksin "(" S_is_rxyksin " gen): " PROC_TRUE " if gen is an " S_rxyksin " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_rxyksin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_rxykcos(Xen obj)
- {
- #define H_is_rxykcos "(" S_is_rxykcos " gen): " PROC_TRUE " if gen is an " S_rxykcos " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
- (mus_is_rxykcos(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_rxyksin(Xen obj, Xen fm)
- {
- #define H_rxyksin "(" S_rxyksin " gen (fm 0.0)): next sample of rxyksin generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rxyksin, S_rxyksin, "an rxyksin generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rxyksin, 2);
-
- return(C_double_to_Xen_real(mus_rxyksin(g, fm1)));
- }
-
- static Xen g_rxykcos(Xen obj, Xen fm)
- {
- #define H_rxykcos "(" S_rxykcos " gen (fm 0.0)): next sample of rxykcos generator"
- mus_float_t fm1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_rxykcos, S_rxykcos, "an rxykcos generator");
- Xen_real_to_C_double_if_bound(fm, fm1, S_rxykcos, 2);
-
- return(C_double_to_Xen_real(mus_rxykcos(g, fm1)));
- }
-
-
- static Xen g_make_rxyk(bool sin_case, const char *caller, Xen arglist)
- {
- mus_any *ge;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- mus_float_t freq, r = 0.5, ratio = 1.0; /* original in generators.scm assumes initial-phase = 0.0 */
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_ratio;
- keys[2] = kw_r;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 6) clm_error(caller, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
-
- ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
- r = Xen_optkey_to_float(kw_r, keys[2], caller, orig_arg[2], r);
- }
- if (sin_case)
- ge = mus_make_rxyksin(freq, 0.0, r, ratio);
- else ge = mus_make_rxykcos(freq, 0.0, r, ratio);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_make_rxyksin(Xen arglist)
- {
- #define H_make_rxyksin "(" S_make_rxyksin " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
- return a new rxyksin generator."
-
- return(g_make_rxyk(true, S_make_rxyksin, arglist));
- }
-
- static Xen g_make_rxykcos(Xen arglist)
- {
- #define H_make_rxykcos "(" S_make_rxykcos " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
- return a new rxykcos generator."
-
- return(g_make_rxyk(false, S_make_rxykcos, arglist));
- }
-
-
-
- /* ---------------- filter ---------------- */
-
- typedef enum {G_FILTER, G_FIR_FILTER, G_IIR_FILTER} xclm_fir_t;
-
- static Xen g_make_fir_coeffs(Xen order, Xen envl)
- {
- #define H_make_fir_coeffs "(" S_make_fir_coeffs " order v): turn spectral envelope in " S_vct " v into coeffs for FIR filter"
- int size;
- mus_float_t *a;
- vct *v;
-
- Xen_check_type(Xen_is_integer(order), order, 1, S_make_fir_coeffs, "int");
- Xen_check_type(mus_is_vct(envl), envl, 2, S_make_fir_coeffs, "a " S_vct);
-
- v = Xen_to_vct(envl);
-
- size = Xen_integer_to_C_int(order);
- if (size != mus_vct_length(v))
- Xen_error(CLM_ERROR,
- Xen_list_3(C_string_to_Xen_string(S_make_fir_coeffs ": order ~A != " S_vct " length ~A"),
- order,
- envl));
-
- a = mus_make_fir_coeffs(Xen_integer_to_C_int(order), mus_vct_data(v), NULL);
- return(xen_make_vct(mus_vct_length(v), a));
- }
-
-
- static Xen g_is_filter(Xen obj)
- {
- #define H_is_filter "(" S_is_filter " gen): " PROC_TRUE " if gen is a " S_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_fir_filter(Xen obj)
- {
- #define H_is_fir_filter "(" S_is_fir_filter " gen): " PROC_TRUE " if gen is an " S_fir_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_fir_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_iir_filter(Xen obj)
- {
- #define H_is_iir_filter "(" S_is_iir_filter " gen): " PROC_TRUE " if gen is an " S_iir_filter
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_iir_filter(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_filter(Xen obj, Xen input)
- {
- #define H_filter "(" S_filter " gen (input 0.0)): next sample from filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_filter, S_filter, "a filter");
- Xen_real_to_C_double_if_bound(input, x, S_filter, 2);
-
- return(C_double_to_Xen_real(mus_filter(g, x)));
- }
-
-
- static Xen g_fir_filter(Xen obj, Xen input)
- {
- #define H_fir_filter "(" S_fir_filter " gen (input 0.0)): next sample from FIR filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_fir_filter, S_fir_filter, "an FIR filter");
- Xen_real_to_C_double_if_bound(input, x, S_fir_filter, 2);
-
- return(C_double_to_Xen_real(mus_fir_filter(g, x)));
- }
-
-
- static Xen g_iir_filter(Xen obj, Xen input)
- {
- #define H_iir_filter "(" S_iir_filter " gen (input 0.0)): next sample from IIR filter"
- mus_any *g = NULL;
- mus_xen *gn;
- mus_float_t x = 0.0;
-
- Xen_to_C_generator(obj, gn, g, mus_is_iir_filter, S_iir_filter, "an IIR filter");
- Xen_real_to_C_double_if_bound(input, x, S_iir_filter, 2);
-
- return(C_double_to_Xen_real(mus_iir_filter(g, x)));
- }
-
-
- static Xen g_make_filter_1(xclm_fir_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- Xen xwave = Xen_undefined, ywave = Xen_undefined;
- mus_any *fgen = NULL;
- Xen args[8];
- Xen keys[4];
- int orig_arg[4] = {0, 0, 0, 0};
- vct *x = NULL, *y = NULL;
- int vals, order = 0;
- const char *caller;
- if (choice == G_FILTER) caller = S_make_filter; else if (choice == G_FIR_FILTER) caller = S_make_fir_filter; else caller = S_make_iir_filter;
-
- keys[0] = kw_order;
- keys[1] = kw_x_coeffs;
- keys[2] = kw_y_coeffs;
- keys[3] = kw_coeffs;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = Xen_undefined; args[7] = Xen_undefined;
-
- vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
- if (vals > 0)
- {
- if (!(Xen_is_keyword(keys[0])))
- {
- order = Xen_optkey_to_int(kw_order, keys[0], caller, orig_arg[0], 0);
- if (order <= 0)
- Xen_out_of_range_error(caller, orig_arg[0], keys[0], "order <= 0?");
- }
-
- if (!(Xen_is_keyword(keys[1])))
- {
- Xen_check_type(mus_is_vct(keys[1]), keys[1], orig_arg[1], caller, "a " S_vct);
- if (choice == G_IIR_FILTER)
- {
- ywave = keys[1];
- y = Xen_to_vct(ywave);
- }
- else
- {
- xwave = keys[1];
- x = Xen_to_vct(xwave);
- }
- }
-
- if (!(Xen_is_keyword(keys[2])))
- {
- Xen_check_type(mus_is_vct(keys[2]), keys[2], orig_arg[2], caller, "a " S_vct);
- ywave = keys[2];
- y = Xen_to_vct(ywave);
- }
-
- if ((choice != G_FILTER) && (!(Xen_is_keyword(keys[3]))))
- {
- if (choice == G_IIR_FILTER)
- clm_error(caller, "redundant arg passed to " S_make_iir_filter "?", keys[3]);
- else clm_error(caller, "redundant arg passed to " S_make_fir_filter "?", keys[3]);
- }
- }
-
- if (choice == G_FILTER)
- {
- if (y == NULL)
- choice = G_FIR_FILTER;
- else
- {
- if (x == NULL)
- choice = G_IIR_FILTER;
- }
- }
- if (((x == NULL) && (choice != G_IIR_FILTER)) ||
- ((y == NULL) && (choice != G_FIR_FILTER)))
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string("~A: no coeffs?"),
- C_string_to_Xen_string(caller)));
- if (order == 0)
- {
- if (x)
- order = mus_vct_length(x);
- else order = mus_vct_length(y);
- }
- else
- {
- if ((x) && (order > mus_vct_length(x)))
- {
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: xcoeffs, ~A, must match order, ~A"),
- C_string_to_Xen_string(caller),
- keys[1],
- keys[0]));
- }
- else
- {
- if ((y) && (order > mus_vct_length(y)))
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: ycoeffs, ~A, must match order, ~A"),
- C_string_to_Xen_string(caller),
- keys[2],
- keys[0]));
- else
- {
- if ((x) && (y) && (mus_vct_length(x) != mus_vct_length(y)))
- Xen_error(CLM_ERROR,
- Xen_list_4(C_string_to_Xen_string("~A: coeffs must be same length. x len: ~A, y len: ~A"),
- C_string_to_Xen_string(caller),
- C_int_to_Xen_integer(mus_vct_length(x)),
- C_int_to_Xen_integer(mus_vct_length(y))));
- }
- }
- }
- switch (choice)
- {
- case G_FILTER: fgen = mus_make_filter(order, mus_vct_data(x), mus_vct_data(y), NULL); break;
- case G_FIR_FILTER: fgen = mus_make_fir_filter(order, mus_vct_data(x), NULL); break;
- case G_IIR_FILTER: fgen = mus_make_iir_filter(order, mus_vct_data(y), NULL); break;
- }
- if (fgen)
- {
- mus_xen *gn = NULL;
- gn = mx_alloc(3);
- gn->gen = fgen; /* delay gn allocation since make_filter can throw an error */
- gn->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(order, mus_data(fgen));
- gn->vcts[G_FILTER_XCOEFFS] = xwave;
- gn->vcts[G_FILTER_YCOEFFS] = ywave;
- return(mus_xen_to_object(gn));
- }
- return(Xen_false);
- }
-
-
- static Xen g_make_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_filter "(" S_make_filter " order xcoeffs ycoeffs): return a new direct form FIR/IIR filter, coeff args are " S_vct "s"
- return(g_make_filter_1(G_FILTER, arg1, arg2, arg3, arg4, arg5, arg6));
- }
-
-
- static Xen g_make_fir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_fir_filter "(" S_make_fir_filter " order xcoeffs): return a new FIR filter, xcoeffs a " S_vct
- return(g_make_filter_1(G_FIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
- }
-
-
- static Xen g_make_iir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_iir_filter "(" S_make_iir_filter " order ycoeffs): return a new IIR filter, ycoeffs a " S_vct
- return(g_make_filter_1(G_IIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
- }
-
-
-
-
- /* ---------------- env ---------------- */
-
- static Xen g_is_env(Xen obj)
- {
- #define H_is_env "(" S_is_env " gen): " PROC_TRUE " if gen is a " S_env
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_env(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_env(Xen obj)
- {
- #define H_env "(" S_env " gen): next sample from envelope generator"
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_env, S_env, "an env generator");
-
- return(C_double_to_Xen_real(mus_env(g)));
- }
-
-
- static Xen g_make_env(Xen arglist)
- {
- #define H_make_env "(" S_make_env " envelope (scaler 1.0) (duration) (offset 0.0) (base 1.0) (end) (length)): \
- return a new envelope generator. 'envelope' is a list, vector, or " S_vct " of break-point pairs. To create the envelope, \
- these points are offset by 'offset', scaled by 'scaler', and mapped over the time interval defined by \
- either 'duration' (seconds) or 'length' (samples). If 'base' is 1.0, the connecting segments \
- are linear, if 0.0 you get a step function, and anything else produces an exponential connecting segment."
-
- mus_any *ge;
- Xen args[14];
- Xen keys[7];
- int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, i;
- mus_float_t base = 1.0, scaler = 1.0, offset = 0.0, duration = 0.0;
- mus_long_t end = 0, dur = -1;
- int npts = 0;
- mus_float_t *brkpts = NULL;
- vct *v = NULL;
-
- keys[0] = kw_envelope;
- keys[1] = kw_scaler;
- keys[2] = kw_duration;
- keys[3] = kw_offset;
- keys[4] = kw_base;
- keys[5] = kw_end;
- keys[6] = kw_length;
-
- {
- int arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 14) clm_error(S_make_env, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_env, 7, keys, args, orig_arg);
- if (vals > 0)
- {
- scaler = Xen_optkey_to_float(kw_scaler, keys[1], S_make_env, orig_arg[1], 1.0);
-
- duration = Xen_optkey_to_float(kw_duration, keys[2], S_make_env, orig_arg[2], 0.0);
- if ((duration < 0.0) || ((duration == 0.0) && (!Xen_is_keyword(keys[2]))))
- Xen_out_of_range_error(S_make_env, orig_arg[2], keys[2], "duration <= 0.0?");
-
- offset = Xen_optkey_to_float(kw_offset, keys[3], S_make_env, orig_arg[3], 0.0);
-
- base = Xen_optkey_to_float(kw_base, keys[4], S_make_env, orig_arg[4], 1.0);
- if (base < 0.0)
- Xen_out_of_range_error(S_make_env, orig_arg[4], keys[4], "base < 0.0?");
-
- end = Xen_optkey_to_mus_long_t(kw_end, keys[5], S_make_env, orig_arg[5], 0);
- if (end < 0)
- Xen_out_of_range_error(S_make_env, orig_arg[5], keys[5], "end < 0?");
-
- dur = Xen_optkey_to_mus_long_t(kw_length, keys[6], S_make_env, orig_arg[6], 0);
- if (dur < 0)
- Xen_out_of_range_error(S_make_env, orig_arg[6], keys[6], "length < 0?");
-
- /* env data is a list, checked last to let the preceding throw wrong-type error before calloc */
- if (!(Xen_is_keyword(keys[0])))
- {
- int len;
- Xen vect = XEN_NULL;
- if (mus_is_vct(keys[0]))
- {
- v = Xen_to_vct(keys[0]);
- len = mus_vct_length(v);
- if ((len < 2) || (len & 1))
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": " S_vct " is a bogus breakpoints list, ~A"),
- keys[0]));
- }
- else
- {
- #if HAVE_SCHEME
- /* in Ruby and Forth vectors and lists are the same, so stay with the old code */
- if (Xen_is_vector(keys[0]))
- {
- vect = keys[0];
- len = Xen_vector_length(vect);
- if ((len < 2) || (len & 1))
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_make_env ": vector is a bogus breakpoints list, ~A"), vect));
- }
- else
- {
- #endif
- Xen_check_type(Xen_is_list(keys[0]), keys[0], orig_arg[0], S_make_env, "a list, vector, or " S_vct);
- len = Xen_list_length(keys[0]);
- if (len == 0)
- Xen_error(NO_DATA,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": null env? ~A"),
- keys[0]));
-
- if (Xen_is_list(Xen_car(keys[0])))
- len *= 2;
- else
- {
- if (len & 1)
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": odd length breakpoints list? ~A"),
- keys[0]));
-
- if (!(Xen_is_number(Xen_car(keys[0]))))
- Xen_check_type(false, keys[0], orig_arg[0], S_make_env, "a list of numbers (breakpoints)");
- }
- }
- #if HAVE_SCHEME
- }
- #endif
- npts = len / 2;
- if (v)
- brkpts = mus_vct_data(v);
- else
- {
- brkpts = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- if (brkpts == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate env list", S_make_env));
- if (vect)
- {
- for (i = 0; i < len; i++)
- brkpts[i] = Xen_real_to_C_double(Xen_vector_ref(vect, i));
- }
- else
- {
- Xen lst;
- if (Xen_is_number(Xen_car(keys[0])))
- {
- for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
- brkpts[i] = Xen_real_to_C_double(Xen_car(lst));
- }
- else
- {
- for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i += 2, lst = Xen_cdr(lst))
- {
- Xen el;
- el = Xen_car(lst);
- if ((Xen_is_pair(el)) &&
- (Xen_is_number(Xen_car(el))) &&
- (Xen_is_pair(Xen_cdr(el))) &&
- (Xen_is_number(Xen_cadr(el))))
- {
- brkpts[i] = Xen_real_to_C_double(Xen_car(el));
- brkpts[i + 1] = Xen_real_to_C_double(Xen_cadr(el));
- }
- else
- {
- Xen_error(BAD_TYPE,
- Xen_list_2(C_string_to_Xen_string(S_make_env ": odd breakpoints list? ~A"),
- keys[0]));
- }
- }
- }
- }
- }
- }
- }
-
- if (brkpts == NULL)
- {
- Xen_error(NO_DATA,
- Xen_list_1(C_string_to_Xen_string(S_make_env ": no envelope?")));
- }
-
- if (dur > 0)
- {
- if ((end > 0) && ((end + 1) != dur))
- {
- if ((!v) && (brkpts)) {free(brkpts); brkpts = NULL;}
- Xen_error(CLM_ERROR,
- Xen_list_3(C_string_to_Xen_string(S_make_env ": end, ~A, and dur, ~A, specified, but dur != end+1"),
- keys[5],
- keys[6]));
- }
- end = dur - 1;
- }
-
- /* (make-env '(0 1 1 0) :duration most-positive-fixnum) -> env linear, pass: 0 (dur: -9223372036854775808)...
- */
- if ((end <= 0) && (duration <= 0.0))
- Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration <= 0.0?");
- if (duration > (24 * 3600 * 365))
- Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration > year?");
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_env(brkpts, npts, scaler, offset, base, duration, end, NULL);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- if (v)
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, keys[0]))); /* in s7, keys[0] == v */
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, xen_make_vct(mus_env_breakpoints(ge) * 2, brkpts))));
- }
- return(clm_mus_error(local_error_type, local_error_msg, S_make_env));
- }
-
-
- static Xen g_env_interp(Xen x, Xen env1) /* "env" causes trouble in Objective-C!! */
- {
- #define H_env_interp "(" S_env_interp " x env): value of envelope env at x"
- Xen_check_type(Xen_is_number(x), x, 1, S_env_interp, "a number");
- Xen_check_type((mus_is_xen(env1)) && (mus_is_env(Xen_to_mus_any(env1))), env1, 2, S_env_interp, "an env generator");
- return(C_double_to_Xen_real(mus_env_interp(Xen_real_to_C_double(x), Xen_to_mus_any(env1))));
- }
-
-
-
- /* mus_env_any calls the C function itself, so we pass it connect_func,
- * connect_func uses the function passed as an argument to g_env_any.
- * I can't think of a cleaner way to handle this except via nested functions.
- * Both versions seem to work ok with recursive env-any calls.
- */
-
- static Xen current_connect_func;
-
- static mus_float_t connect_func(mus_float_t val)
- {
- return(Xen_real_to_C_double(Xen_call_with_1_arg(current_connect_func,
- C_double_to_Xen_real(val),
- S_env_any " connect function")));
- }
-
- static Xen g_env_any(Xen e, Xen func)
- {
- Xen val;
- Xen old_connect_func = Xen_false;
-
- #define H_env_any "(" S_env_any " e func) uses 'func' to connect the dots in the env 'e'"
- Xen_check_type((mus_is_xen(e)) && (mus_is_env(Xen_to_mus_any(e))), e, 1, S_env_any, "an env generator");
- Xen_check_type((Xen_is_procedure(func)) && (Xen_is_aritable(func, 1)), func, 2, S_env_any, "a function of one arg");
-
- old_connect_func = current_connect_func;
- current_connect_func = func;
- val = C_double_to_Xen_real(mus_env_any(Xen_to_mus_any(e), connect_func));
- current_connect_func = old_connect_func;
-
- return(val);
- }
-
-
-
- #define S_envelope_interp "envelope-interp"
-
- static Xen g_envelope_interp(Xen ux, Xen e, Xen ubase)
- {
- #define H_envelope_interp "(envelope-interp x e (base 1.0)) -> value of e at x; base controls connecting segment type: (envelope-interp .3 '(0 0 .5 1 1 0)) -> .6"
- mus_float_t x, base = 1.0, x0, y0, y1;
- Xen_check_type(Xen_is_number(ux), ux, 1, S_envelope_interp, "a number");
- Xen_check_type(Xen_is_list(e), e, 2, S_envelope_interp, "a list");
-
- if (Xen_is_null(e))
- return(Xen_integer_zero);
-
- x = Xen_real_to_C_double(ux);
- if (Xen_is_bound(ubase)) base = Xen_real_to_C_double(ubase);
- x0 = Xen_real_to_C_double(Xen_car(e));
-
- while (true)
- {
- mus_float_t x1;
- Xen ey;
- if (!Xen_is_pair(Xen_cdr(e)))
- Xen_check_type(false, e, 2, S_envelope_interp, "a list of breakpoint values");
- ey = Xen_cadr(e);
- if ((x <= x0) ||
- (!Xen_is_pair(Xen_cddr(e))))
- return(ey);
- x1 = Xen_real_to_C_double(Xen_caddr(e));
- if (x < x1)
- {
- if (base == 0.0)
- return(ey);
- y0 = Xen_real_to_C_double(ey);
- y1 = Xen_real_to_C_double(Xen_cadddr(e));
- if (y0 == y1)
- return(ey);
- if (base == 1.0)
- return(C_double_to_Xen_real(y0 + ((x - x0) * (y1 - y0) / (x1 - x0))));
- return(C_double_to_Xen_real(y0 + (((y1 - y0) / (base - 1.0)) * (pow(base, (x - x0) / (x1 - x0)) - 1.0))));
- }
- e = Xen_cddr(e);
- x0 = x1;
- }
- return(Xen_false);
- }
-
- /* -------------------------------- pulsed-env -------------------------------- */
-
- static Xen g_make_pulsed_env(Xen e, Xen dur, Xen frq)
- {
- #define H_make_pulsed_env "(" S_make_pulsed_env " envelope duration frequency) returns a pulsed-env generator."
- Xen gp, ge;
- mus_any *pl;
-
- gp = g_make_pulse_train(frq, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined);
- ge = g_make_env(Xen_list_3(e, C_double_to_Xen_real(1.0), dur));
-
- pl = mus_make_pulsed_env(Xen_to_mus_any(ge), Xen_to_mus_any(gp));
- return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(pl, ge, gp)));
- }
-
- static Xen g_is_pulsed_env(Xen os)
- {
- #define H_is_pulsed_env "(" S_is_pulsed_env " gen) returns " PROC_TRUE " if gen is a pulsed-env generator."
- return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_pulsed_env(Xen_to_mus_any(os)))));
- }
-
- static Xen g_pulsed_env(Xen g, Xen fm)
- {
- #define H_pulsed_env "(" S_pulsed_env " gen fm) runs a pulsed-env generator."
- mus_any *pl = NULL;
-
- Xen_check_type((mus_is_xen(g)) && (mus_is_pulsed_env(pl = Xen_to_mus_any(g))), g, 1, S_pulsed_env, "a pulsed-env object");
-
- if (Xen_is_number(fm))
- return(C_double_to_Xen_real(mus_pulsed_env(pl, Xen_real_to_C_double(fm))));
- return(C_double_to_Xen_real(mus_pulsed_env_unmodulated(pl)));
- }
-
-
-
-
- /* ---------------- io ---------------- */
-
- #if (!HAVE_RUBY)
- #define S_output "*output*"
- #define S_reverb "*reverb*"
- #else
- #define S_output "output"
- #define S_reverb "reverb"
- #endif
-
- static Xen clm_output, clm_reverb; /* *output* and *reverb* at extlang level -- these can be output streams, vct, sound-data objects etc */
-
- #if (HAVE_SCHEME)
- static Xen clm_output_slot = NULL, clm_reverb_slot = NULL;
-
- #define CLM_OUTPUT s7_slot_value(clm_output_slot)
- #define CLM_REVERB s7_slot_value(clm_reverb_slot)
-
- #else
-
- #define CLM_OUTPUT Xen_variable_ref(S_output)
- #define CLM_REVERB Xen_variable_ref(S_reverb)
-
- #endif
-
-
- static Xen g_is_mus_input(Xen obj)
- {
- #define H_is_mus_input "(" S_is_mus_input " gen): " PROC_TRUE " if gen is an input generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_mus_output(Xen obj)
- {
- #define H_is_mus_output "(" S_is_mus_output " gen): " PROC_TRUE " if gen is an output generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_output(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_file_to_sample(Xen obj)
- {
- #define H_is_file_to_sample "(" S_is_file_to_sample " gen): " PROC_TRUE " if gen is a " S_file_to_sample " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_sample(Xen_to_mus_any(obj)))));
- }
-
- static Xen mus_clm_output(void) {return(CLM_OUTPUT);}
- static Xen mus_clm_reverb(void) {return(CLM_REVERB);}
-
- static Xen g_is_file_to_frample(Xen obj)
- {
- #define H_is_file_to_frample "(" S_is_file_to_frample " gen): " PROC_TRUE " if gen is a " S_file_to_frample " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_frample(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_sample_to_file(Xen obj)
- {
- #define H_is_sample_to_file "(" S_is_sample_to_file " gen): " PROC_TRUE " if gen is a " S_sample_to_file " generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sample_to_file(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_is_frample_to_file(Xen obj)
- {
- #define H_is_frample_to_file "(" S_is_frample_to_file " gen): " PROC_TRUE " if gen is a " S_frample_to_file " generator"
-
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_frample_to_file(Xen_to_mus_any(obj)))));
- }
-
-
- #if HAVE_SCHEME
- static mus_float_t (*in_any_2)(mus_long_t pos, int chn);
- #endif
-
- static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
- {
- mus_long_t pos;
-
- Xen_check_type(Xen_is_integer(frample), frample, 1, caller, "an integer");
-
- pos = Xen_llong_to_C_llong(frample);
- if (pos < 0)
- Xen_out_of_range_error(caller, 1, frample, "location should be >= 0");
-
- if (in_chan < 0)
- Xen_out_of_range_error(caller, 2, C_int_to_Xen_integer(in_chan), "must be >= 0");
-
- #if HAVE_SCHEME
- if (Xen_is_false(inp)) return(C_double_to_Xen_real(0.0)); /* ws.scm default for *clm-reverb* is #f */
- if (inp == CLM_REVERB)
- return(s7_make_real(s7, in_any_2(pos, in_chan)));
- #endif
-
- if (mus_is_xen(inp))
- {
- Xen_check_type(mus_is_input(Xen_to_mus_any(inp)), inp, 3, caller, "an input generator");
- return(C_double_to_Xen_real(mus_in_any(pos, in_chan, (mus_any *)Xen_to_mus_any(inp))));
- }
-
- if (mus_is_vct(inp))
- {
- #if HAVE_SCHEME
- if (pos < s7_vector_length(inp))
- {
- if (s7_vector_rank(inp) > 1)
- return(s7_vector_ref_n(s7, inp, 2, in_chan, pos));
- return(s7_vector_ref(s7, inp, pos));
- }
- return(C_double_to_Xen_real(0.0));
- #else
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(inp);
- vdata = mus_vct_data(v);
- if (pos < mus_vct_length(v))
- return(C_double_to_Xen_real(vdata[pos]));
- return(C_double_to_Xen_real(0.0));
- #endif
- }
-
- if (Xen_is_vector(inp))
- {
- if (pos < Xen_vector_length(inp))
- return(Xen_vector_ref(inp, pos));
- }
-
- return(C_double_to_Xen_real(0.0));
- }
-
-
- static Xen g_in_any(Xen frample, Xen chan, Xen inp)
- {
- #define H_in_any "(" S_in_any " frample chan stream): input stream sample at frample in channel chan"
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_in_any, "an integer");
- return(g_in_any_1(S_in_any, frample, Xen_integer_to_C_int(chan), inp));
- }
-
-
- static Xen g_ina(Xen frample, Xen inp)
- {
- #define H_ina "(" S_ina " frample stream): input stream sample in channel 0 at frample"
- return(g_in_any_1(S_ina, frample, 0, inp));
- }
-
-
- static Xen g_inb(Xen frample, Xen inp)
- {
- #define H_inb "(" S_inb " frample stream): input stream sample in channel 1 at frample"
- return(g_in_any_1(S_inb, frample, 1, inp));
- }
-
-
- #if (!HAVE_SCHEME)
- static Xen out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- #else
- static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- #endif
- {
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(outp, mus_xen_tag);
- if (gn)
- {
- /* mus_out_any will check the writer so output_p is pointless */
- mus_out_any(pos, inv, chn, mus_xen_to_mus_any(gn));
- return(Xen_integer_zero);
- }
-
- if (mus_is_vct(outp))
- {
- mus_float_t *vdata;
- vct *v;
- v = xen_to_vct(outp);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(outp) == 1)
- {
- if (chn == 0)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += inv;
- }
- }
- #if HAVE_SCHEME
- else
- {
- s7_int *offsets;
- offsets = s7_vector_offsets(outp);
- pos += (chn * offsets[0]);
- if (pos < mus_vct_length(v))
- vdata[pos] += inv;
- }
- #endif
- return(Xen_integer_zero);
- }
-
- if (Xen_is_vector(outp))
- {
- if (pos < Xen_vector_length(outp))
- Xen_vector_set(outp, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(outp, pos)) + inv));
- }
-
- return(Xen_integer_zero);
- }
-
- #if HAVE_SCHEME
-
- static Xen (*out_any_2)(mus_long_t pos, mus_float_t inv, int chn, const char *caller);
-
- bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO);
- bool mus_simple_outa_to_file(mus_long_t samp, mus_float_t val, mus_any *IO);
-
- static mus_xen *clm_output_gn = NULL;
- static mus_any *clm_output_gen = NULL;
- static vct *clm_output_vct;
-
- static Xen out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- mus_out_any(pos, inv, chn, clm_output_gen);
- return(xen_zero);
- }
-
- static Xen safe_out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- if (!mus_simple_out_any_to_file(pos, inv, chn, clm_output_gen))
- mus_safe_out_any_to_file(pos, inv, chn, clm_output_gen);
- return(xen_zero);
- }
-
-
- static Xen out_any_2_to_vct(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(clm_output_vct);
-
- #if (!HAVE_SCHEME)
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_output_vct)))
- vdata[pos] += inv;
- #else
- if (Xen_vector_rank(clm_output_vct) == 1)
- {
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_output_vct)))
- vdata[pos] += inv;
- }
- else
- {
- s7_int chans;
- chans = s7_vector_dimensions(clm_output_vct)[0];
- if (chn < chans)
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(clm_output_vct)[1];
- if (pos < chan_len)
- vdata[chn * chan_len + pos] += inv;
- }
- }
- #endif
- return(xen_zero);
- }
-
-
- static Xen out_any_2_to_vector(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- if (pos < Xen_vector_length(CLM_OUTPUT))
- Xen_vector_set(CLM_OUTPUT, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(CLM_OUTPUT, pos)) + inv));
- return(xen_zero);
- }
-
- static Xen out_any_2_no_op(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
- {
- return(xen_zero);
- }
-
- static s7_pointer g_clm_output_set(s7_scheme *sc, s7_pointer args)
- {
- s7_pointer new_output;
- new_output = s7_cadr(args);
-
- clm_output_gn = (mus_xen *)Xen_object_ref_checked(new_output, mus_xen_tag);
- if (clm_output_gn)
- {
- out_any_2 = out_any_2_to_mus_xen;
- clm_output_gen = clm_output_gn->gen;
-
- if (mus_out_any_is_safe(clm_output_gen))
- out_any_2 = safe_out_any_2_to_mus_xen;
- }
- else
- {
- clm_output_gen = NULL;
- if (mus_is_vct(new_output))
- {
- out_any_2 = out_any_2_to_vct;
- clm_output_vct = xen_to_vct(new_output);
- }
- else
- {
- if (Xen_is_vector(new_output))
- {
- out_any_2 = out_any_2_to_vector;
- }
- else out_any_2 = out_any_2_no_op;
- }
- }
- return(new_output);
- }
-
-
- /* need in_any_2(pos, 0, caller) -> double + safe case + none-file cases
- */
-
- static mus_xen *clm_input_gn;
- static mus_any *clm_input_gen;
- static vct *clm_input_vct;
-
- static mus_float_t in_any_2_to_mus_xen(mus_long_t pos, int chn)
- {
- return(mus_in_any(pos, chn, clm_input_gen));
- }
-
- static mus_float_t safe_in_any_2_to_mus_xen(mus_long_t pos, int chn)
- {
- return(mus_file_to_sample(clm_input_gen, pos, chn));
- }
-
- static mus_float_t in_any_2_to_vct(mus_long_t pos, int chn)
- {
- mus_float_t *vdata;
- vdata = mus_vct_data(clm_input_vct);
- if ((chn == 0) &&
- (pos < mus_vct_length(clm_input_vct)))
- return(vdata[pos]);
- return(0.0);
- }
-
- static mus_float_t in_any_2_to_vector(mus_long_t pos, int chn)
- {
- if (pos < Xen_vector_length(CLM_REVERB))
- return(Xen_real_to_C_double(Xen_vector_ref(CLM_REVERB, pos)));
- return(0.0);
- }
-
- static mus_float_t in_any_2_no_op(mus_long_t pos, int chn)
- {
- return(0.0);
- }
-
- static s7_pointer g_clm_reverb_set(s7_scheme *sc, s7_pointer args)
- {
- s7_pointer new_input;
- new_input = s7_cadr(args);
-
- clm_input_gn = (mus_xen *)Xen_object_ref_checked(new_input, mus_xen_tag);
- if (clm_input_gn)
- {
- in_any_2 = in_any_2_to_mus_xen;
- clm_input_gen = clm_input_gn->gen;
-
- if (mus_in_any_is_safe(clm_input_gen))
- in_any_2 = safe_in_any_2_to_mus_xen;
- }
- else
- {
- if (mus_is_vct(new_input))
- {
- in_any_2 = in_any_2_to_vct;
- clm_input_vct = xen_to_vct(new_input);
- }
- else
- {
- if (Xen_is_vector(new_input))
- {
- in_any_2 = in_any_2_to_vector;
- }
- else in_any_2 = in_any_2_no_op;
- }
- }
- return(new_input);
- }
-
-
- #endif
-
-
- #define S_out_bank "out-bank"
- static Xen g_out_bank(Xen gens, Xen loc, Xen inval)
- {
- #define H_out_bank "(out-bank gens location val) calls each generator in the gens vector, passing it the argument val, then \
- sends that output to the output channels in the vector order (the first generator writes to outa, the second to outb, etc)."
-
- mus_long_t pos;
- int i, size;
- mus_float_t x = 0.0;
-
- Xen_check_type(Xen_is_integer(loc), loc, 2, S_out_bank, "an integer");
- pos = Xen_llong_to_C_llong(loc);
- if (pos < 0)
- Xen_out_of_range_error(S_out_bank, 2, loc, "must be >= 0");
-
- Xen_check_type(Xen_is_vector(gens), gens, 1, S_out_bank, "a vector of generators");
- size = Xen_vector_length(gens);
-
- Xen_check_type(Xen_is_number(inval), inval, 3, S_out_bank, "a number");
- x = Xen_real_to_C_double(inval);
-
- #if HAVE_SCHEME
- for (i = 0; i < size; i++)
- {
- mus_any *g = NULL;
- mus_xen *gn;
- Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
- out_any_2(pos, mus_apply(g, x, 0.0), i, S_out_bank);
- }
- #else
- for (i = 0; i < size; i++)
- {
- mus_any *g = NULL;
- mus_xen *gn;
- Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
- out_any_2(CLM_OUTPUT, pos, mus_apply(g, x, 0.0), i, S_out_bank);
- }
- #endif
-
- return(inval);
- }
-
-
- static Xen g_out_any_1(const char *caller, Xen frample, int chn, Xen val, Xen outp)
- {
- mus_long_t pos = 0;
- mus_float_t inv;
-
- if (chn < 0)
- Xen_out_of_range_error(caller, 3, C_int_to_Xen_integer(chn), "must be >= 0");
- Xen_to_C_integer_or_error(frample, pos, caller, 1);
- if (pos < 0)
- Xen_out_of_range_error(caller, 1, frample, "must be >= 0");
-
- Xen_to_C_double_or_error(val, inv, caller, 2);
-
- if (!Xen_is_bound(outp))
- #if (!HAVE_SCHEME)
- return(out_any_2(CLM_OUTPUT, pos, inv, chn, caller));
- #else
- return(out_any_2(pos, inv, chn, caller));
- #endif
-
- #if (!HAVE_SCHEME)
- return(out_any_2(outp, pos, inv, chn, caller));
- #else
- if (outp == CLM_OUTPUT)
- return(out_any_2(pos, inv, chn, caller));
- return(fallback_out_any_2(outp, pos, inv, chn, caller));
- #endif
- }
-
- static Xen g_out_any(Xen frample, Xen val, Xen chan, Xen outp)
- {
- #define H_out_any "(" S_out_any " frample val chan stream): add val to output stream at frample in channel chan"
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_out_any, "an integer");
- return(g_out_any_1(S_out_any, frample, Xen_integer_to_C_int(chan), val, outp));
- }
-
-
- static Xen g_outa(Xen frample, Xen val, Xen outp)
- {
- #define H_outa "(" S_outa " frample val stream): add val to output stream at frample in channel 0"
- return(g_out_any_1(S_outa, frample, 0, val, outp));
- }
-
-
- static Xen g_outb(Xen frample, Xen val, Xen outp)
- {
- #define H_outb "(" S_outb " frample val stream): add val to output stream at frample in channel 1"
- return(g_out_any_1(S_outb, frample, 1, val, outp));
- }
-
-
- static Xen g_outc(Xen frample, Xen val, Xen outp)
- {
- #define H_outc "(" S_outc " frample val stream): add val to output stream at frample in channel 2"
- return(g_out_any_1(S_outc, frample, 2, val, outp));
- }
-
-
- static Xen g_outd(Xen frample, Xen val, Xen outp)
- {
- #define H_outd "(" S_outd " frample val stream): add val to output stream at frample in channel 3"
- return(g_out_any_1(S_outd, frample, 3, val, outp));
- }
-
-
- static Xen g_mus_close(Xen ptr)
- {
- #define H_mus_close "(" S_mus_close " gen): close the IO stream managed by 'gen' (a sample->file generator, for example)"
-
- if (mus_is_xen(ptr))
- return(C_int_to_Xen_integer(mus_close_file((mus_any *)Xen_to_mus_any(ptr))));
-
- Xen_check_type(mus_is_vct(ptr) || Xen_is_false(ptr) || Xen_is_vector(ptr),
- ptr, 1, S_mus_close, "an IO gen or its outa equivalent");
- return(Xen_integer_zero);
- }
-
-
- static Xen g_make_file_to_sample(Xen name, Xen buffer_size)
- {
- #define H_make_file_to_sample "(" S_make_file_to_sample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
-
- mus_any *ge;
- mus_long_t size;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_sample, "a string");
- Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_sample, "an integer");
-
- if (!(mus_file_probe(Xen_string_to_C_string(name))))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_file_to_sample ": ~S, ~A"),
- name,
- C_string_to_Xen_string(STRERROR(errno))));
-
- if (Xen_is_llong(buffer_size))
- {
- size = Xen_llong_to_C_llong(buffer_size);
- if (size <= 0)
- Xen_out_of_range_error(S_make_file_to_sample, 2, buffer_size, "must be > 0");
- }
- else size = mus_file_buffer_size();
-
- ge = mus_make_file_to_sample_with_buffer_size(Xen_string_to_C_string(name), size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_file_to_sample(Xen obj, Xen samp, Xen chan)
- {
- #define H_file_to_sample "(" S_file_to_sample " obj frample chan): sample value in sound file read by 'obj' in channel chan at frample"
- int channel = 0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_input, S_file_to_sample, "an input generator");
- Xen_check_type(Xen_is_llong(samp), samp, 2, S_file_to_sample, "an integer");
-
- if (Xen_is_bound(chan))
- {
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_file_to_sample, "an integer");
- channel = Xen_integer_to_C_int(chan);
- }
- return(C_double_to_Xen_real(mus_file_to_sample(g, Xen_llong_to_C_llong(samp), channel)));
- }
-
-
- static Xen g_make_sample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
- {
- #if HAVE_SCHEME
- #define make_sample_to_file_example "(" S_make_sample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
- #endif
- #if HAVE_RUBY
- #define make_sample_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_sample2file"
- #endif
- #if HAVE_FORTH
- #define make_sample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-sample->file"
- #endif
-
- #define H_make_sample_to_file "(" S_make_sample_to_file " filename chans sample-type header-type comment): \
- return an output generator writing the sound file 'filename' which is set up to have \
- 'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
- should be sndlib identifiers:\n " make_sample_to_file_example
-
- mus_sample_t df = MUS_OUT_SAMPLE_TYPE;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_sample_to_file, "a string");
- Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_sample_to_file, "an integer");
- Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_sample_to_file, "an integer (sample type)");
- Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_sample_to_file, "an integer (header type)");
-
- if (Xen_is_integer(out_format)) df = (mus_sample_t)Xen_integer_to_C_int(out_format);
- if (mus_is_sample_type(df))
- {
- mus_header_t ht = MUS_NEXT;
- if (Xen_is_integer(out_type)) ht = (mus_header_t)Xen_integer_to_C_int(out_type);
- if (mus_is_header_type(ht))
- {
- int chns = 1;
- if (Xen_is_integer(chans)) chns = Xen_integer_to_C_int(chans);
- if (chns > 0)
- {
- mus_any *rgen;
- rgen = mus_make_sample_to_file_with_comment(Xen_string_to_C_string(name),
- chns, df, ht,
- (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 2, chans, "chans <= 0?");
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 4, out_type, "invalid header type");
- }
- else Xen_out_of_range_error(S_make_sample_to_file, 3, out_format, "invalid sample type");
- return(Xen_false);
- }
-
-
- static Xen g_continue_sample_to_file(Xen name)
- {
- #define H_continue_sample_to_file "(" S_continue_sample_to_file " filename): return an output generator \
- that reopens an existing sound file 'filename' ready for output via " S_sample_to_file
-
- mus_any *rgen = NULL;
- Xen_check_type(Xen_is_string(name), name, 1, S_continue_sample_to_file, "a string");
- rgen = mus_continue_sample_to_file(Xen_string_to_C_string(name));
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(Xen_false);
- }
-
-
- static Xen g_sample_to_file(Xen obj, Xen samp, Xen chan, Xen val)
- {
- #define H_sample_to_file "(" S_sample_to_file " obj samp chan val): add val to the output stream \
- handled by the output generator 'obj', in channel 'chan' at frample 'samp'"
-
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_any_generator(obj, gn, g, S_sample_to_file, "an output generator");
- Xen_check_type(mus_is_output(g), obj, 1, S_sample_to_file, "an output generator");
-
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_sample_to_file, "an integer");
- Xen_check_type(Xen_is_integer(chan), chan, 3, S_sample_to_file, "an integer");
- Xen_check_type(Xen_is_number(val), val, 4, S_sample_to_file, "a number");
-
- mus_sample_to_file(g,
- Xen_llong_to_C_llong(samp),
- Xen_integer_to_C_int(chan),
- Xen_real_to_C_double(val));
- return(val);
- }
-
-
- static Xen g_sample_to_file_add(Xen obj1, Xen obj2)
- {
- #define H_sample_to_file_add "(" S_sample_to_file_add " obj1 obj2): mixes obj2 (an output generator) into obj1 (also an output generator)"
- mus_any *g1 = NULL, *g2 = NULL;
- mus_xen *gn1, *gn2;
-
- Xen_to_C_any_generator(obj1, gn1, g1, S_sample_to_file_add, "an output generator");
- Xen_to_C_any_generator(obj2, gn2, g2, S_sample_to_file_add, "an output generator");
- Xen_check_type(mus_is_output(g1), obj1, 1, S_sample_to_file_add, "an output generator");
- Xen_check_type(mus_is_output(g2), obj2, 2, S_sample_to_file_add, "an output generator");
-
- mus_sample_to_file_add(g1, g2);
- return(obj1);
- }
-
- static Xen g_make_file_to_frample(Xen name, Xen buffer_size)
- {
- #define H_make_file_to_frample "(" S_make_file_to_frample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
-
- mus_any *ge;
- mus_long_t size;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_frample, "a string");
- Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_frample, "an integer");
-
- if (!(mus_file_probe(Xen_string_to_C_string(name))))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_file_to_frample ": ~S, ~A"),
- name,
- C_string_to_Xen_string(STRERROR(errno))));
-
- if (Xen_is_llong(buffer_size))
- {
- size = Xen_llong_to_C_llong(buffer_size);
- if (size <= 0)
- Xen_out_of_range_error(S_make_file_to_frample, 2, buffer_size, "must be > 0");
- }
- else size = mus_file_buffer_size();
- ge = mus_make_file_to_frample_with_buffer_size(Xen_string_to_C_string(name), size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_file_to_frample(Xen obj, Xen samp, Xen outfr)
- {
- #define H_file_to_frample "(" S_file_to_frample " obj samp outf): frample of samples at frample 'samp' in sound file read by 'obj'"
-
- Xen_check_type((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj))), obj, 1, S_file_to_frample, "an input generator");
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_file_to_frample, "an integer");
-
- mus_file_to_frample(Xen_to_mus_any(obj), Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(outfr)));
- return(outfr);
- }
-
-
- static Xen g_make_frample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
- {
- #if HAVE_SCHEME
- #define make_frample_to_file_example "(" S_make_frample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
- #endif
- #if HAVE_RUBY
- #define make_frample_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_frample2file"
- #endif
- #if HAVE_FORTH
- #define make_frample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-frample->file"
- #endif
-
- #define H_make_frample_to_file "(" S_make_frample_to_file " filename chans sample-type header-type comment): \
- return an output generator writing the sound file 'filename' which is set up to have \
- 'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
- should be sndlib identifiers:\n " make_frample_to_file_example
-
- mus_any *fgen = NULL;
-
- Xen_check_type(Xen_is_string(name), name, 1, S_make_frample_to_file, "a string");
- Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_frample_to_file, "an integer");
- Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_frample_to_file, "an integer (sample type id)");
- Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_frample_to_file, "an integer (header-type id)");
-
- fgen = mus_make_frample_to_file_with_comment(Xen_string_to_C_string(name),
- (Xen_is_integer(chans)) ? Xen_integer_to_C_int(chans) : 1,
- (Xen_is_integer(out_format)) ? (mus_sample_t)Xen_integer_to_C_int(out_format) : MUS_OUT_SAMPLE_TYPE,
- (Xen_is_integer(out_type)) ? (mus_header_t)Xen_integer_to_C_int(out_type) : MUS_NEXT,
- (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
- if (fgen) return(mus_xen_to_object(mus_any_to_mus_xen(fgen)));
- return(Xen_false);
- }
-
-
- static Xen g_continue_frample_to_file(Xen name)
- {
- #define H_continue_frample_to_file "(" S_continue_frample_to_file " filename): return an output generator \
- that reopens an existing sound file 'filename' ready for output via " S_frample_to_file
-
- mus_any *rgen = NULL;
- Xen_check_type(Xen_is_string(name), name, 1, S_continue_frample_to_file, "a string");
- rgen = mus_continue_frample_to_file(Xen_string_to_C_string(name));
- if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(Xen_false);
- }
-
-
- static Xen g_frample_to_file(Xen obj, Xen samp, Xen val)
- {
- #define H_frample_to_file "(" S_frample_to_file " obj samp val): add frample 'val' to the output stream \
- handled by the output generator 'obj' at frample 'samp'"
- mus_xen *gn;
-
- gn = (mus_xen *)Xen_object_ref_checked(obj, mus_xen_tag);
- Xen_check_type(((gn) && (mus_is_output(gn->gen))), obj, 1, S_frample_to_file, "an output generator");
- Xen_check_type(Xen_is_integer(samp), samp, 2, S_frample_to_file, "an integer");
-
- mus_frample_to_file(gn->gen, Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(val)));
- return(val);
- }
-
-
-
-
- /* ---------------- readin ---------------- */
-
- static Xen g_is_readin(Xen obj)
- {
- #define H_is_readin "(" S_is_readin " gen): " PROC_TRUE " if gen is a " S_readin
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_readin(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_readin(Xen obj)
- {
- #define H_readin "(" S_readin " gen): next sample from readin generator (a sound file reader)"
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_readin, S_readin, "a readin generator");
-
- return(C_double_to_Xen_real(mus_readin(g)));
- }
-
-
- static Xen g_make_readin(Xen arglist)
- {
- #define H_make_readin "(" S_make_readin " file (channel 0) (start 0) (direction 1) size): \
- return a new readin (file input) generator reading the sound file 'file' starting at frample \
- 'start' in channel 'channel' and reading forward if 'direction' is not -1"
-
- /* optkey file channel start direction size */
-
- mus_any *ge;
- const char *file = NULL;
- Xen args[10];
- Xen keys[5];
- int orig_arg[5] = {0, 0, 0, 0, 0};
- int vals, chans;
- mus_long_t buffer_size;
- int channel = 0, direction = 1;
- mus_long_t start = 0;
-
- keys[0] = kw_file;
- keys[1] = kw_channel;
- keys[2] = kw_start;
- keys[3] = kw_direction;
- keys[4] = kw_size;
-
- buffer_size = mus_file_buffer_size();
- /* this is only 8192! (clm.h MUS_DEFAULT_FILE_BUFFER_SIZE) */
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 10) clm_error(S_make_readin, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_readin, 5, keys, args, orig_arg);
- if (vals > 0)
- {
- file = mus_optkey_to_string(keys[0], S_make_readin, orig_arg[0], NULL); /* not copied */
-
- channel = Xen_optkey_to_int(kw_channel, keys[1], S_make_readin, orig_arg[1], channel);
- if (channel < 0)
- Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel < 0?");
-
- start = Xen_optkey_to_mus_long_t(kw_start, keys[2], S_make_readin, orig_arg[2], start);
-
- direction = Xen_optkey_to_int(kw_direction, keys[3], S_make_readin, orig_arg[3], direction);
-
- buffer_size = Xen_optkey_to_mus_long_t(kw_size, keys[4], S_make_readin, orig_arg[4], buffer_size);
- if (buffer_size <= 0)
- Xen_out_of_range_error(S_make_readin, orig_arg[4], keys[4], "must be > 0");
- }
-
- if (file == NULL)
- Xen_out_of_range_error(S_make_readin, orig_arg[0], keys[0], "no file name given");
- if (!(mus_file_probe(file)))
- Xen_error(NO_SUCH_FILE,
- Xen_list_3(C_string_to_Xen_string(S_make_readin ": ~S, ~A"),
- C_string_to_Xen_string(file),
- C_string_to_Xen_string(STRERROR(errno))));
-
- chans = mus_sound_chans(file);
- if (chans <= 0)
- Xen_error(BAD_HEADER,
- Xen_list_2(C_string_to_Xen_string(S_make_readin ": ~S chans <= 0?"),
- C_string_to_Xen_string(file)));
-
- if (channel >= chans)
- Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel > available chans?");
-
- ge = mus_make_readin_with_buffer_size(file, channel, start, direction, buffer_size);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- /* ---------------- locsig ---------------- */
-
- static Xen g_locsig_ref(Xen obj, Xen chan)
- {
- #define H_locsig_ref "(" S_locsig_ref " gen chan): locsig 'gen' channel 'chan' scaler"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_ref, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_ref, "an integer");
- return(C_double_to_Xen_real(mus_locsig_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
- }
-
-
- static Xen g_locsig_set(Xen obj, Xen chan, Xen val)
- {
- #define H_locsig_set "(" S_locsig_set " gen chan val): set the locsig generator's channel 'chan' scaler to 'val'"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_set, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_set, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(val), val, 3, S_locsig_set, "a number");
- mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
- #else
- mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_set));
- #endif
- return(val);
- }
-
-
- static Xen g_locsig_reverb_ref(Xen obj, Xen chan)
- {
- #define H_locsig_reverb_ref "(" S_locsig_reverb_ref " gen chan): locsig reverb channel 'chan' scaler"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_ref, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_ref, "an integer");
- return(C_double_to_Xen_real(mus_locsig_reverb_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
- }
-
-
- static Xen g_locsig_reverb_set(Xen obj, Xen chan, Xen val)
- {
- #define H_locsig_reverb_set "(" S_locsig_reverb_set " gen chan val): set the locsig reverb channel 'chan' scaler to 'val'"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_set, "a locsig generator");
- Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_set, "an integer");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(val), val, 3, S_locsig_reverb_set, "a number");
- mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
- #else
- mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_reverb_set));
- #endif
- return(val);
- }
-
-
- static Xen g_is_locsig(Xen obj)
- {
- #define H_is_locsig "(" S_is_locsig " gen): " PROC_TRUE " if gen is a " S_locsig
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj)))));
- }
-
-
- static void mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any *loc_gen, mus_long_t pos, bool from_locsig)
- {
- mus_float_t *outfr = NULL, *revfr = NULL;
- Xen output, reverb;
- #if HAVE_SCHEME
- int chans, rev_chans;
- #endif
- if (pos < 0) return;
-
- if (from_locsig)
- {
- outfr = mus_locsig_outf(loc_gen);
- revfr = mus_locsig_revf(loc_gen);
- #if HAVE_SCHEME
- chans = mus_locsig_channels(loc_gen);
- rev_chans = mus_locsig_reverb_channels(loc_gen);
- #endif
- }
- else
- {
- outfr = mus_move_sound_outf(loc_gen);
- revfr = mus_move_sound_revf(loc_gen);
- #if HAVE_SCHEME
- chans = mus_move_sound_channels(loc_gen);
- rev_chans = mus_move_sound_reverb_channels(loc_gen);
- #endif
- }
- output = ms->vcts[G_LOCSIG_OUT];
-
- if (outfr)
- {
- if (mus_is_vct(output))
- {
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(output);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(output) == 1)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += outfr[0];
- }
- #if HAVE_SCHEME
- else
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(output)[1]; /* '(4 20) so each chan len is [1] */
- if (pos < chan_len)
- {
- int i;
- for (i = 0; i < chans; i++)
- vdata[i * chan_len + pos] += outfr[i];
- }
- }
- #endif
- }
- else
- {
- if ((Xen_is_vector(output)) &&
- (pos < Xen_vector_length(output)))
- Xen_vector_set(output, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(output, pos)) + outfr[0]));
- }
- }
-
- if ((revfr) &&
- (Xen_is_bound(ms->vcts[G_LOCSIG_REVOUT])))
- {
- reverb = ms->vcts[G_LOCSIG_REVOUT];
- if (mus_is_vct(reverb))
- {
- vct *v;
- mus_float_t *vdata;
- v = Xen_to_vct(reverb);
- vdata = mus_vct_data(v);
- if (Xen_vector_rank(reverb) == 1)
- {
- if (pos < mus_vct_length(v))
- vdata[pos] += revfr[0];
- }
- #if HAVE_SCHEME
- else
- {
- s7_int chan_len;
- chan_len = s7_vector_dimensions(reverb)[1];
- if (pos < chan_len)
- {
- int i;
- for (i = 0; i < rev_chans; i++)
- vdata[i * chan_len + pos] += revfr[i];
- }
- }
- #endif
- }
- else
- {
- if ((Xen_is_vector(reverb)) &&
- (pos < Xen_vector_length(reverb)))
- Xen_vector_set(reverb, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(reverb, pos)) + revfr[0]));
- }
- }
- }
-
-
- static Xen g_locsig(Xen xobj, Xen xpos, Xen xval)
- {
- #define H_locsig "(" S_locsig " gen loc val): add 'val' to the output of locsig at frample 'loc'"
- mus_any *loc_gen;
- mus_xen *ms;
- mus_long_t pos;
- mus_float_t fval;
-
- ms = (mus_xen *)Xen_object_ref_checked(xobj, mus_xen_tag);
- if (!ms) Xen_check_type(false, xobj, 1, S_locsig, "a locsig generator");
- loc_gen = ms->gen;
- Xen_check_type(mus_is_locsig(loc_gen), xobj, 1, S_locsig, "a locsig generator");
-
- Xen_check_type(Xen_is_integer(xpos), xpos, 2, S_locsig, "an integer");
-
- pos = Xen_llong_to_C_llong(xpos);
- if (pos < 0)
- Xen_out_of_range_error(S_locsig, 2, xpos, "must be >= 0");
-
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(xval), xval, 3, S_locsig, "a number");
- fval = Xen_real_to_C_double(xval);
- #else
- fval = s7_number_to_real_with_caller(s7, xval, S_locsig);
- #endif
-
- mus_locsig(loc_gen, pos, fval);
-
- return(xval); /* changed 30-June-06 to return val rather than a wrapped frample */
- }
-
- static mus_interp_t clm_locsig_type = MUS_INTERP_LINEAR;
-
- static Xen g_locsig_type(void)
- {
- #define H_locsig_type "(" S_locsig_type "): locsig interpolation type, either " S_mus_interp_linear " or " S_mus_interp_sinusoidal "."
- return(C_int_to_Xen_integer((int)clm_locsig_type));
- }
-
-
- static Xen g_set_locsig_type(Xen val)
- {
- mus_interp_t newval;
- Xen_check_type(Xen_is_integer(val), val, 1, S_locsig_type, S_mus_interp_linear " or " S_mus_interp_sinusoidal);
- newval = (mus_interp_t)Xen_integer_to_C_int(val);
- if ((newval == MUS_INTERP_LINEAR) || (newval == MUS_INTERP_SINUSOIDAL))
- clm_locsig_type = newval;
- return(C_int_to_Xen_integer((int)clm_locsig_type));
- }
-
-
- static void clm_locsig_detour(mus_any *ptr, mus_long_t pos)
- {
- mus_xen *ms;
- ms = (mus_xen *)mus_locsig_closure(ptr);
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4)
- mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, true);
- }
-
- static Xen g_make_locsig(Xen arglist)
- {
- #define H_make_locsig "(" S_make_locsig " (degree 0.0) (distance 1.0) (reverb 0.0) (output *output*) (revout *reverb*) (channels (mus-channels *output*)) (type " S_mus_interp_linear ")): \
- return a new generator for signal placement in n channels. Channel 0 corresponds to 0 degrees."
-
- mus_any *ge;
- mus_any *outp = NULL, *revp = NULL;
- Xen args[14];
- Xen keys[7];
- Xen ov = Xen_undefined, rv = Xen_undefined;
- Xen keys3 = Xen_undefined, keys4 = Xen_undefined;
- int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, out_chans = -1, rev_chans = -1;
- mus_interp_t type;
- mus_float_t degree = 0.0, distance = 1.0, reverb = 0.0;
-
- type = clm_locsig_type;
-
- keys[0] = kw_degree;
- keys[1] = kw_distance;
- keys[2] = kw_reverb;
- keys[3] = kw_output;
- keys[4] = kw_revout;
- keys[5] = kw_channels;
- keys[6] = kw_type;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 14) clm_error(S_make_locsig, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_locsig, 7, keys, args, orig_arg);
- if (vals > 0)
- {
- degree = Xen_optkey_to_float(kw_degree, keys[0], S_make_locsig, orig_arg[0], degree);
- distance = Xen_optkey_to_float(kw_distance, keys[1], S_make_locsig, orig_arg[1], distance);
- reverb = Xen_optkey_to_float(kw_reverb, keys[2], S_make_locsig, orig_arg[2], reverb);
-
- if (!(Xen_is_keyword(keys[3])))
- keys3 = keys[3];
-
- if (!(Xen_is_keyword(keys[4])))
- keys4 = keys[4];
-
- if (!(Xen_is_keyword(keys[5])))
- {
- Xen_check_type(Xen_is_integer(keys[5]), keys[5], orig_arg[5], S_make_locsig, "an integer");
- out_chans = Xen_integer_to_C_int(keys[5]);
- if (out_chans < 0)
- Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "chans < 0?");
- if (out_chans > mus_max_table_size())
- Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "too many chans");
- }
-
- type = (mus_interp_t)Xen_optkey_to_int(kw_type, keys[6], S_make_locsig, orig_arg[6], (int)type);
- if ((type != MUS_INTERP_LINEAR) && (type != MUS_INTERP_SINUSOIDAL))
- Xen_out_of_range_error(S_make_locsig, orig_arg[6], keys[6], "type must be " S_mus_interp_linear " or " S_mus_interp_sinusoidal ".");
- }
-
- if (!Xen_is_bound(keys3))
- keys3 = CLM_OUTPUT;
-
- if (!Xen_is_bound(keys4))
- keys4 = CLM_REVERB;
-
- /* try to default output to *output* and reverb to *reverb*, if they're currently set and not closed */
- /* mus_close is actually mus_close_file = sample_to_file_end = free and nullify obufs so we're hoping dynamic-wind works... */
-
- if ((mus_is_xen(keys3)) &&
- (mus_is_output(Xen_to_mus_any(keys3))))
- {
- outp = (mus_any *)Xen_to_mus_any(keys3);
- if (out_chans < 0)
- out_chans = mus_channels((mus_any *)outp);
- }
- else
- {
- if (mus_is_vct(keys3))
- ov = keys3;
- else Xen_check_type(Xen_is_keyword(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], S_make_locsig, "an output gen, " S_vct ", vector, or a sound-data object");
- #if HAVE_SCHEME
- if ((out_chans < 0) &&
- (s7_is_vector(ov)) &&
- (s7_vector_rank(ov) > 1))
- out_chans = s7_vector_dimensions(ov)[0];
- #endif
- }
-
- if ((mus_is_xen(keys4)) &&
- (mus_is_output(Xen_to_mus_any(keys4))))
- {
- revp = (mus_any *)Xen_to_mus_any(keys4);
- if (rev_chans < 0)
- rev_chans = mus_channels((mus_any *)revp);
- }
- else
- {
- if (mus_is_vct(keys4))
- {
- rv = keys4;
- rev_chans = 1;
- #if HAVE_SCHEME
- if (Xen_vector_rank(rv) > 1)
- rev_chans = s7_vector_dimensions(rv)[0];
- #endif
- }
- else Xen_check_type(Xen_is_keyword(keys[4]) || Xen_is_false(keys[4]), keys[4], orig_arg[4], S_make_locsig, "a reverb output generator");
- }
-
- if (out_chans < 0) out_chans = 1;
- if (rev_chans < 0) rev_chans = 0;
-
- ge = mus_make_locsig(degree, distance, reverb, out_chans, outp, rev_chans, revp, type);
-
- if (ge)
- {
- mus_xen *gn;
- if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
- ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
- gn = mx_alloc(4);
- else gn = mx_alloc(2);
-
- /* these two are for the mus-data and mus-xcoeffs methods in Scheme (etc) = MUS_DATA_WRAPPER and G_FILTER_XCOEFFS */
- if (out_chans > 0)
- gn->vcts[G_LOCSIG_DATA] = xen_make_vct_wrapper(out_chans, mus_data(ge));
- else gn->vcts[G_LOCSIG_DATA] = Xen_undefined;
- if (rev_chans > 0)
- gn->vcts[G_LOCSIG_REVDATA] = xen_make_vct_wrapper(rev_chans, mus_xcoeffs(ge));
- else gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
-
- if (gn->nvcts == 4)
- {
- mus_locsig_set_detour(ge, clm_locsig_detour);
- gn->vcts[G_LOCSIG_OUT] = ov;
- gn->vcts[G_LOCSIG_REVOUT] = rv;
- mus_set_environ(ge, (void *)gn);
- }
-
- gn->gen = ge;
- return(mus_xen_to_object(gn));
- }
- return(Xen_false);
- }
-
-
- static Xen g_move_locsig(Xen obj, Xen degree, Xen distance)
- {
- #define H_move_locsig "(" S_move_locsig " gen degree distance): move locsig gen to reflect degree and distance"
- Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_move_locsig, "a locsig generator");
- #if (!HAVE_SCHEME)
- Xen_check_type(Xen_is_number(degree), degree, 2, S_move_locsig, "a number in degrees");
- Xen_check_type(Xen_is_number(distance), distance, 3, S_move_locsig, "a number > 1.0");
- mus_move_locsig(Xen_to_mus_any(obj), Xen_real_to_C_double(degree), Xen_real_to_C_double(distance));
- #else
- mus_move_locsig(Xen_to_mus_any(obj),
- s7_number_to_real_with_caller(s7, degree, S_move_locsig),
- s7_number_to_real_with_caller(s7, distance, S_move_locsig));
- #endif
- return(obj);
- }
-
-
-
-
- /* ---------------- move-sound ---------------- */
-
- static Xen g_is_move_sound(Xen obj)
- {
- #define H_is_move_sound "(" S_is_move_sound " gen): " PROC_TRUE " if gen is a " S_move_sound
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_move_sound(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_move_sound(Xen obj, Xen loc, Xen val)
- {
- #define H_move_sound "(" S_move_sound " gen loc val): dlocsig run-time generator handling 'val' at sample 'loc'"
- mus_any *move_gen;
- mus_xen *ms;
- mus_long_t pos;
- mus_float_t fval;
-
- Xen_check_type(mus_is_xen(obj), obj, 1, S_move_sound, "a move-sound generator");
- ms = Xen_to_mus_xen(obj);
- move_gen = (mus_any *)(ms->gen);
-
- Xen_check_type(mus_is_move_sound(move_gen), obj, 1, S_move_sound, "a move-sound generator");
- Xen_check_type(Xen_is_integer(loc), loc, 2, S_move_sound, "an integer");
- Xen_check_type(Xen_is_number(val), val, 3, S_move_sound, "a number");
-
- pos = Xen_llong_to_C_llong(loc);
- if (pos < 0)
- Xen_out_of_range_error(S_move_sound, 2, loc, "must be >= 0");
- fval = Xen_real_to_C_double(val);
-
- mus_move_sound(move_gen, pos, fval);
- return(val);
- }
-
-
- static mus_any **xen_vector_to_mus_any_array(Xen vect)
- {
- mus_any **gens;
- mus_long_t i, len;
-
- if (!(Xen_is_vector(vect))) return(NULL);
- len = Xen_vector_length(vect);
- gens = (mus_any **)calloc(len, sizeof(mus_any *));
-
- for (i = 0; i < len; i++)
- if (mus_is_xen(Xen_vector_ref(vect, i)))
- gens[i] = Xen_to_mus_any(Xen_vector_ref(vect, i));
- return(gens);
- }
-
-
- static int *xen_vector_to_int_array(Xen vect)
- {
- int *vals;
- mus_long_t i, len;
-
- len = Xen_vector_length(vect);
- vals = (int *)calloc(len, sizeof(int));
-
- for (i = 0; i < len; i++)
- vals[i] = Xen_integer_to_C_int(Xen_vector_ref(vect, i));
- return(vals);
- }
-
-
- static void clm_move_sound_detour(mus_any *ptr, mus_long_t pos)
- {
- mus_xen *ms;
- ms = (mus_xen *)mus_move_sound_closure(ptr);
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4)
- mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, false);
- }
-
-
- static Xen g_make_move_sound(Xen dloc_list, Xen outp, Xen revp)
- {
- Xen ov = Xen_undefined, rv = Xen_undefined;
- mus_any *ge, *dopdly, *dopenv, *globrevenv = NULL, *output = NULL, *revput = NULL;
- mus_any **out_delays, **out_envs, **rev_envs;
- int *out_map;
- mus_long_t start, end;
- int outchans = 0, revchans = 0;
- Xen ref;
-
- #define H_make_move_sound "(" S_make_move_sound " dloc-list (out *output*) (rev *reverb*)): make a dlocsig run-time generator"
-
- /* dloc-list is (list start end outchans revchans dopdly dopenv revenv outdelays outenvs revenvs outmap) */
- /* outdelays envs and revenvs are vectors */
-
- Xen_check_type(Xen_is_list(dloc_list) && (Xen_list_length(dloc_list) == 11), dloc_list, 1, S_make_move_sound, "a dlocsig list");
-
- if (!Xen_is_bound(outp))
- outp = CLM_OUTPUT;
-
- if (!Xen_is_bound(revp))
- revp = CLM_REVERB;
-
- if (mus_is_xen(outp))
- {
- output = Xen_to_mus_any(outp);
- Xen_check_type(mus_is_output(output), outp, 2, S_make_move_sound, "output stream");
- }
- else
- {
- if ((mus_is_vct(outp)) ||
- (Xen_is_false(outp)) ||
- (!Xen_is_bound(outp)))
- ov = outp;
- else Xen_check_type(false, outp, 2, S_make_move_sound, "output stream, " S_vct ", or a sound-data object");
- }
-
- if (mus_is_xen(revp))
- {
- revput = Xen_to_mus_any(revp);
- Xen_check_type(mus_is_output(revput), revp, 3, S_make_move_sound, "reverb stream");
- }
- else
- {
- if ((mus_is_vct(revp)) ||
- (Xen_is_false(revp)) ||
- (!Xen_is_bound(revp)))
- rv = revp;
- else Xen_check_type(false, revp, 3, S_make_move_sound, "reverb stream, " S_vct ", or a sound-data object");
- }
-
- ref = Xen_list_ref(dloc_list, 0);
- Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[0] (start): a sample number");
- start = Xen_llong_to_C_llong(ref);
-
- ref = Xen_list_ref(dloc_list, 1);
- Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[1] (end): a sample number");
- end = Xen_llong_to_C_llong(ref);
-
- ref = Xen_list_ref(dloc_list, 2);
- Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[2] (outchans): an integer");
- outchans = Xen_integer_to_C_int(ref);
-
- ref = Xen_list_ref(dloc_list, 3);
- Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[3] (revchans): an integer");
- revchans = Xen_integer_to_C_int(ref);
-
- ref = Xen_list_ref(dloc_list, 4);
- Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
- dopdly = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_delay(dopdly), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
-
- ref = Xen_list_ref(dloc_list, 5);
- Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
- dopenv = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_env(dopenv), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
-
- ref = Xen_list_ref(dloc_list, 6);
- Xen_check_type(Xen_is_false(ref) || mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
- if (mus_is_xen(ref))
- {
- globrevenv = Xen_to_mus_any(ref);
- Xen_check_type(mus_is_env(globrevenv), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
- }
-
- ref = Xen_list_ref(dloc_list, 7);
- Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
- ref, 1, S_make_move_sound, "dlocsig list[7] (out delays): a vector of delay gens");
-
- ref = Xen_list_ref(dloc_list, 8);
- Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans)),
- ref, 1, S_make_move_sound, "dlocsig list[8] (out envs): " PROC_FALSE " or a vector of envs");
-
- ref = Xen_list_ref(dloc_list, 9);
- Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= revchans)),
- ref, 1, S_make_move_sound, "dlocsig list[9] (rev envs): " PROC_FALSE " or a vector of envs");
-
- ref = Xen_list_ref(dloc_list, 10);
- Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
- ref, 1, S_make_move_sound, "dlocsig list[10] (out map): vector of ints");
-
- /* put off allocation until all type error checks are done */
-
- out_delays = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 7));
- out_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 8));
- rev_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 9));
- out_map = xen_vector_to_int_array(Xen_list_ref(dloc_list, 10));
-
- ge = mus_make_move_sound(start, end, outchans, revchans,
- dopdly, dopenv, globrevenv,
- out_delays, out_envs, rev_envs, out_map,
- output, revput,
- true, false); /* free outer arrays but not gens */
- if (ge)
- {
- mus_xen *gn;
- if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
- ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
- gn = mx_alloc(4);
- else gn = mx_alloc(1);
- gn->vcts[G_LOCSIG_DATA] = dloc_list; /* it is crucial that the list be gc-protected! */
- if (gn->nvcts == 4)
- {
- mus_move_sound_set_detour(ge, clm_move_sound_detour);
- gn->vcts[G_LOCSIG_OUT] = ov;
- gn->vcts[G_LOCSIG_REVOUT] = rv;
- gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
- mus_set_environ(ge, (void *)gn);
- }
- gn->gen = ge;
- return(mus_xen_to_object(gn));
- }
-
- return(Xen_false);
- }
-
-
-
-
- /* ---------------- src ---------------- */
-
- static Xen xen_one, xen_minus_one;
-
- #if HAVE_SCHEME
- static Xen as_needed_arglist;
-
- static s7_pointer env_symbol, polywave_symbol, triangle_wave_symbol, rand_interp_symbol, oscil_symbol;
- static s7_pointer multiply_symbol, add_symbol, vector_ref_symbol, quote_symbol, cos_symbol, comb_bank_symbol;
-
-
- static mus_float_t as_needed_input_float(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(s7_real(gn->vcts[MUS_INPUT_DATA]));
- }
-
- static mus_float_t as_needed_block_input_float(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- mus_xen *gn = (mus_xen *)ptr;
- mus_float_t val;
- mus_long_t i, lim4;
-
- lim4 = end - 4;
- val = (mus_float_t)s7_real(gn->vcts[MUS_INPUT_DATA]); /* set in the chooser below */
-
- for (i = start; i <= lim4;)
- {
- data[i++] = val;
- data[i++] = val;
- data[i++] = val;
- data[i++] = val;
- }
- for (;i < end; i++)
- data[i] = val;
- return(val);
- }
-
-
- static mus_float_t as_needed_input_any(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- s7_set_car(as_needed_arglist, (direction == 1) ? xen_one : xen_minus_one);
- return(s7_number_to_real(s7, s7_apply_function(s7, gn->vcts[MUS_INPUT_FUNCTION], as_needed_arglist)));
- }
- #endif
-
-
- static mus_float_t as_needed_input_generator(void *ptr, int direction)
- {
- #if HAVE_EXTENSION_LANGUAGE
- return(mus_apply((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), 0.0, 0.0));
- #else
- return(0.0);
- #endif
- }
-
- static mus_float_t as_needed_block_input_generator(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- #if HAVE_EXTENSION_LANGUAGE
- mus_any *g;
- mus_long_t i;
- g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = mus_apply(g, 0.0, 0.0);
- #endif
- return(0.0);
- }
-
-
- static mus_float_t as_needed_input_readin(void *ptr, int direction)
- {
- #if HAVE_EXTENSION_LANGUAGE
- return(mus_readin((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
- #else
- return(0.0);
- #endif
- }
-
- static mus_float_t as_needed_block_input_readin(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- #if HAVE_EXTENSION_LANGUAGE
- mus_any *g;
- mus_long_t i;
- g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = mus_readin(g);
- #endif
- return(0.0);
- }
-
-
- #if USE_SND && HAVE_SCHEME
- static mus_float_t as_needed_input_sampler(void *ptr, int direction)
- {
- return(read_sample((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
- }
-
- static mus_float_t as_needed_block_input_sampler(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- snd_fd *p;
- mus_long_t i;
- p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = read_sample(p);
- return(0.0);
- }
-
-
- mus_float_t read_sample_with_direction(void *p, int dir);
- static mus_float_t as_needed_input_sampler_with_direction(void *ptr, int direction)
- {
- return(read_sample_with_direction((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), direction));
- }
-
- static mus_float_t as_needed_block_input_sampler_with_direction(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- snd_fd *p;
- mus_long_t i;
- p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
- for (i = start; i < end; i++)
- data[i] = read_sample_with_direction(p, direction);
- return(0.0);
- }
- #endif
-
-
- static mus_float_t as_needed_input_func(void *ptr, int direction) /* intended for "as-needed" input funcs */
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- Xen in_obj;
- in_obj = gn->vcts[MUS_INPUT_FUNCTION];
- if (Xen_is_procedure(in_obj))
- return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_INPUT_FUNCTION], (direction == 1) ? xen_one : xen_minus_one)));
- }
- return(0.0);
- }
-
- #if HAVE_SCHEME
- static mus_float_t as_needed_input_rf(void *ptr, int direction)
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- p = top;
- return(rf(s7, &p));
- }
- return(0.0);
- }
-
- static mus_float_t as_needed_block_input_rf(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
- {
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- mus_long_t i;
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- for (i = start; i < end; i++)
- {
- p = top;
- data[i] = rf(s7, &p);
- }
- }
- return(0.0);
- }
- #endif
-
- static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
- {
- /* fprintf(stderr, "set_as_needed_input for %s: %s\n", mus_name(gen), DISPLAY(obj)); */
- if (mus_is_xen(obj)) /* input function is a generator */
- {
- mus_any *p;
- p = Xen_to_mus_any(obj);
- if (p)
- {
- #if HAVE_EXTENSION_LANGUAGE
- gn->vcts[MUS_INPUT_DATA] = (Xen)p;
- #endif
- if (mus_is_readin(p))
- mus_generator_set_feeders(gen, as_needed_input_readin, as_needed_block_input_readin);
- else mus_generator_set_feeders(gen, as_needed_input_generator, as_needed_block_input_generator);
- return;
- }
- }
-
- #if HAVE_SCHEME
- if ((Xen_is_procedure(obj)) &&
- (!Xen_is_procedure(gn->vcts[MUS_ANALYZE_FUNCTION]))) /* this assumes scheme-ready input function at least in phase-vocoder case */
- {
- s7_pointer body;
- body = s7_closure_body(s7, obj);
- if (s7_is_pair(body))
- {
- if (s7_is_null(s7, s7_cdr(body)))
- {
- s7_pointer res;
- res = s7_car(body);
- if (s7_is_real(res))
- {
- gn->vcts[MUS_INPUT_DATA] = res;
- mus_generator_set_feeders(gen, as_needed_input_float, as_needed_block_input_float);
- return;
- }
- if (s7_is_pair(res))
- {
- if (s7_is_symbol(s7_car(res)))
- {
- s7_pointer fcar;
- fcar = s7_symbol_value(s7, s7_car(res));
- if (s7_rf_function(s7, fcar))
- {
- s7_rf_t rf;
- s7_pointer old_e, e;
- e = s7_sublet(s7, s7_closure_let(s7, obj), s7_nil(s7));
- old_e = s7_set_curlet(s7, e);
- s7_xf_new(s7, e);
- rf = s7_rf_function(s7, fcar)(s7, res);
- if (rf)
- {
- gn->vcts[MUS_SAVED_FUNCTION] = gn->vcts[MUS_INPUT_FUNCTION]; /* needed for GC protection */
- gn->vcts[MUS_INPUT_DATA] = (s7_pointer)s7_xf_detach(s7);
- gn->vcts[MUS_INPUT_FUNCTION] = (s7_pointer)rf;
- gn->free_data = true;
- mus_generator_set_feeders(gen, as_needed_input_rf, as_needed_block_input_rf);
- s7_set_curlet(s7, old_e);
- return;
- }
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
- }
- }
- #if USE_SND
- {
- s7_pointer arg;
- arg = s7_car(s7_closure_args(s7, obj));
- if ((arg == s7_caddr(res)) &&
- (s7_car(res) == s7_make_symbol(s7, "read-sample-with-direction")))
- {
- gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(s7_symbol_local_value(s7, s7_cadr(res), s7_closure_let(s7, obj)));
- mus_generator_set_feeders(gen, as_needed_input_sampler_with_direction, as_needed_block_input_sampler_with_direction);
- return;
- }
- }
- #endif
- }
- }
- }
- #if USE_SND
- /* check for a sampler (snd-edits.c) */
- if (is_sampler(obj))
- {
- gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(obj);
- mus_generator_set_feeders(gen, as_needed_input_sampler, as_needed_block_input_sampler);
- return;
- }
- mus_generator_set_feeders(gen, as_needed_input_any, NULL);
- return;
- #endif
- }
- #endif
- mus_generator_set_feeders(gen, as_needed_input_func, NULL);
- }
-
-
- static Xen g_mus_clear_sincs(void)
- {
- mus_clear_sinc_tables();
- return(Xen_false);
- }
-
-
- static Xen g_is_src(Xen obj)
- {
- #define H_is_src "(" S_is_src " gen): " PROC_TRUE " if gen is an " S_src
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_src(Xen_to_mus_any(obj)))));
- }
-
-
- #define SRC_CHANGE_MAX 1000000.0
-
- static Xen g_src(Xen obj, Xen pm, Xen func)
- {
- #define H_src "(" S_src " gen (pm 0.0) input-function): next sampling rate conversion sample. \
- 'pm' can be used to change the sampling rate on a sample-by-sample basis. 'input-function' \
- is a function of one argument (the current input direction, normally ignored) that is called \
- internally whenever a new sample of input data is needed. If the associated " S_make_src " \
- included an 'input' argument, input-function is ignored."
-
- mus_float_t pm1 = 0.0;
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_src, S_src, "an src generator");
- Xen_real_to_C_double_if_bound(pm, pm1, S_src, 2);
-
- /* if sr_change (pm1) is ridiculous, complain! */
- if ((pm1 > SRC_CHANGE_MAX) || (pm1 < -SRC_CHANGE_MAX))
- Xen_out_of_range_error(S_src, 2, pm, "src change too large");
-
- if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_src, 3, func, "src input function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_src(g, pm1, NULL)));
- }
-
- static void set_gn_gen(void *p, mus_any *g)
- {
- mus_xen *gn = (mus_xen *)p;
- gn->gen = g;
- }
-
- static Xen g_make_src(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
- {
- #define H_make_src "(" S_make_src " input (srate 1.0) (width 10)): \
- return a new sampling-rate conversion generator (using 'warped sinc interpolation'). \
- 'srate' is the ratio between the new rate and the old. 'width' is the sine \
- width (effectively the steepness of the low-pass filter), normally between 10 and 100. \
- 'input' if given is an open file stream."
-
- Xen in_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge = NULL;
- int vals, wid = 0; /* 0 here picks up the current default width in clm.c */
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- mus_float_t srate = 1.0;
-
- keys[0] = kw_input;
- keys[1] = kw_srate;
- keys[2] = kw_width;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6;
-
- vals = mus_optkey_unscramble(S_make_src, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_src, orig_arg[0], Xen_undefined, 1, "src input procedure takes 1 arg");
-
- srate = Xen_optkey_to_float(kw_srate, keys[1], S_make_src, orig_arg[1], srate);
- /* srate can be negative => read in reverse */
-
- wid = Xen_optkey_to_int(kw_width, keys[2], S_make_src, orig_arg[2], wid);
- if (wid < 0)
- Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width < 0?");
- if (wid > 2000)
- Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width > 2000?");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- /* mus_make_src assumes it can invoke the input function! */
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
-
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_src_with_init(NULL, srate, wid, gn, set_gn_gen);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- Xen src_obj;
- #if HAVE_SCHEME
- int loc;
- #endif
-
- gn->gen = ge;
- src_obj = mus_xen_to_object(gn);
- #if HAVE_SCHEME
- loc = s7_gc_protect(s7, src_obj);
- #endif
- /* src_init can call an input function which can trigger the GC, so we need to GC-protect the new object */
-
- gn->vcts[MUS_SELF_WRAPPER] = src_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- mus_src_init(ge);
- #if HAVE_SCHEME
- s7_gc_unprotect_at(s7, loc);
- #endif
- return(src_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_src));
- }
-
-
-
-
- /* ---------------- granulate ---------------- */
-
- static Xen g_is_granulate(Xen obj)
- {
- #define H_is_granulate "(" S_is_granulate " gen): " PROC_TRUE " if gen is a " S_granulate " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_granulate(Xen_to_mus_any(obj)))));
- }
-
-
- static int grnedit(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_integer_to_C_int(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static Xen g_granulate(Xen obj, Xen func, Xen edit_func)
- {
- #define H_granulate "(" S_granulate " gen input-func edit-func): next sample from granular synthesis generator"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_granulate, S_granulate, "a granulate generator");
-
- if ((Xen_is_bound(func)) &&
- (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_granulate, 2, func, "granulate input function wants 1 arg");
- }
- if (Xen_is_procedure(edit_func))
- {
- if (Xen_is_aritable(edit_func, 1))
- {
- if (!(Xen_is_bound(gn->vcts[MUS_EDIT_FUNCTION]))) /* default value is Xen_undefined */
- {
- mus_granulate_set_edit_function(gn->gen, grnedit);
- gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
- }
- }
- else Xen_bad_arity_error(S_granulate, 3, edit_func, "granulate edit function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_granulate(g, NULL)));
- }
-
-
- static Xen g_make_granulate(Xen arglist)
- {
- #define H_make_granulate "(" S_make_granulate " input (expansion 1.0) (length .15) (scaler .6) (hop .05) (ramp .4) (jitter 1.0) max-size edit): \
- return a new granular synthesis generator. 'length' is the grain length (seconds), 'expansion' is the ratio in timing \
- between the new and old (expansion > 1.0 slows things down), 'scaler' scales the grains \
- to avoid overflows, 'hop' is the spacing (seconds) between successive grains upon output. \
- 'jitter' controls the randomness in that spacing, 'input' can be a file pointer. 'edit' can \
- be a function of one arg, the current granulate generator. It is called just before \
- a grain is added into the output buffer. The current grain is accessible via " S_mus_data ". \
- The edit function, if any, should return the length in samples of the grain, or 0."
-
- Xen in_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge;
- Xen args[18];
- Xen keys[9];
- int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, 0, 0};
- int vals, maxsize = 0;
- mus_float_t expansion = 1.0, segment_length = .15, segment_scaler = .6, ramp_time = .4, output_hop = .05;
- mus_float_t jitter = 1.0;
- Xen edit_obj = Xen_undefined, grn_obj;
-
- keys[0] = kw_input;
- keys[1] = kw_expansion;
- keys[2] = kw_length;
- keys[3] = kw_scaler;
- keys[4] = kw_hop;
- keys[5] = kw_ramp;
- keys[6] = kw_jitter;
- keys[7] = kw_max_size;
- keys[8] = kw_edit;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 18) clm_error(S_make_granulate, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 18; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_granulate, 9, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_granulate, orig_arg[0], Xen_undefined, 1, "granulate input procedure takes 1 arg");
-
- expansion = Xen_optkey_to_float(kw_expansion, keys[1], S_make_granulate, orig_arg[1], expansion);
- if (expansion <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[1], keys[1], "expansion <= 0.0?");
-
- segment_length = Xen_optkey_to_float(kw_length, keys[2], S_make_granulate, orig_arg[2], segment_length);
- if (segment_length <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[2], keys[2], "segment-length <= 0.0?");
-
- segment_scaler = Xen_optkey_to_float(kw_scaler, keys[3], S_make_granulate, orig_arg[3], segment_scaler);
- if (segment_scaler == 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[3], keys[3], "segment-scaler should be greater than 0.0?");
-
- output_hop = Xen_optkey_to_float(kw_hop, keys[4], S_make_granulate, orig_arg[4], output_hop);
- if (output_hop <= 0.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop <= 0?");
- if (output_hop > 3600.0)
- Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop > 3600?");
- if ((segment_length + output_hop) > 60.0) /* multiplied by srate in mus_make_granulate in array allocation */
- Xen_out_of_range_error(S_make_granulate, orig_arg[2], Xen_list_2(keys[2], keys[4]), "segment_length + output_hop too large!");
-
- ramp_time = Xen_optkey_to_float(kw_ramp, keys[5], S_make_granulate, orig_arg[5], ramp_time);
- if ((ramp_time < 0.0) || (ramp_time > 0.5))
- Xen_out_of_range_error(S_make_granulate, orig_arg[5], keys[5], "ramp must be between 0.0 and 0.5");
-
- jitter = Xen_optkey_to_float(kw_jitter, keys[6], S_make_granulate, orig_arg[6], jitter);
- Xen_check_type((jitter >= 0.0) && (jitter < 100.0), keys[6], orig_arg[6], S_make_granulate, "0.0 .. 100.0");
-
- maxsize = Xen_optkey_to_int(kw_max_size, keys[7], S_make_granulate, orig_arg[7], maxsize);
- if ((maxsize > mus_max_malloc()) ||
- (maxsize < 0) ||
- ((maxsize == 0) && (!Xen_is_keyword(keys[7]))))
- Xen_out_of_range_error(S_make_granulate, orig_arg[7], keys[7], "max-size invalid");
-
- edit_obj = mus_optkey_to_procedure(keys[8], S_make_granulate, orig_arg[8], Xen_undefined, 1, "granulate edit procedure takes 1 arg");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_granulate(NULL,
- expansion, segment_length, segment_scaler, output_hop, ramp_time, jitter, maxsize,
- (!Xen_is_bound(edit_obj) ? NULL : grnedit),
- (void *)gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- gn->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(ge), mus_data(ge));
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
- gn->gen = ge;
- grn_obj = mus_xen_to_object(gn);
- gn->vcts[MUS_SELF_WRAPPER] = grn_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(grn_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_granulate));
- }
-
-
-
-
- /* ---------------- convolve ---------------- */
-
- static Xen g_is_convolve(Xen obj)
- {
- #define H_is_convolve "(" S_is_convolve " gen): " PROC_TRUE " if gen is a " S_convolve " generator"
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_convolve(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_convolve(Xen obj, Xen func)
- {
- #define H_convolve_gen "(" S_convolve " gen input-func): next sample from convolution generator"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_convolve, S_convolve, "a convolve generator");
-
- if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
- {
- if (Xen_is_procedure(func))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else Xen_bad_arity_error(S_convolve, 2, func, "convolve input function wants 1 arg");
- }
- }
- return(C_double_to_Xen_real(mus_convolve(g, NULL)));
- }
-
-
- /* filter-size? */
-
- static Xen g_make_convolve(Xen arglist)
- {
- #define H_make_convolve "(" S_make_convolve " input filter fft-size): \
- return a new convolution generator which convolves its input with the impulse response 'filter'."
-
- mus_xen *gn;
- mus_any *ge;
- Xen args[6];
- Xen keys[3];
- int orig_arg[3] = {0, 0, 0};
- int vals;
- vct *filter = NULL;
- Xen filt = Xen_undefined, in_obj = Xen_undefined;
- mus_long_t fftlen, fft_size = 0;
-
- keys[0] = kw_input;
- keys[1] = kw_filter;
- keys[2] = kw_fft_size;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 6) clm_error(S_make_convolve, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_convolve, 3, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_convolve, orig_arg[0], Xen_undefined, 1, "convolve input procedure takes 1 arg");
-
- filter = mus_optkey_to_vct(keys[1], S_make_convolve, orig_arg[1], NULL);
- if (filter) filt = keys[1];
-
- fft_size = Xen_optkey_to_mus_long_t(kw_fft_size, keys[2], S_make_convolve, orig_arg[2], fft_size);
- if ((fft_size < 0) ||
- ((fft_size == 0) && (!Xen_is_keyword(keys[2]))) ||
- (fft_size > mus_max_malloc()))
- Xen_out_of_range_error(S_make_convolve, orig_arg[2], keys[2], "fft-size invalid (see mus-max-malloc))");
- }
-
- if (filter == NULL)
- Xen_error(NO_DATA,
- Xen_list_1(C_string_to_Xen_string(S_make_convolve ": no impulse (filter)?")));
-
- if (is_power_of_2(mus_vct_length(filter)))
- fftlen = mus_vct_length(filter) * 2;
- else fftlen = (mus_long_t)pow(2.0, 1 + (int)(log((mus_float_t)(mus_vct_length(filter) + 1)) / log(2.0)));
- if (fft_size < fftlen) fft_size = fftlen;
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_convolve(NULL, mus_vct_data(filter), fft_size, mus_vct_length(filter), gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- Xen c_obj;
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_ANALYZE_FUNCTION] = filt; /* why is this here? GC protection? (might be a locally-allocated vct as from file->vct) */
- gn->gen = ge;
- c_obj = mus_xen_to_object(gn);
- gn->vcts[MUS_SELF_WRAPPER] = c_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(c_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_convolve));
- }
-
-
- static Xen g_convolve_files(Xen file1, Xen file2, Xen maxamp, Xen outfile)
- {
- #define H_convolve_files "(" S_convolve_files " file1 file2 maxamp output-file): convolve \
- file1 and file2 writing outfile after scaling the convolution result to maxamp."
-
- const char *f1, *f2, *f3;
- mus_float_t maxval = 1.0;
-
- Xen_check_type(Xen_is_string(file1), file1, 1, S_convolve_files, "a string");
- Xen_check_type(Xen_is_string(file2), file2, 2, S_convolve_files, "a string");
- Xen_check_type(Xen_is_number_or_unbound(maxamp), maxamp, 3, S_convolve_files, "a number");
- Xen_check_type((!Xen_is_bound(outfile)) || (Xen_is_string(outfile)), outfile, 4, S_convolve_files, "a string");
-
- f1 = Xen_string_to_C_string(file1);
- f2 = Xen_string_to_C_string(file2);
- if (Xen_is_string(outfile))
- f3 = Xen_string_to_C_string(outfile);
- else f3 = "tmp.snd";
- if (Xen_is_number(maxamp))
- maxval = Xen_real_to_C_double(maxamp);
-
- mus_convolve_files(f1, f2, maxval, f3);
- return(C_string_to_Xen_string(f3));
- }
-
-
-
-
- /* ---------------- phase-vocoder ---------------- */
-
- /* pvedit pvanalyze pvsynthesize:
- * these three functions provide a path for the call (clm.c) (*(pv->edit))(pv->closure)
- * which is calling a user-supplied edit function within the particular phase-vocoder
- * generator's context. "closure" is an uninterpreted void pointer passed in by the
- * user, and passed here as the edit function argument. In this file, pv->edit is
- * &pvedit, and (void *)ptr is closure; in make_phase_vocoder we set closure to be
- * the mus_xen object that shadows the phase-vocoder generator, with two special
- * pointers in the vcts field: vcts[MUS_EDIT_FUNCTION] is the (Scheme-side) function
- * passed by the user, and vcts[MUS_SELF_WRAPPER] is a pointer to the (Scheme-relevant)
- * object that packages the mus_xen pointer for Scheme. This way, the user's
- * (make-phase-vocoder ... (lambda (v) (mus-length v)) ...)
- * treats v as the current pv gen, vcts[MUS_SELF_WRAPPER] = v, vcts[MUS_EDIT_FUNCTION] =
- * the lambda form, mus_xen obj->gen is the C-side pv struct pointer. See above
- * under as_needed_input_func for more verbiage. (All this complication arises because clm.c
- * is pure C -- no notion that Scheme might be the caller, and the user's pv.scm
- * or whatever is pure Scheme -- no notion that C is actually doing the work,
- * and we have to tie everything together here including the Scheme-C-Scheme-C
- * call chains).
- */
-
- static int pvedit(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static mus_float_t pvsynthesize(void *ptr)
- {
- mus_xen *gn = (mus_xen *)ptr;
- return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_SYNTHESIZE_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
- }
-
-
- static bool pvanalyze(void *ptr, mus_float_t (*input)(void *arg1, int direction))
- {
- mus_xen *gn = (mus_xen *)ptr;
- /* we can only get input func if it's already set up by the outer gen call, so (?) we can use that function here.
- * but the gc might be called during this call, and scan the args, so the input function should be
- * in the arg list only if its a legit pointer?
- */
- return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_2_args(gn->vcts[MUS_ANALYZE_FUNCTION],
- gn->vcts[MUS_SELF_WRAPPER],
- gn->vcts[MUS_INPUT_FUNCTION])));
- }
-
-
- static Xen g_is_phase_vocoder(Xen obj)
- {
- #define H_is_phase_vocoder "(" S_is_phase_vocoder " gen): " PROC_TRUE " if gen is an " S_phase_vocoder
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_phase_vocoder(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_phase_vocoder(Xen obj, Xen func, Xen analyze_func, Xen edit_func, Xen synthesize_func)
- {
- #define H_phase_vocoder "(" S_phase_vocoder " gen input-function analyze-func edit-func synthesize-func): next phase vocoder value"
- mus_xen *gn;
- mus_any *g = NULL;
-
- Xen_to_C_generator(obj, gn, g, mus_is_phase_vocoder, S_phase_vocoder, "a phase-vocoder generator");
-
- if (Xen_is_bound(func))
- {
- bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)) = NULL;
- int (*edit)(void *arg) = NULL;
- mus_float_t (*synthesize)(void *arg) = NULL;
-
- if ((Xen_is_procedure(func)) &&
- (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
- {
- if (Xen_is_aritable(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func; /* as_needed_input_func set at make time will pick this up */
- else Xen_bad_arity_error(S_phase_vocoder, 2, func, S_phase_vocoder " input function wants 1 arg");
- }
- if (Xen_is_procedure(analyze_func))
- {
- if (Xen_is_aritable(analyze_func, 2))
- {
- gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_func;
- analyze = pvanalyze;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 3, analyze_func, S_phase_vocoder " analyze function wants 2 args");
- }
- if (Xen_is_procedure(edit_func))
- {
- if (Xen_is_aritable(edit_func, 1))
- {
- gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
- edit = pvedit;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 4, edit_func, S_phase_vocoder " edit function wants 1 arg");
- }
- if (Xen_is_procedure(synthesize_func))
- {
- if (Xen_is_aritable(synthesize_func, 1))
- {
- gn->vcts[MUS_SYNTHESIZE_FUNCTION] = synthesize_func;
- synthesize = pvsynthesize;
- }
- else Xen_bad_arity_error(S_phase_vocoder, 5, synthesize_func, S_phase_vocoder " synthesize function wants 1 arg");
- }
- return(C_double_to_Xen_real(mus_phase_vocoder_with_editors(g, NULL, analyze, edit, synthesize)));
- }
- return(C_double_to_Xen_real(mus_phase_vocoder(g, NULL)));
- }
-
-
- static Xen g_make_phase_vocoder(Xen arglist)
- {
- #if HAVE_SCHEME
- #define pv_example "(" S_make_phase_vocoder " #f 512 4 256 1.0 #f #f #f)"
- #define pv_edit_example "(" S_make_phase_vocoder " #f 512 4 256 1.0\n\
- (lambda (v infunc) (snd-print \"analyzing\") #t)\n\
- (lambda (v) (snd-print \"editing\") #t)\n\
- (lambda (v) (snd-print \"resynthesizing\") 0.0))"
- #endif
- #if HAVE_RUBY
- #define pv_example "make_phase_vocoder(false, 512, 4, 256, 1.0, false, false, false)"
- #define pv_edit_example "make_phase_vocoder(false, 512, 4, 256, 1.0,\n\
- lambda do | v, infunc | snd_print(\"analyzing\"); true end,\n\
- lambda do | v | snd_print(\"editing\"); true end,\n\
- lambda do | v | snd_print(\"resynthesizing\"); 0.0 end)"
- #endif
- #if HAVE_FORTH
- #define pv_example "#f 512 4 256 1.0 #f #f #f " S_make_phase_vocoder
- #define pv_edit_example "#f 512 4 256 1.0\n\
- lambda: <{ v infunc -- f }> \"analyzing\" snd-print drop #t ;\n\
- lambda: <{ v -- n }> \"editing\" snd-print drop #t ;\n\
- lambda: <{ v -- r }> \"resynthesizing\" snd-print drop 0.0 ; " S_make_phase_vocoder
- #endif
-
- #define H_make_phase_vocoder "(" S_make_phase_vocoder " input fft-size overlap interp pitch analyze edit synthesize): \
- return a new phase-vocoder generator; input is the input function (it can be set at run-time), analyze, edit, \
- and synthesize are either " PROC_FALSE " or functions that replace the default innards of the generator, fft-size, overlap \
- and interp set the fftsize, the amount of overlap between ffts, and the time between new analysis calls. \
- 'analyze', if given, takes 2 args, the generator and the input function; if it returns " PROC_TRUE ", the default analysis \
- code is also called. 'edit', if given, takes 1 arg, the generator; if it returns " PROC_TRUE ", the default edit code \
- is run. 'synthesize' is a function of 1 arg, the generator; it is called to get the current vocoder \
- output. \n\n " pv_example "\n\n " pv_edit_example
-
- Xen in_obj = Xen_undefined, edit_obj = Xen_undefined, synthesize_obj = Xen_undefined, analyze_obj = Xen_undefined;
- mus_xen *gn;
- mus_any *ge;
- Xen args[16];
- Xen keys[8];
- Xen pv_obj;
- int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
- int vals;
- int fft_size = 512, overlap = 4, interp = 128;
- mus_float_t pitch = 1.0;
-
- keys[0] = kw_input;
- keys[1] = kw_fft_size;
- keys[2] = kw_overlap;
- keys[3] = kw_interp;
- keys[4] = kw_pitch;
- keys[5] = kw_analyze;
- keys[6] = kw_edit;
- keys[7] = kw_synthesize;
-
- {
- int i, arglist_len;
- Xen p;
- arglist_len = Xen_list_length(arglist);
- if (arglist_len > 16) clm_error(S_make_phase_vocoder, "too many arguments!", arglist);
- for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
- for (i = arglist_len; i < 16; i++) args[i] = Xen_undefined;
- }
-
- vals = mus_optkey_unscramble(S_make_phase_vocoder, 8, keys, args, orig_arg);
- if (vals > 0)
- {
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_phase_vocoder, orig_arg[0], Xen_undefined, 1, S_phase_vocoder " input procedure takes 1 arg");
-
- fft_size = Xen_optkey_to_int(kw_fft_size, keys[1], S_make_phase_vocoder, orig_arg[1], fft_size);
- if (fft_size <= 1)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size <= 1?");
- if (fft_size > mus_max_malloc())
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size too large (see mus-max-malloc)");
- if (!is_power_of_2(fft_size))
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size must be power of 2");
-
- overlap = Xen_optkey_to_int(kw_overlap, keys[2], S_make_phase_vocoder, orig_arg[2], overlap);
- if (overlap <= 0)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[2], keys[2], "overlap <= 0?");
-
- interp = Xen_optkey_to_int(kw_interp, keys[3], S_make_phase_vocoder, orig_arg[3], interp);
- if (interp <= 0)
- Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[3], keys[3], "interp <= 0?");
-
- pitch = Xen_optkey_to_float(kw_pitch, keys[4], S_make_phase_vocoder, orig_arg[4], pitch);
-
- analyze_obj = mus_optkey_to_procedure(keys[5], S_make_phase_vocoder, orig_arg[5], Xen_undefined, 2, S_phase_vocoder " analyze procedure takes 2 args");
- edit_obj = mus_optkey_to_procedure(keys[6], S_make_phase_vocoder, orig_arg[6], Xen_undefined, 1, S_phase_vocoder " edit procedure takes 1 arg");
- synthesize_obj = mus_optkey_to_procedure(keys[7], S_make_phase_vocoder, orig_arg[7], Xen_undefined, 1, S_phase_vocoder " synthesize procedure takes 1 arg");
- }
-
- gn = mx_alloc(MUS_MAX_VCTS);
- {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
- {
- mus_error_handler_t *old_error_handler;
- old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_phase_vocoder(NULL,
- fft_size, overlap, interp, pitch,
- (!Xen_is_bound(analyze_obj) ? NULL : pvanalyze),
- (!Xen_is_bound(edit_obj) ? NULL : pvedit),
- (!Xen_is_bound(synthesize_obj) ? NULL : pvsynthesize),
- (void *)gn);
- mus_error_set_handler(old_error_handler);
- }
-
- if (ge)
- {
- gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
- gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_obj;
- gn->vcts[MUS_SYNTHESIZE_FUNCTION] = synthesize_obj;
- gn->gen = ge;
- pv_obj = mus_xen_to_object(gn);
- /* need scheme-relative backpointer for possible function calls */
- gn->vcts[MUS_SELF_WRAPPER] = pv_obj;
- set_as_needed_input_choices(ge, in_obj, gn);
- return(pv_obj);
- }
-
- free(gn->vcts);
- free(gn);
- return(clm_mus_error(local_error_type, local_error_msg, S_make_phase_vocoder));
- }
-
-
- static Xen g_phase_vocoder_amps(Xen pv)
- {
- #define H_phase_vocoder_amps "(" S_phase_vocoder_amps " gen): " S_vct " containing the current output sinusoid amplitudes"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amps, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_amps(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
- static Xen g_phase_vocoder_freqs(Xen pv)
- {
- #define H_phase_vocoder_freqs "(" S_phase_vocoder_freqs " gen): " S_vct " containing the current output sinusoid frequencies"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_freqs, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_freqs(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len, amps));
- }
-
-
- static Xen g_phase_vocoder_phases(Xen pv)
- {
- #define H_phase_vocoder_phases "(" S_phase_vocoder_phases " gen): " S_vct " containing the current output sinusoid phases"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phases, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_phases(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
- static Xen g_phase_vocoder_amp_increments(Xen pv)
- {
- #define H_phase_vocoder_amp_increments "(" S_phase_vocoder_amp_increments " gen): " S_vct " containing the current output sinusoid amplitude increments per sample"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amp_increments, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_amp_increments(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len, amps));
- }
-
-
- static Xen g_phase_vocoder_phase_increments(Xen pv)
- {
- #define H_phase_vocoder_phase_increments "(" S_phase_vocoder_phase_increments " gen): " S_vct " containing the current output sinusoid phase increments"
- mus_float_t *amps;
- int len;
- mus_xen *gn;
-
- Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phase_increments, "a " S_phase_vocoder " generator");
-
- gn = Xen_to_mus_xen(pv);
- amps = mus_phase_vocoder_phase_increments(gn->gen);
- len = (int)mus_length(gn->gen);
- return(xen_make_vct_wrapper(len / 2, amps));
- }
-
-
-
-
- /* -------- ssb-am -------- */
-
- static Xen g_is_ssb_am(Xen obj)
- {
- #define H_is_ssb_am "(" S_is_ssb_am " gen): " PROC_TRUE " if gen is a " S_ssb_am
- return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_ssb_am(Xen_to_mus_any(obj)))));
- }
-
-
- static Xen g_make_ssb_am(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
- {
- #define H_make_ssb_am "(" S_make_ssb_am " (frequency *clm-default-frequency*) (order 40)): \
- return a new " S_ssb_am " generator."
- #define MUS_MAX_SSB_ORDER 65536
-
- mus_any *ge;
- Xen args[4];
- Xen keys[2];
- int orig_arg[2] = {0, 0};
- int vals;
- int order = 40;
- mus_float_t freq;
-
- freq = clm_default_frequency;
-
- keys[0] = kw_frequency;
- keys[1] = kw_order;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
-
- vals = mus_optkey_unscramble(S_make_ssb_am, 2, keys, args, orig_arg);
- if (vals > 0)
- {
- freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ssb_am, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[0], keys[0], "freq > srate/2?");
-
- order = Xen_optkey_to_int(kw_order, keys[1], S_make_ssb_am, orig_arg[1], order);
- if (order <= 0)
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order <= 0?");
- if (order > MUS_MAX_SSB_ORDER)
- Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order too large?");
- }
-
- ge = mus_make_ssb_am(freq, order);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(Xen_false);
- }
-
-
- static Xen g_ssb_am(Xen obj, Xen insig, Xen fm)
- {
- #define H_ssb_am "(" S_ssb_am " gen (insig 0.0) (fm 0.0)): get the next sample from " S_ssb_am " generator"
-
- mus_float_t insig1 = 0.0;
- mus_any *g = NULL;
- mus_xen *gn;
-
- Xen_to_C_generator(obj, gn, g, mus_is_ssb_am, S_ssb_am, "an ssb-am generator");
- Xen_real_to_C_double_if_bound(insig, insig1, S_ssb_am, 2);
-
- if (Xen_is_bound(fm))
- {
- Xen_check_type(Xen_is_number(fm), fm, 3, S_ssb_am, "a number");
- return(C_double_to_Xen_real(mus_ssb_am(g, insig1, Xen_real_to_C_double(fm))));
- }
- return(C_double_to_Xen_real(mus_ssb_am_unmodulated(g, insig1)));
- }
-
-
- #define S_mus_frandom "mus-frandom"
- #define S_mus_irandom "mus-irandom"
-
- static Xen g_mus_frandom(Xen val)
- {
- return(C_double_to_Xen_real(mus_frandom(Xen_real_to_C_double_with_caller(val, S_mus_frandom))));
- }
-
- static Xen g_mus_irandom(Xen val)
- {
- mus_long_t ind;
- Xen_to_C_integer_or_error(val, ind, S_mus_irandom, 1);
- return(C_int_to_Xen_integer(mus_irandom(ind)));
- }
-
-
- static Xen mus_clm_output(void);
- static Xen mus_clm_reverb(void);
-
-
-
- /* Xen out, Xen in, Xen ost, Xen olen, Xen ist, Xen mx, Xen envs */
- static Xen g_mus_file_mix(Xen args)
- {
- #define H_mus_file_mix "(" S_mus_file_mix " outfile infile (outloc 0) (framples) (inloc 0) matrix envs): \
- mix infile into outfile starting at outloc in outfile and inloc in infile \
- mixing 'framples' framples into 'outfile'. framples defaults to the length of infile. If matrix, \
- use it to scale the various channels; if envs (an array of envelope generators), use \
- it in conjunction with matrix to scale/envelope all the various ins and outs. \
- 'outfile' can also be a " S_frample_to_file " generator, and 'infile' can be a " S_file_to_frample " generator."
-
- Xen arg, out, in;
- mus_any *outf = NULL, *inf = NULL;
- mus_float_t *matrix = NULL;
- mus_any ***envs1 = NULL;
- int i;
- mus_long_t ostart = 0, istart = 0, osamps = 0;
- int in_chans = 0, out_chans = 0, mx_chans = 0, in_size = 0; /* mus_mix in clm.c assumes the envs array is large enough */
- const char *outfile = NULL, *infile = NULL;
-
- /* -------- setup output gen -------- */
- arg = args;
- out = Xen_car(arg);
- Xen_check_type(Xen_is_string(out) || ((mus_is_xen(out)) && (mus_is_output(Xen_to_mus_any(out)))),
- out, 1, S_mus_file_mix, "a filename or a " S_frample_to_file " generator");
- if (Xen_is_string(out))
- {
- outfile = Xen_string_to_C_string(out);
- if (!mus_file_probe(outfile))
- Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), out));
- out_chans = mus_sound_chans(outfile);
- if (out_chans <= 0)
- Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S output chans <= 0"), out));
- }
- else
- {
- outf = Xen_to_mus_any(out);
- out_chans = mus_channels(outf);
- }
-
- /* -------- setup input gen -------- */
- arg = Xen_cdr(arg);
- in = Xen_car(arg);
- Xen_check_type(Xen_is_string(in) || ((mus_is_xen(in)) && (mus_is_input(Xen_to_mus_any(in)))),
- in, 2, S_mus_file_mix, "a filename or a " S_file_to_frample " generator");
- if (Xen_is_string(in))
- {
- infile = Xen_string_to_C_string(in);
- if (!mus_file_probe(infile))
- Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), in));
- in_chans = mus_sound_chans(infile);
- if (in_chans <= 0)
- Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S input chans <= 0"), in));
- osamps = mus_sound_framples(infile);
- }
- else
- {
- inf = Xen_to_mus_any(in);
- in_chans = mus_channels(inf);
- osamps = mus_length(inf);
- }
-
- /* inf and outf only exist during the rest of the arglist scan if not infile or outfile.
- * we need to delay making the inf/outf gens in this case to greatly simplify error handling.
- */
-
- /* rest of args are optional */
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen ost;
- ost = Xen_car(arg);
- Xen_check_type(Xen_is_integer(ost), ost, 3, S_mus_file_mix, "an integer");
- ostart = Xen_llong_to_C_llong(ost);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen olen;
- olen = Xen_car(arg);
- Xen_check_type(Xen_is_integer(olen), olen, 4, S_mus_file_mix, "an integer");
- osamps = Xen_llong_to_C_llong(olen);
- if (osamps <= 0) return(Xen_false);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen ist;
- ist = Xen_car(arg);
- Xen_check_type(Xen_is_integer(ist), ist, 5, S_mus_file_mix, "an integer");
- istart = Xen_llong_to_C_llong(ist);
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen mx;
- mx = Xen_car(arg);
- Xen_check_type((mus_is_vct(mx)) || (Xen_is_false(mx)), mx, 6, S_mus_file_mix, "a " S_vct);
- if (mus_is_vct(mx))
- {
- matrix = mus_vct_data(Xen_to_vct(mx));
- mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
- }
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- Xen envs;
- envs = Xen_car(arg);
- Xen_check_type((Xen_is_false(envs)) || (Xen_is_vector(envs)), envs, 7, S_mus_file_mix, "a vector of envs");
- if (Xen_is_vector(envs))
- {
- int in_len = 0, out_len, j, out_size;
- /* pack into a C-style array of arrays of env pointers */
- in_len = Xen_vector_length(envs);
- if (in_len == 0)
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": env vector, ~A, can't be empty"), envs));
-
- for (i = 0; i < in_len; i++)
- {
- Xen datum;
- datum = Xen_vector_ref(envs, i);
- if (!(Xen_is_vector(datum)))
- Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A, must contain vectors of envelopes"), datum));
- }
-
- out_len = Xen_vector_length(Xen_vector_ref(envs, 0));
- if (in_len < in_chans) in_size = in_chans; else in_size = in_len;
- if (out_len < out_chans) out_size = out_chans; else out_size = out_len;
-
- envs1 = (mus_any ***)malloc(in_size * sizeof(mus_any **));
- for (i = 0; i < in_size; i++)
- envs1[i] = (mus_any **)calloc(out_size, sizeof(mus_any *));
-
- for (i = 0; i < in_len; i++)
- for (j = 0; j < out_len; j++)
- {
- Xen datum1;
- datum1 = Xen_vector_ref(Xen_vector_ref(envs, i), j);
- if (mus_is_xen(datum1))
- {
- if (mus_is_env(Xen_to_mus_any(datum1)))
- envs1[i][j] = Xen_to_mus_any(datum1);
- else
- {
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- Xen_error(BAD_TYPE, Xen_list_4(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A at ~A ~A, must contain an envelope"),
- datum1,
- C_int_to_Xen_integer(i),
- C_int_to_Xen_integer(j)));
- }
- }
- }
- }
- }
- }
- }
- }
- }
-
- if ((infile) && (outfile))
- mus_file_mix(outfile, infile, ostart, osamps, istart, matrix, mx_chans, envs1);
- else
- {
- if (infile)
- inf = mus_make_file_to_frample(infile);
- if (outfile)
- outf = mus_continue_sample_to_file(outfile);
- mus_file_mix_with_reader_and_writer(outf, inf, ostart, osamps, istart, matrix, mx_chans, envs1);
- if (infile)
- mus_free((mus_any *)inf);
- if (outfile)
- mus_free((mus_any *)outf);
- }
- if (envs1)
- {
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- }
- return(Xen_true);
- }
-
-
- /* Xen file, Xen beg, Xen dur, Xen mx, Xen revmx, Xen envs, Xen srcs, Xen srcenv, Xen outstream, Xen revstream */
-
- static Xen g_mus_file_mix_with_envs(Xen args)
- {
- #define H_mus_file_mix_with_envs "(" S_mus_file_mix_with_envs " file beg dur mx revmx envs srcs srcenv out rev) is an extension of " S_mus_file_mix ", primarily \
- intended to speed up the fullmix instrument. file is a vector of readin generators. beg is the sample at which to start mixing \
- output, dur is the number of samples to write. mx is a matrix, revmx is either #f or a matrix. "
-
- int i, in_chans, out_chans, mx_chans = 0, rev_chans = 0, rev_mix_chans = 0;
- mus_long_t st, nd;
- mus_any *s_env = NULL, *ostr, *rstr = NULL;
- mus_any **mix_envs, **mix_srcs, **mix_rds;
- mus_xen *gn;
- Xen ve, arg, file, beg, dur, mx, revmx, envs, srcs, srcenv, outstream, revstream;
- mus_float_t *mix = NULL, *rev_mix = NULL;
-
- i = Xen_list_length(args);
- if ((i < 8) || (i > 10)) /* no wrong-number-of-args error in xen.h, so I'll use out-of-range */
- Xen_out_of_range_error(S_mus_file_mix_with_envs, 0, args, "wrong number of args");
-
- arg = args;
- file = Xen_car(arg);
- Xen_check_type(Xen_is_vector(file), file, 1, S_mus_file_mix_with_envs, "a vector of readin generators");
- in_chans = Xen_vector_length(file);
-
- arg = Xen_cdr(arg);
- beg = Xen_car(arg);
- Xen_check_type(Xen_is_integer(beg), beg, 2, S_mus_file_mix_with_envs, "an integer");
- st = Xen_integer_to_C_int(beg);
-
- arg = Xen_cdr(arg);
- dur = Xen_car(arg);
- Xen_check_type(Xen_is_integer(dur), dur, 3, S_mus_file_mix_with_envs, "an integer");
- nd = st + Xen_integer_to_C_int(dur);
-
- arg = Xen_cdr(arg);
- mx = Xen_car(arg);
- if (mus_is_vct(mx))
- {
- mix = mus_vct_data(Xen_to_vct(mx));
- mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
- }
-
- arg = Xen_cdr(arg);
- revmx = Xen_car(arg);
- if (mus_is_vct(revmx))
- {
- rev_mix = mus_vct_data(Xen_to_vct(revmx));
- rev_mix_chans = (int)sqrt(mus_vct_length(Xen_to_vct(revmx)));
- }
-
- arg = Xen_cdr(arg);
- envs = Xen_car(arg);
- if (!Xen_is_false(envs))
- Xen_check_type(Xen_is_vector(envs), envs, 6, S_mus_file_mix_with_envs, "a vector of env generators");
-
- arg = Xen_cdr(arg);
- srcs = Xen_car(arg);
- if (!Xen_is_false(srcs))
- Xen_check_type(Xen_is_vector(srcs), srcs, 7, S_mus_file_mix_with_envs, "a vector of src generators");
-
- arg = Xen_cdr(arg);
- srcenv = Xen_car(arg);
- if (!Xen_is_false(srcenv))
- {
- gn = (mus_xen *)Xen_object_ref_checked(srcenv, mus_xen_tag);
- if (!gn) Xen_check_type(false, srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
- s_env = gn->gen;
- Xen_check_type(mus_is_env(s_env), srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
- }
-
- revstream = Xen_false;
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- {
- outstream = Xen_car(arg);
- gn = (mus_xen *)Xen_object_ref_checked(outstream, mus_xen_tag);
- if (!gn)
- Xen_check_type(false, outstream, 9, S_mus_file_mix_with_envs, "an output generator");
- ostr = gn->gen;
-
- arg = Xen_cdr(arg);
- if (!Xen_is_null(arg))
- revstream = Xen_car(arg);
- }
- else ostr = Xen_to_mus_any(mus_clm_output());
- out_chans = mus_channels(ostr);
-
- if (rev_mix)
- {
- if (!Xen_is_false(revstream))
- {
- gn = (mus_xen *)Xen_object_ref_checked(revstream, mus_xen_tag);
- if (!gn)
- Xen_check_type(false, revstream, 10, S_mus_file_mix_with_envs, "an output generator");
- rstr = gn->gen;
- }
- else rstr = Xen_to_mus_any(mus_clm_reverb());
- rev_chans = mus_channels(rstr);
- }
-
- mix_rds = (mus_any **)calloc(in_chans, sizeof(mus_any *));
- mix_srcs = (mus_any **)calloc(in_chans, sizeof(mus_any *));
-
- for (i = 0; i < in_chans; i++)
- mix_rds[i] = Xen_to_mus_any(Xen_vector_ref(file, i));
-
- if (Xen_is_vector(srcs))
- {
- for (i = 0; i < in_chans; i++)
- {
- ve = Xen_vector_ref(srcs, i);
- if (!Xen_is_false(ve)) mix_srcs[i] = Xen_to_mus_any(ve);
- }
- }
-
- mix_envs = (mus_any **)calloc(in_chans * out_chans, sizeof(mus_any *));
- if (Xen_is_vector(envs))
- for (i = 0; i < in_chans * out_chans; i++)
- {
- ve = Xen_vector_ref(envs, i);
- if (!Xen_is_false(ve)) mix_envs[i] = Xen_to_mus_any(ve);
- }
-
- {
- mus_long_t samp;
- int outp;
- mus_float_t src_env_val = 0.0;
- mus_float_t *infs, *out_frample, *rev_frample = NULL;
-
- infs = (mus_float_t *)calloc(in_chans, sizeof(mus_float_t));
- out_frample = (mus_float_t *)calloc(out_chans, sizeof(mus_float_t));
- if (rev_mix) rev_frample = (mus_float_t *)calloc(rev_chans, sizeof(mus_float_t));
-
- if (in_chans == 1)
- {
- mus_any *s = NULL, *r = NULL;
- s = mix_srcs[0];
- if (!s) r = mix_rds[0];
-
- for (samp = st; samp < nd; samp++)
- {
- for (outp = 0; outp < out_chans; outp++)
- {
- mus_any *e;
- e = mix_envs[outp];
- if (e)
- mix[outp] = mus_env(e);
- }
- if (s_env)
- src_env_val = mus_env(s_env);
- if (s)
- infs[0] = mus_src(s, src_env_val, NULL);
- else
- {
- if (r)
- infs[0] = mus_readin(r);
- else infs[0] = 0.0;
- }
- mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
- if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
- }
- }
- else
- {
- for (samp = st; samp < nd; samp++)
- {
- int inp, off;
- for (inp = 0, off = 0; inp < in_chans; inp++, off += mx_chans)
- for (outp = 0; outp < out_chans; outp++)
- {
- mus_any *e;
- e = mix_envs[inp * out_chans + outp]; /* this is different from the matrix setup -- I don't know why */
- if (e)
- mix[off + outp] = mus_env(e);
- }
- if (s_env)
- src_env_val = mus_env(s_env);
- for (inp = 0; inp < in_chans; inp++)
- {
- mus_any *s;
- s = mix_srcs[inp];
- if (s)
- infs[inp] = mus_src(s, src_env_val, NULL);
- else
- {
- s = mix_rds[inp];
- if (s)
- infs[inp] = mus_readin(s);
- else infs[inp] = 0.0;
- }
- }
- mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
- if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
- }
- }
- free(infs);
- free(out_frample);
- if (rev_frample) free(rev_frample);
- }
-
- free(mix_rds);
- free(mix_srcs);
- free(mix_envs);
- return(Xen_false);
- }
-
-
- static Xen g_frample_to_frample(Xen mx, Xen infr, Xen inchans, Xen outfr, Xen outchans)
- {
- #define H_frample_to_frample "(" S_frample_to_frample " matrix in-data in-chans out-data out-chans): pass frample in-data through matrix \
- returning frample out-data; this is a matrix multiply of matrix and in-data"
- int ins, outs, mxs;
- vct *vin, *vout, *vmx;
-
- Xen_check_type(mus_is_vct(mx), mx, 1, S_frample_to_frample, "a " S_vct);
- Xen_check_type(mus_is_vct(infr), infr, 2, S_frample_to_frample, "a " S_vct);
- Xen_check_type(mus_is_vct(outfr), outfr, 4, S_frample_to_frample, "a " S_vct);
- Xen_check_type(Xen_is_integer(inchans), inchans, 3, S_frample_to_frample, "an integer");
- Xen_check_type(Xen_is_integer(outchans), outchans, 5, S_frample_to_frample, "an integer");
-
- ins = Xen_integer_to_C_int(inchans);
- vin = Xen_to_vct(infr);
- if (mus_vct_length(vin) < ins) ins = mus_vct_length(vin);
- if (ins <= 0) return(outfr);
-
- outs = Xen_integer_to_C_int(outchans);
- vout = Xen_to_vct(outfr);
- if (mus_vct_length(vout) < outs) outs = mus_vct_length(vout);
- if (outs <= 0) return(outfr);
-
- vmx = Xen_to_vct(mx);
- mxs = (int)sqrt(mus_vct_length(vmx));
-
- mus_frample_to_frample(mus_vct_data(vmx), mxs, mus_vct_data(vin), ins, mus_vct_data(vout), outs);
- return(outfr);
- }
-
-
-
-
- #if HAVE_SCHEME
- #ifndef _MSC_VER
-
- #include <time.h>
- #include <sys/time.h>
-
- static struct timeval overall_start_time;
- #define S_get_internal_real_time "get-internal-real-time"
- #define S_internal_time_units_per_second "internal-time-units-per-second"
-
- static Xen g_get_internal_real_time(void)
- {
- #define H_get_internal_real_time "(" S_get_internal_real_time ") returns the number of seconds since \
- the program started. The number is in terms of " S_internal_time_units_per_second ", usually 1"
- struct timezone z0;
- struct timeval t0;
- mus_float_t secs;
- gettimeofday(&t0, &z0);
- secs = difftime(t0.tv_sec, overall_start_time.tv_sec);
- return(C_double_to_Xen_real(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)));
- }
- #else
- static Xen g_get_internal_real_time(void) {return(C_double_to_Xen_real(0.0));}
- #endif
-
- Xen_wrap_no_args(g_get_internal_real_time_w, g_get_internal_real_time)
- #endif
-
-
-
-
- /* -------------------------------- scheme-side optimization -------------------------------- */
-
- #if HAVE_SCHEME
- #if (!WITH_GMP)
- #define car(E) s7_car(E)
- #define cdr(E) s7_cdr(E)
- #define cadr(E) s7_cadr(E)
- #define caddr(E) s7_caddr(E)
- #define cadddr(E) s7_cadddr(E)
- #define cadddr(E) s7_cadddr(E)
-
- static mus_float_t mus_nsin_unmodulated(mus_any *p) {return(mus_nsin(p, 0.0));}
- static mus_float_t mus_ncos_unmodulated(mus_any *p) {return(mus_ncos(p, 0.0));}
- static mus_float_t mus_nrxysin_unmodulated(mus_any *p) {return(mus_nrxysin(p, 0.0));}
- static mus_float_t mus_nrxycos_unmodulated(mus_any *p) {return(mus_nrxycos(p, 0.0));}
- static mus_float_t mus_rxyksin_unmodulated(mus_any *p) {return(mus_rxyksin(p, 0.0));}
- static mus_float_t mus_rxykcos_unmodulated(mus_any *p) {return(mus_rxykcos(p, 0.0));}
- static mus_float_t mus_square_wave_unmodulated(mus_any *p) {return(mus_square_wave(p, 0.0));}
- static mus_float_t mus_sawtooth_wave_unmodulated(mus_any *p) {return(mus_sawtooth_wave(p, 0.0));}
-
- static mus_float_t mus_src_simple(mus_any *p) {return(mus_src(p, 0.0, NULL));}
- static mus_float_t mus_src_two(mus_any *p, mus_float_t x) {return(mus_src(p, x, NULL));}
- static mus_float_t mus_granulate_simple(mus_any *p) {return(mus_granulate_with_editor(p, NULL, NULL));}
- static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL));}
- static mus_float_t mus_phase_vocoder_simple(mus_any *p) {return(mus_phase_vocoder(p, NULL));}
-
- #define mus_oscil_rf mus_oscil_unmodulated
- #define mus_polywave_rf mus_polywave_unmodulated
- #define mus_ncos_rf mus_ncos_unmodulated
- #define mus_nsin_rf mus_nsin_unmodulated
- #define mus_nrxycos_rf mus_nrxycos_unmodulated
- #define mus_nrxysin_rf mus_nrxysin_unmodulated
- #define mus_rxykcos_rf mus_rxykcos_unmodulated
- #define mus_rxyksin_rf mus_rxyksin_unmodulated
- #define mus_rand_rf mus_rand_unmodulated
- #define mus_rand_interp_rf mus_rand_interp_unmodulated
- #define mus_readin_rf mus_readin
- #define mus_env_rf mus_env
- #define mus_pulsed_env_rf mus_pulsed_env_unmodulated
- #define mus_oscil_bank_rf mus_oscil_bank
- #define mus_table_lookup_rf mus_table_lookup_unmodulated
- #define mus_sawtooth_wave_rf mus_sawtooth_wave_unmodulated
- #define mus_pulse_train_rf mus_pulse_train_unmodulated
- #define mus_triangle_wave_rf mus_triangle_wave_unmodulated
- #define mus_square_wave_rf mus_square_wave_unmodulated
- #define mus_wave_train_rf mus_wave_train_unmodulated
-
- #define mus_convolve_rf mus_convolve_simple
- #define mus_src_rf mus_src_simple
- #define mus_granulate_rf mus_granulate_simple
- #define mus_phase_vocoder_rf mus_phase_vocoder_simple
-
- static mus_float_t mus_one_pole_rf(mus_any *p) {return(mus_one_pole(p, 0.0));}
- static mus_float_t mus_two_pole_rf(mus_any *p) {return(mus_two_pole(p, 0.0));}
- static mus_float_t mus_one_zero_rf(mus_any *p) {return(mus_one_zero(p, 0.0));}
- static mus_float_t mus_two_zero_rf(mus_any *p) {return(mus_two_zero(p, 0.0));}
- static mus_float_t mus_delay_rf(mus_any *p) {return(mus_delay_unmodulated(p, 0.0));}
- static mus_float_t mus_comb_rf(mus_any *p) {return(mus_comb_unmodulated(p, 0.0));}
- static mus_float_t mus_comb_bank_rf(mus_any *p) {return(mus_comb_bank(p, 0.0));}
- static mus_float_t mus_all_pass_bank_rf(mus_any *p) {return(mus_all_pass_bank(p, 0.0));}
- static mus_float_t mus_notch_rf(mus_any *p) {return(mus_notch_unmodulated(p, 0.0));}
- static mus_float_t mus_all_pass_rf(mus_any *p) {return(mus_all_pass_unmodulated(p, 0.0));}
- static mus_float_t mus_one_pole_all_pass_rf(mus_any *p) {return(mus_one_pole_all_pass(p, 0.0));}
- static mus_float_t mus_moving_average_rf(mus_any *p) {return(mus_moving_average(p, 0.0));}
- static mus_float_t mus_moving_max_rf(mus_any *p) {return(mus_moving_max(p, 0.0));}
- static mus_float_t mus_moving_norm_rf(mus_any *p) {return(mus_moving_norm(p, 0.0));}
- static mus_float_t mus_filter_rf(mus_any *p) {return(mus_filter(p, 0.0));}
- static mus_float_t mus_fir_filter_rf(mus_any *p) {return(mus_fir_filter(p, 0.0));}
- static mus_float_t mus_iir_filter_rf(mus_any *p) {return(mus_iir_filter(p, 0.0));}
- static mus_float_t mus_polyshape_rf(mus_any *p) {return(mus_polyshape_unmodulated(p, 1.0));}
- static mus_float_t mus_filtered_comb_rf(mus_any *p) {return(mus_filtered_comb_unmodulated(p, 0.0));}
- static mus_float_t mus_filtered_comb_bank_rf(mus_any *p) {return(mus_filtered_comb_bank(p, 0.0));}
- static mus_float_t mus_asymmetric_fm_rf(mus_any *p) {return(mus_asymmetric_fm_unmodulated(p, 0.0));}
- static mus_float_t mus_formant_rf(mus_any *p) {return(mus_formant(p, 0.0));}
- static mus_float_t mus_firmant_rf(mus_any *p) {return(mus_firmant(p, 0.0));}
-
- static mus_float_t mus_ssb_am_rf_1(mus_any *p) {return(mus_ssb_am(p, 0.0, 0.0));}
-
- static mus_any *cadr_gen(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- return(gn->gen);
- }
-
- static s7_rf_t caddr_rf(s7_scheme *sc, s7_pointer a2, s7_rf_t func)
- {
- s7_int loc;
- s7_pointer val_sym, val;
- s7_rf_t rf;
- s7_rp_t rp;
-
- val_sym = car(a2);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a2);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(func);
- }
-
- #define GEN_RF_1(Type, Func) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) {s7_xf_store(sc, (s7_pointer)g); return(Type ## _rf_g);} \
- return(NULL); \
- } \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
- } \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
- }
-
- #define GEN_RF(Type, Func1, Func2) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- return(Func1(g)); \
- } \
- static s7_double Type ## _rf_gr(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = (**p); (*p)++; \
- return(Func2(g, s7_number_to_real(sc, a2))); \
- } \
- static s7_double Type ## _rf_gs(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_double a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = s7_slot_real_value(sc, **p, #Type); (*p)++; \
- return(Func2(g, a2)); \
- } \
- static s7_double Type ## _rf_gx(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- f = (s7_rf_t)(**p); (*p)++; \
- return(Func2(g, f(sc, p))); \
- } \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) \
- { \
- s7_pointer a2; \
- s7_xf_store(sc, (s7_pointer)g); \
- if (s7_is_null(sc, s7_cddr(expr))) return(Type ## _rf_g); \
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL); \
- a2 = caddr(expr); \
- if (s7_is_real(a2)) {s7_xf_store(sc, a2); return(Type ## _rf_gr);} \
- if (s7_is_symbol(a2)) \
- { \
- s7_pointer slot; \
- slot = s7_slot(sc, a2); \
- if (slot != xen_undefined) {s7_xf_store(sc, (s7_pointer)slot); return(Type ## _rf_gs);} \
- return(NULL); \
- } \
- if (s7_is_pair(a2)) \
- return(caddr_rf(sc, a2, Type ## _rf_gx)); \
- } \
- return(NULL); \
- } \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
- } \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
- }
-
- GEN_RF(all_pass, mus_all_pass_rf, mus_all_pass_unmodulated)
- GEN_RF(asymmetric_fm, mus_asymmetric_fm_rf, mus_asymmetric_fm_unmodulated)
- GEN_RF(comb, mus_comb_rf, mus_comb_unmodulated)
- GEN_RF(comb_bank, mus_comb_bank_rf, mus_comb_bank)
- GEN_RF(all_pass_bank, mus_all_pass_bank_rf, mus_all_pass_bank)
- GEN_RF_1(convolve, mus_convolve_rf)
- GEN_RF(delay, mus_delay_rf, mus_delay_unmodulated)
- GEN_RF_1(env, mus_env_rf)
- GEN_RF(filter, mus_filter_rf, mus_filter)
- GEN_RF(filtered_comb, mus_filtered_comb_rf, mus_filtered_comb_unmodulated)
- GEN_RF(filtered_comb_bank, mus_filtered_comb_bank_rf, mus_filtered_comb_bank)
- GEN_RF(fir_filter, mus_fir_filter_rf, mus_fir_filter)
- GEN_RF(firmant, mus_firmant_rf, mus_firmant)
- GEN_RF(formant, mus_formant_rf, mus_formant)
- GEN_RF_1(granulate, mus_granulate_rf)
- GEN_RF(iir_filter, mus_iir_filter_rf, mus_iir_filter)
- GEN_RF(moving_average, mus_moving_average_rf, mus_moving_average)
- GEN_RF(moving_max, mus_moving_max_rf, mus_moving_max)
- GEN_RF(moving_norm, mus_moving_norm_rf, mus_moving_norm)
- GEN_RF(ncos, mus_ncos_rf, mus_ncos)
- GEN_RF(notch, mus_notch_rf, mus_notch_unmodulated)
- GEN_RF(nrxycos, mus_nrxycos_rf, mus_nrxycos)
- GEN_RF(nrxysin, mus_nrxysin_rf, mus_nrxysin)
- GEN_RF(nsin, mus_nsin_rf, mus_nsin)
- GEN_RF(one_pole, mus_one_pole_rf, mus_one_pole)
- GEN_RF(one_pole_all_pass, mus_one_pole_all_pass_rf, mus_one_pole_all_pass)
- GEN_RF(one_zero, mus_one_zero_rf, mus_one_zero)
- GEN_RF(oscil, mus_oscil_rf, mus_oscil_fm)
- GEN_RF_1(oscil_bank, mus_oscil_bank_rf)
- GEN_RF_1(phase_vocoder, mus_phase_vocoder_rf)
- GEN_RF(polyshape, mus_polyshape_rf, mus_polyshape_unmodulated)
- GEN_RF(polywave, mus_polywave_rf, mus_polywave)
- GEN_RF(pulse_train, mus_pulse_train_rf, mus_pulse_train)
- GEN_RF(pulsed_env, mus_pulsed_env_rf, mus_pulsed_env)
- GEN_RF(rand, mus_rand_rf, mus_rand)
- GEN_RF(rand_interp, mus_rand_interp_rf, mus_rand_interp)
- GEN_RF_1(readin, mus_readin_rf)
- GEN_RF(rxykcos, mus_rxykcos_rf, mus_rxykcos)
- GEN_RF(rxyksin, mus_rxyksin_rf, mus_rxyksin)
- GEN_RF(sawtooth_wave, mus_sawtooth_wave_rf, mus_sawtooth_wave)
- GEN_RF(square_wave, mus_square_wave_rf, mus_square_wave)
- GEN_RF(src, mus_src_rf, mus_src_two)
- GEN_RF(table_lookup, mus_table_lookup_rf, mus_table_lookup)
- GEN_RF(triangle_wave, mus_triangle_wave_rf, mus_triangle_wave)
- GEN_RF(two_pole, mus_two_pole_rf, mus_two_pole)
- GEN_RF(two_zero, mus_two_zero_rf, mus_two_zero)
- GEN_RF(wave_train, mus_wave_train_rf, mus_wave_train)
- GEN_RF(ssb_am, mus_ssb_am_rf_1, mus_ssb_am_unmodulated)
- GEN_RF(tap, mus_tap_unmodulated, mus_tap)
-
- static s7_double oscil_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1, v2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- v2 = rf2(sc, p);
- return(mus_oscil(g, v1, v2));
- }
-
- static s7_double oscil_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), v1));
- }
-
- static s7_double oscil_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), s7_slot_real_value(sc, s2, S_oscil)));
- }
-
- static s7_double oscil_rf_srs(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_number_to_real(sc, s1), s7_slot_real_value(sc, s2, S_oscil)));
- }
-
- static s7_double oscil_rf_srx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_number_to_real(sc, s1), v1));
- }
-
-
- static s7_rf_t oscil_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
-
- len = s7_list_length(sc, expr);
- g = cadr_gen(sc, expr);
- if (!g) return(NULL);
- if (len < 4) return(oscil_rf(sc, expr));
- if (len > 5) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, oscil_rf_srs, oscil_rf_sss, NULL, oscil_rf_srx, oscil_rf_ssx, oscil_rf_sxx));
- }
-
-
- static s7_double comb_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, v1, rf2(sc, p)));
- }
-
- static s7_double comb_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), rf1(sc, p)));
- }
-
- static s7_double comb_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), s7_slot_real_value(sc, s2, S_comb)));
- }
-
- static s7_rf_t comb_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(comb_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_comb(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, comb_rf_sss, NULL, NULL, comb_rf_ssx, comb_rf_sxx));
- }
-
- static s7_double notch_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_notch(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t notch_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(notch_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_notch(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, notch_rf_sxx));
- }
-
- static s7_double delay_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_delay(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t delay_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(delay_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_delay(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, delay_rf_sxx));
- }
-
- static s7_double all_pass_rf_sxx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_all_pass(g, v1, rf2(sc, p)));
- }
-
- static s7_rf_t all_pass_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(all_pass_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_all_pass(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, all_pass_rf_sxx));
- }
-
- static s7_double ssb_am_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_ssb_am(g, s7_slot_real_value(sc, s1, S_ssb_am), s7_slot_real_value(sc, s2, S_ssb_am)));
- }
-
- static s7_rf_t ssb_am_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(ssb_am_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_ssb_am(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, ssb_am_rf_sss, NULL, NULL, NULL, NULL));
- }
-
- static s7_double formant_rf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), rf1(sc, p)));
- }
-
- static s7_double formant_rf_sss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), s7_slot_real_value(sc, s2, S_formant)));
- }
-
- static s7_rf_t formant_rf_3(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(formant_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_formant(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, formant_rf_sss, NULL, NULL, formant_rf_ssx, NULL));
- }
-
-
- /* formant-bank: c g r, or v for with_inputs */
- static s7_double formant_bank_rf_s(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_slot_real_value(sc, slot, S_formant_bank)));
- }
-
- static s7_double formant_bank_rf_r(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_number_to_real(sc, slot)));
- }
-
- static s7_double formant_bank_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_rf_t r1;
- bank = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_bank(bank, r1(sc, p)));
- }
-
- static s7_double formant_bank_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *bank;
- s7_double *els;
- bank = (mus_any *)(**p); (*p)++;
- els = (s7_double *)(**p); (*p)++;
- return(mus_formant_bank_with_inputs(bank, els));
- }
-
- static s7_rf_t formant_bank_rf(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant_bank(g)))
- {
- s7_pointer a1, val_sym, val;
- s7_int loc;
- s7_rf_t rf;
-
- s7_xf_store(sc, (s7_pointer)g);
- a1 = caddr(expr);
- if (s7_is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (slot == xen_undefined) return(NULL);
- val = s7_slot_value(slot);
- if (s7_is_real(val))
- {
- s7_xf_store(sc, (s7_pointer)slot);
- return(formant_bank_rf_s);
- }
- if (s7_is_float_vector(val))
- {
- s7_xf_store(sc, (s7_pointer)s7_float_vector_elements(val));
- return(formant_bank_rf_v);
- }
- return(NULL);
- }
- if (s7_is_real(a1))
- {
- s7_xf_store(sc, a1);
- return(formant_bank_rf_r);
- }
- if (!s7_is_pair(a1)) return(NULL);
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(formant_bank_rf_x);
- }
- return(NULL);
- }
-
-
- static s7_double set_formant_frequency_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *f;
- s7_rf_t r1;
- f = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_set_formant_frequency(f, r1(sc, p)));
- }
-
- static s7_rf_t set_formant_frequency_rf(s7_scheme *sc, s7_pointer expr)
- {
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant(g)))
- {
- s7_pointer a1;
- a1 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- s7_int loc;
- s7_pointer val, val_sym;
- s7_rf_t rf;
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(set_formant_frequency_rf_x);
- }
- }
- return(NULL);
- }
-
-
- static s7_double outa_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_x_rf_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int ind;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(ind, val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_s_rf_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_pointer ind;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
- }
-
- static s7_double outa_x_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t rf;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outa_s_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outb_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 1, S_outb);
- return(val);
- }
-
- static s7_double outb_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- s7_double val;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outb); (*p)++;
- out_any_2(ind, val, 1, S_outb);
- return(val);
- }
-
- static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p);
- static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double outa_mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *g;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(g) * r2(sc, p);
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
- static s7_double outa_mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *e, *o;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, r2(sc, p));
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
-
- static s7_double outa_mul_env_polywave_env_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_int pos;
- mus_any *e, *o, *fe;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- fe = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, mus_env(fe));
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
- }
-
-
- static s7_rf_t out_rf(s7_scheme *sc, s7_pointer expr, int chan)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_rf_t rf = NULL;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- if (ind < 0) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_caddr(expr);
- if (s7_is_symbol(val_expr))
- {
- s7_pointer slot;
- slot = s7_slot(sc, val_expr);
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else
- {
- s7_int loc;
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- }
-
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- {
- if (out_any_2 == safe_out_any_2_to_mus_xen)
- {
- if (rf == mul_env_polywave_x_rf)
- {
- s7_pointer fm;
- fm = s7_caddr(s7_caddr(val_expr));
- if ((s7_is_pair(fm)) &&
- (s7_car(fm) == env_symbol) &&
- (s7_is_symbol(s7_cadr(fm))))
- return(outa_mul_env_polywave_env_rf);
- return(outa_mul_env_polywave_x_rf);
- }
- if (rf == mul_env_x_rf)
- return(outa_mul_env_x_rf);
- return((rf) ? outa_x_rf_to_mus_xen : outa_s_rf_to_mus_xen);
- }
- return((rf) ? outa_x_rf : outa_s_rf);
- }
- return((rf) ? outb_x_rf : outb_s_rf);
- }
-
- if (chan == 0)
- return((rf) ? outa_x_rf_checked : outa_s_rf_checked);
- return(NULL);
- }
-
- static s7_rf_t outa_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(out_rf(sc, expr, 0));
- }
-
- static s7_rf_t outb_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(out_rf(sc, expr, 1));
- }
-
-
- static s7_double sample_to_file_rf_g(s7_scheme *sc, s7_pointer **p)
- {
- /* (sample->file obj samp chan[always int] val) */
- s7_int ind, chan;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_sample_to_file(lc, ind, chan, val);
- return(val);
- }
-
- static s7_rf_t sample_to_file_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, chan, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_sample_to_file(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- chan = s7_cadddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
-
- val_expr = s7_car(s7_cddddr(expr));
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- s7_xf_store(sc, chan);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(sample_to_file_rf_g);
- }
-
-
- static s7_double locsig_rf_x(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, ind, val);
- return(val);
- }
-
- static s7_double locsig_rf_x_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_locsig, 2, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, s7_integer(ind), val);
- return(val);
- }
-
- static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double locsig_fm_violin_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc, *e, *o, *fp, *a;
- s7_double val, vib;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p) += 3;
-
- /* fm_violin_rf */
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib)));
-
- mus_locsig(lc, ind, val);
- return(val);
- }
-
- static s7_rf_t locsig_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_locsig(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (rf == fm_violin_rf)
- return(locsig_fm_violin_rf);
- return((s7_is_stepper(ind_slot)) ? locsig_rf_x : locsig_rf_x_checked);
- }
-
-
- static s7_double move_sound_rf_g(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_move_sound(lc, ind, val);
- return(val);
- }
-
- static s7_rf_t move_sound_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_move_sound(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(move_sound_rf_g);
- }
-
-
- static s7_double out_bank_rf_1(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
- }
-
- static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p);
-
- static s7_double out_bank_rf_comb_bank_1(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
- }
-
- static s7_double out_bank_rf_comb_bank_2(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
- }
-
- static s7_double out_bank_rf_2(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
- }
-
- static s7_double out_bank_rf_4(s7_scheme *sc, s7_pointer **p)
- {
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *g3, *g4;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- g3 = (mus_any *)(**p); (*p)++;
- g4 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g4, val), 3, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g4, val), 3, "out-bank");
- }
- return(val);
- }
-
- static s7_rf_t out_bank_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr, filts;
- s7_int loc;
- s7_rf_t rf;
- s7_int i, len;
- mus_xen *gn;
- mus_any *g;
- s7_pointer *els;
-
- filts = s7_cadr(expr);
- if (!s7_is_symbol(filts)) return(NULL);
- filts = s7_symbol_value(sc, filts);
- if (!s7_is_vector(filts)) return(NULL);
- len = s7_vector_length(filts);
- if ((len != 1) && (len != 2) && (len != 4)) return(NULL);
- els = s7_vector_elements(filts);
- gn = (mus_xen *)s7_object_value_checked(els[0], mus_xen_tag);
- if (!gn) return(NULL);
- g = gn->gen;
- if ((!mus_is_delay(g)) && (!mus_is_all_pass(g))) return(NULL);
- for (i = 0; i < len; i++)
- s7_xf_store(sc, (s7_pointer)((mus_xen *)s7_object_value(els[i]))->gen);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (len == 1)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_1);
- return(out_bank_rf_1);
- }
- if (len == 2)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_2);
- return(out_bank_rf_2);
- }
- return(out_bank_rf_4);
- }
-
-
- static s7_double file_to_sample_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- return(mus_file_to_sample(stream, ind, 0));
- }
-
- static s7_rf_t file_to_sample_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- return(file_to_sample_rf_ss);
- }
-
-
- static s7_pointer file_to_frample_pf_sss(s7_scheme *sc, s7_pointer **p)
- {
- /* (file->frample gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_file_to_frample(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pf_t file_to_frample_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (!s7_is_symbol(fv_sym)) return(NULL);
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
-
- return(file_to_frample_pf_sss);
- }
-
-
- static s7_pointer frample_to_file_pf_sss(s7_scheme *sc, s7_pointer **p)
- {
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pointer frample_to_file_pf_ssx(s7_scheme *sc, s7_pointer **p)
- {
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- s7_pf_t pf;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
- }
-
- static s7_pf_t frample_to_file_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (s7_is_symbol(fv_sym))
- {
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
- return(frample_to_file_pf_sss);
- }
- if (s7_is_pair(fv_sym))
- {
- s7_pp_t pp;
- s7_pf_t pf;
- s7_int loc;
- pp = s7_pf_function(sc, s7_symbol_value(sc, s7_car(fv_sym)));
- if (!pp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- pf = pp(sc, fv_sym);
- if (!pf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)pf);
- return(frample_to_file_pf_ssx);
- }
- return(NULL);
- }
-
-
- static s7_pointer frample_to_frample_pf_all_s(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer matrix, in_data, in_chans, out_data, out_chans;
- matrix = s7_slot_value(**p); (*p)++;
- in_data = s7_slot_value(**p); (*p)++;
- in_chans = s7_slot_value(**p); (*p)++;
- out_data = s7_slot_value(**p); (*p)++;
- out_chans = s7_slot_value(**p); (*p)++;
-
- mus_frample_to_frample(s7_float_vector_elements(matrix), (int)sqrt(s7_vector_length(matrix)),
- s7_float_vector_elements(in_data), s7_integer(in_chans),
- s7_float_vector_elements(out_data), s7_integer(out_chans));
- return(out_data);
- }
-
- static s7_pf_t frample_to_frample_pf(s7_scheme *sc, s7_pointer expr)
- {
- s7_int i;
- s7_pointer p;
- for (i = 0, p = s7_cdr(expr); (s7_is_pair(p)) && (i < 5); i++, p = s7_cdr(p))
- {
- if (s7_is_symbol(s7_car(p)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_car(p));
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else return(NULL);
- }
- if ((i == 5) && (s7_is_null(sc, p)))
- return(frample_to_frample_pf_all_s);
- return(NULL);
- }
-
- static s7_double ina_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 0, stream));
- }
-
- static s7_double ina_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_ina, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 0, stream));
- }
-
- static s7_double inb_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 1, stream));
- }
-
- static s7_double inb_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_inb, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 1, stream));
- }
-
- static s7_double ina_rf_fv(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer fv;
- s7_int index;
- index = s7_slot_integer_value(**p); (*p)++;
- fv = (**p); (*p)++;
- if ((index >= 0) && (index < s7_vector_length(fv)))
- return(s7_float_vector_elements(fv)[index]);
- return(0.0);
- }
-
- static s7_rf_t in_rf(s7_scheme *sc, s7_pointer expr, int chan)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- sym = s7_caddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- if (s7_is_float_vector(o))
- {
- if ((chan == 0) &&
- (s7_is_stepper(ind_slot)))
- {
- s7_xf_store(sc, o);
- return(ina_rf_fv);
- }
- return(NULL);
- }
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- return(ina_rf_ss);
- return(inb_rf_ss);
- }
- if (chan == 0)
- return(ina_rf_ss_checked);
- return(inb_rf_ss_checked);
- }
-
- static s7_rf_t ina_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(in_rf(sc, expr, 0));
- }
-
- static s7_rf_t inb_rf(s7_scheme *sc, s7_pointer expr)
- {
- return(in_rf(sc, expr, 1));
- }
-
- static s7_double in_any_rf_srs(s7_scheme *sc, s7_pointer **p)
- {
- s7_int ind, chan;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, chan, stream));
- }
-
- static s7_rf_t in_any_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer ind_sym, ind_slot, ind, sym, o, chan;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- chan = s7_caddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
- s7_xf_store(sc, chan);
-
- sym = s7_cadddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- return(in_any_rf_srs);
- }
-
-
- #define RF2_TO_RF(CName, Rfnc) \
- static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- s7_double x, y; \
- f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); \
- f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); \
- return(Rfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_rf(sc, s7_cadr(expr))) && \
- (s7_arg_to_rf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_r2); \
- return(NULL); \
- }
-
- #define RF_0(Call) \
- static s7_double Call ## _rf_0(s7_scheme *sc, s7_pointer **p) \
- { \
- return(mus_ ## Call()); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cdr(expr))) return(NULL); \
- return(Call ## _rf_0); \
- }
-
- RF_0(srate)
-
-
- #define RF_1(Call) \
- static s7_double Call ## _rf_s(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_slot_real_value(sc, slot, #Call))); \
- } \
- static s7_double Call ## _rf_c(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_number_to_real(sc, slot))); \
- } \
- static s7_double Call ## _rf_r(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t r; \
- r = (s7_rf_t)(**p); (*p)++; \
- return(mus_ ## Call(r(sc, p))); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- return(s7_rf_1(sc, expr, Call ## _rf_c, Call ## _rf_s, Call ## _rf_r)); \
- }
-
- RF_1(odd_weight)
- RF_1(even_weight)
- RF_1(hz_to_radians)
- RF_1(radians_to_hz)
- RF_1(db_to_linear)
- RF_1(linear_to_db)
- RF_1(radians_to_degrees)
- RF_1(degrees_to_radians)
- RF_1(random)
-
- RF2_TO_RF(contrast_enhancement, mus_contrast_enhancement(x, y))
- RF2_TO_RF(odd_multiple, mus_odd_multiple(x, y))
- RF2_TO_RF(even_multiple, mus_even_multiple(x, y))
- RF2_TO_RF(ring_modulate, x * y)
-
-
- static s7_double polynomial_rf_ss(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "polynomial"); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), s2, s7_vector_length(s1)));
- }
-
- static s7_double polynomial_rf_sx(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_rf_t r1;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), r1(sc, p), s7_vector_length(s1)));
- }
-
- static s7_rf_t polynomial_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_float_vector(s7_symbol_value(sc, s7_cadr(expr)))))
- return(s7_rf_2(sc, expr, NULL, NULL, NULL, NULL, polynomial_rf_ss, NULL, NULL, polynomial_rf_sx, NULL));
- return(NULL);
- }
-
- static s7_double pink_noise_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s1 = s7_slot_value(**p); (*p)++;
- return(mus_pink_noise(s1));
- }
-
- static s7_rf_t pink_noise_rf(s7_scheme *sc, s7_pointer expr)
- {
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_cadr(expr));
- if (s7_is_float_vector(s7_slot_value(slot)))
- {
- s7_xf_store(sc, slot);
- return(pink_noise_rf_v);
- }
- }
- return(NULL);
- }
-
- static s7_double piano_noise_rf_vr(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "piano-noise"); (*p)++;
- return(piano_noise(s7_int_vector_elements(s1), s2));
- }
-
- static s7_rf_t piano_noise_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_symbol(s7_caddr(expr))))
- {
- s7_pointer slot1, slot2;
- slot1 = s7_slot(sc, s7_cadr(expr));
- slot2 = s7_slot(sc, s7_caddr(expr));
- if ((s7_is_int_vector(s7_slot_value(slot1))) &&
- (s7_is_real(s7_slot_value(slot2))))
- {
- s7_xf_store(sc, slot1);
- s7_xf_store(sc, slot2);
- return(piano_noise_rf_vr);
- }
- }
- return(NULL);
- }
-
-
- static s7_double array_interp_rf_sxr(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_int c2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- c2 = s7_integer(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, c2));
- }
-
- static s7_double array_interp_rf_sxs(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer s1;
- s7_int s2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- s2 = s7_slot_integer_value(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, s2));
- }
-
- static s7_rf_t array_interp_rf(s7_scheme *sc, s7_pointer expr)
- {
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer rst, fv;
- rst = cdr(expr);
- fv = s7_slot(sc, s7_car(rst));
- if ((fv != xen_undefined) &&
- (s7_is_float_vector(s7_slot_value(fv))))
- {
- if ((!s7_is_null(sc, s7_cddr(rst))) &&
- (s7_is_null(sc, s7_cdddr(rst))))
- {
- s7_xf_store(sc, fv);
- return(s7_rf_2(sc, rst, NULL, NULL, array_interp_rf_sxr, NULL, NULL, array_interp_rf_sxs, NULL, NULL, NULL));
- }
- }
- }
- return(NULL);
- }
-
- static s7_double am_rf_rsx(s7_scheme *sc, s7_pointer **p)
- {
- s7_double c1, c2;
- s7_rf_t r1;
- c1 = s7_number_to_real(sc, **p); (*p)++;
- c2 = s7_slot_real_value(sc, **p, "amplitude-modulation"); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_amplitude_modulate(c1, c2, r1(sc, p)));
- }
-
- static s7_rf_t am_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_pointer a1, a2, a3;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- a3 = s7_cadddr(expr);
- if ((s7_is_real(a1)) &&
- (s7_is_symbol(a2)) &&
- (s7_is_pair(a3)))
- {
- s7_rp_t rp;
- s7_rf_t rf;
- s7_int loc;
- s7_pointer sym, val;
-
- s7_xf_store(sc, a1);
- val = s7_slot(sc, a2);
- if (val == xen_undefined) return(NULL);
- s7_xf_store(sc, val);
-
- sym = car(a3);
- if (!s7_is_symbol(sym)) return(NULL);
- val = s7_symbol_value(sc, sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a3);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(am_rf_rsx);
- }
- return(NULL);
- }
-
-
- static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *g;
- (*p)++;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(g) * r2(sc, p));
- }
-
- static s7_double mul_env_oscil_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, r2(sc, p)));
- }
-
- static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o, *fp, *a;
- s7_double vib;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib))));
- }
-
- static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_polywave(o, r2(sc, p)));
- }
-
- static s7_double mul_env_polywave_s_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_double s1;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- s1 = s7_slot_real_value(sc, **p, S_polywave); (*p)++;
- return(mus_env(e) * mus_polywave(o, s1));
- }
-
- static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t r1;
- s7_double s1;
- mus_any *o;
- s1 = s7_slot_real_value(sc, **p, S_comb_bank); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(s1 * mus_comb_bank(o, r1(sc, p)));
- }
-
- static s7_rp_t initial_multiply_rf;
- static s7_rf_t clm_multiply_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_rf_t f;
- f = initial_multiply_rf(sc, expr);
- if ((f) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- if ((s7_car(a1) == env_symbol) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if ((s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- {
- if (s7_is_pair(s7_caddr(a2)))
- {
- if (s7_car(a2) == oscil_symbol)
- {
- s7_pointer fm;
- fm = s7_caddr(a2);
- if ((s7_car(fm) == add_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_pair(s7_caddr(fm))))
- {
- s7_pointer vib_sym;
- vib_sym = s7_cadr(fm);
- fm = s7_caddr(fm);
- if ((s7_car(fm) == multiply_symbol) &&
- (s7_is_pair(s7_cadr(fm))) &&
- (s7_caadr(fm) == env_symbol) &&
- (s7_is_pair(s7_caddr(fm))) &&
- (s7_is_null(sc, s7_cdddr(fm))))
- {
- fm = s7_caddr(fm);
- if ((s7_car(fm) == polywave_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_symbol(s7_caddr(fm))) &&
- (s7_caddr(fm) == vib_sym))
- return(fm_violin_rf);
- }
- }
- return(mul_env_oscil_x_rf);
- }
- else
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_x_rf);
- }
- }
- if (s7_is_symbol(s7_caddr(a2)))
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_s_rf);
- }
- }
- return(mul_env_x_rf);
- }
- }
- else
- {
- if ((s7_is_symbol(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_car(a2) == comb_bank_symbol) &&
- (s7_is_pair(s7_caddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- return(mul_s_comb_bank_x_rf);
- }
- }
- return(f);
- }
-
-
- static s7_double add_env_ri_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- return(mus_env(e) + mus_rand_interp_unmodulated(o));
- }
-
- static s7_double add_tri_ri_rf(s7_scheme *sc, s7_pointer **p)
- {
- mus_any *e, *o;
- (*p)++; /* triangle-wave */
- e = (mus_any *)(**p); (*p) += 2; /* rand-interp */
- o = (mus_any *)(**p); (*p)++;
- return(mus_triangle_wave_unmodulated(e) + mus_rand_interp_unmodulated(o));
- }
-
- static s7_rp_t initial_add_rf;
- static s7_rf_t clm_add_rf(s7_scheme *sc, s7_pointer expr)
- {
- s7_rf_t f;
- f = initial_add_rf(sc, expr);
- if (f)
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if ((s7_is_pair(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_car(a2) == rand_interp_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cddr(a1))) &&
- (s7_is_null(sc, s7_cddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if (s7_car(a1) == triangle_wave_symbol)
- return(add_tri_ri_rf);
- if (s7_car(a1) == env_symbol)
- return(add_env_ri_rf);
- }
- }
- return(f);
- }
-
-
- static s7_double env_rf_v(s7_scheme *sc, s7_pointer **p)
- {
- s7_pointer v;
- mus_xen *gn;
- s7_Int ind;
-
- v = (**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- if ((ind < 0) || (ind >= s7_vector_length(v)))
- s7_out_of_range_error(s7, "vector-ref", 2, s7_make_integer(sc, ind), "must fit in vector");
-
- gn = (mus_xen *)s7_object_value_checked(s7_vector_elements(v)[ind], mus_xen_tag);
- return(mus_env(gn->gen));
- }
-
- static s7_rf_t env_rf_1(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(expr)) &&
- (s7_is_pair(cdr(expr))) &&
- (s7_is_pair(cadr(expr))))
- {
- s7_pointer a1;
- a1 = s7_cadr(expr);
- if ((s7_car(a1) == vector_ref_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_caddr(a1))) &&
- (s7_is_null(sc, s7_cdddr(a1))))
- {
- s7_pointer s1, s2, v, ind;
- s7_pointer *els;
- int i, vlen;
-
- s1 = s7_cadr(a1);
- s2 = s7_caddr(a1);
-
- v = s7_symbol_value(sc, s1);
- if (!s7_is_vector(v)) return(NULL);
- vlen = s7_vector_length(v);
- els = s7_vector_elements(v);
- for (i= 0; i < vlen; i++)
- {
- mus_xen *gn;
- gn = (mus_xen *)s7_object_value_checked(els[i], mus_xen_tag);
- if ((!gn) || (!(gn->gen)) || (!mus_is_env(gn->gen))) return(NULL);
- }
-
- ind = s7_slot(sc, s2);
- if ((ind == xen_undefined) || (!s7_is_integer(s7_slot_value(ind)))) return(NULL);
-
- s7_xf_store(sc, v);
- s7_xf_store(sc, ind);
- return(env_rf_v);
- }
- }
- return(env_rf(sc, expr));
- }
-
-
- static s7_double chebyshev_t_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_t_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
- }
-
- static s7_rf_t chebyshev_t_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_t_rf_a);
- return(NULL);
- }
-
- static s7_double chebyshev_u_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_u_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
- }
-
- static s7_rf_t chebyshev_u_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_u_rf_a);
- return(NULL);
- }
-
- static s7_double chebyshev_tu_rf_a(s7_scheme *sc, s7_pointer **p)
- {
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer t, u;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- t = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- u = pf(sc, p);
- return(mus_chebyshev_tu_sum(x, s7_vector_length(t), s7_float_vector_elements(t), s7_float_vector_elements(u)));
- }
-
- static s7_rf_t chebyshev_tu_rf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_pair(s7_cdddr(expr))) && (s7_is_null(sc, s7_cddddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))) &&
- (s7_arg_to_pf(sc, s7_cadddr(expr))))
- return(chebyshev_tu_rf_a);
- return(NULL);
- }
-
-
- #define PF2_TO_RF(CName, Cfnc) \
- static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_a); \
- return(NULL); \
- }
-
- static s7_double c_dot_product(s7_scheme *sc, s7_pointer x, s7_pointer y)
- {
- s7_int len, lim;
- len = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim < len) len = lim;
- if (len == 0) return(0.0);
- return(mus_dot_product(s7_float_vector_elements(x), s7_float_vector_elements(y), len));
- }
-
- PF2_TO_RF(dot_product, c_dot_product(sc, x, y))
-
- static s7_pointer mus_fft_pf_i2(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size, dir;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; dir = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, dir);
- return(rl);
- }
-
- static s7_pointer mus_fft_pf_i1(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, 1);
- return(rl);
- }
-
- static s7_pointer mus_fft_pf_i0(s7_scheme *sc, s7_pointer **p)
- {
- s7_pf_t pf;
- s7_pointer rl, im;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), s7_vector_length(rl), 1);
- return(rl);
- }
-
- static s7_pf_t mus_fft_pf(s7_scheme *sc, s7_pointer expr)
- {
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))))
- {
- s7_pointer trailers;
- if (!s7_arg_to_pf(sc, s7_cadr(expr))) return(NULL);
- if (!s7_arg_to_pf(sc, s7_caddr(expr))) return(NULL);
- trailers = s7_cdddr(expr);
- if (s7_is_null(sc, trailers)) return(mus_fft_pf_i0);
- if (!s7_arg_to_if(sc, s7_car(trailers))) return(NULL);
- if (s7_is_null(sc, s7_cdr(trailers))) return(mus_fft_pf_i1);
- if (!s7_arg_to_if(sc, s7_cadr(trailers))) return(NULL);
- if (!s7_is_null(sc, s7_cddr(trailers))) return(NULL);
- return(mus_fft_pf_i2);
- }
- return(NULL);
- }
-
-
- #define MG_RF(Method, Func) \
- static s7_double mus_ ## Method ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_rf_t mus_ ## Method ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _rf_g);} \
- return(NULL); \
- }
-
- #define MG_IF(Method, Func) \
- static s7_int mus_ ## Method ## _if_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_if_t mus_ ## Method ## _if(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _if_g);} \
- return(NULL); \
- }
-
- #define PF_PF(Method, Func) \
- static s7_pointer mus_ ## Method ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer g; \
- f = (s7_pf_t)(**p); (*p)++; \
- g = f(sc, p); \
- return(Func(g)); \
- } \
- static s7_pf_t mus_ ## Method ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(mus_ ## Method ## _pf_g); \
- return(NULL); \
- }
-
- MG_RF(scaler, mus_scaler)
- MG_RF(phase, mus_phase)
- MG_RF(frequency, mus_frequency)
- MG_RF(offset, mus_offset)
- MG_RF(width, mus_width)
- MG_RF(increment, mus_increment)
- MG_RF(feedforward, mus_feedforward)
- MG_RF(feedback, mus_feedback)
-
- MG_IF(length, mus_length)
- MG_IF(order, mus_order)
- MG_IF(location, mus_location)
- MG_IF(channel, mus_channel)
- MG_IF(channels, mus_channels)
- MG_IF(ramp, mus_ramp)
- MG_IF(hop, mus_hop)
-
-
- PF_PF(data, g_mus_data)
- PF_PF(reset, g_mus_reset)
-
- #if 0
- MG_RFIF(xcoeff, mus_xcoeff)
- MG_RFIF(ycoeff, mus_ycoeff)
- MG_PF(xcoeffs, c_mus_xcoeffs) -- x|ycoeffs are complicated and may involve wrapper creation
- MG_PF(ycoeffs, c_mus_ycoeffs)
- MG_PF(file_name, c_mus_file_name) -- requires c->xen string creation
- MG_PF(copy, c_mus_copy) -- allocation
- #endif
- #endif /* gmp */
-
-
- static void init_choosers(s7_scheme *sc)
- {
- #if (!WITH_GMP)
- s7_pointer f;
- #endif
-
- env_symbol = s7_make_symbol(sc, S_env);
- comb_bank_symbol = s7_make_symbol(sc, S_comb_bank);
- vector_ref_symbol = s7_make_symbol(sc, "vector-ref");
- polywave_symbol = s7_make_symbol(sc, S_polywave);
- triangle_wave_symbol = s7_make_symbol(sc, S_triangle_wave);
- rand_interp_symbol = s7_make_symbol(sc, S_rand_interp);
- oscil_symbol = s7_make_symbol(sc, S_oscil);
- multiply_symbol = s7_make_symbol(sc, "*");
- add_symbol = s7_make_symbol(sc, "+");
- quote_symbol = s7_make_symbol(sc, "quote");
- cos_symbol = s7_make_symbol(sc, "cos");
- mus_copy_symbol = s7_make_symbol(sc, "mus-copy");
- copy_function = s7_name_to_value(sc, "copy");
-
- sym_frequency = s7_make_symbol(sc, S_mus_frequency);
- sym_phase = s7_make_symbol(sc, S_mus_phase);
- sym_scaler = s7_make_symbol(sc, S_mus_scaler);
- sym_increment = s7_make_symbol(sc, S_mus_increment);
- sym_width = s7_make_symbol(sc, S_mus_width);
- sym_offset = s7_make_symbol(sc, S_mus_offset);
- sym_feedforward = s7_make_symbol(sc, S_mus_feedforward);
- sym_feedback = s7_make_symbol(sc, S_mus_feedback);
-
- #if (!WITH_GMP)
- f = s7_name_to_value(sc, "*");
- initial_multiply_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_multiply_rf);
-
- f = s7_name_to_value(sc, "+");
- initial_add_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_add_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_outa), outa_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_outb), outb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ina), ina_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_file_to_frample), file_to_frample_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_file), frample_to_file_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_frample), frample_to_frample_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil), oscil_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_polywave), polywave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_wave_train), wave_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_granulate), granulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ncos), ncos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxycos), nrxycos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_env), env_rf_1);
- s7_rf_set_function(s7_name_to_value(sc, S_readin), readin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole), one_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_average), moving_average_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_max), moving_max_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_fir_filter), fir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_triangle_wave), triangle_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulse_train), pulse_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand_interp), rand_interp_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_formant), formant_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole_all_pass), one_pole_all_pass_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_delay), delay_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_formant_bank), formant_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil_bank), oscil_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand), rand_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filter), filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_table_lookup), table_lookup_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_src), src_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sawtooth_wave), sawtooth_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_inb), inb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_in_any), in_any_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polynomial), polynomial_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pink_noise), pink_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_piano_noise), piano_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nsin), nsin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxysin), nrxysin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxyksin), rxyksin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxykcos), rxykcos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_tap), tap_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_comb), comb_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_comb_bank), comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_notch), notch_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_two_zero), two_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_zero), one_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_two_pole), two_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_norm), moving_norm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_iir_filter), iir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_square_wave), square_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_firmant), firmant_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass), all_pass_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass_bank), all_pass_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polyshape), polyshape_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulsed_env), pulsed_env_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ssb_am), ssb_am_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_asymmetric_fm), asymmetric_fm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb), filtered_comb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb_bank), filtered_comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_move_sound), move_sound_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_locsig), locsig_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_out_bank), out_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_phase_vocoder), phase_vocoder_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_convolve), convolve_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sample_to_file), sample_to_file_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_srate), srate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_contrast_enhancement), contrast_enhancement_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_set_formant_frequency), set_formant_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_weight), odd_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_weight), even_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_multiple), odd_multiple_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_multiple), even_multiple_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_hz_to_radians), hz_to_radians_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_hz), radians_to_hz_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_degrees), radians_to_degrees_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_degrees_to_radians), degrees_to_radians_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_db_to_linear), db_to_linear_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_linear_to_db), linear_to_db_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_random), random_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_amplitude_modulate), am_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ring_modulate), ring_modulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_array_interp), array_interp_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb), is_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb_bank), is_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass_bank), is_all_pass_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_convolve), is_convolve_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_delay), is_delay_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_env), is_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filter), is_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb), is_filtered_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb_bank), is_filtered_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_fir_filter), is_fir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_firmant), is_firmant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_formant), is_formant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_granulate), is_granulate_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_iir_filter), is_iir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_average), is_moving_average_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_max), is_moving_max_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_norm), is_moving_norm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ncos), is_ncos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_notch), is_notch_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxycos), is_nrxycos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxysin), is_nrxysin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nsin), is_nsin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole), is_one_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole_all_pass), is_one_pole_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_zero), is_one_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil), is_oscil_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil_bank), is_oscil_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_phase_vocoder), is_phase_vocoder_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polyshape), is_polyshape_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polywave), is_polywave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulse_train), is_pulse_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulsed_env), is_pulsed_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand), is_rand_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand_interp), is_rand_interp_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_readin), is_readin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxykcos), is_rxykcos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxyksin), is_rxyksin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_sawtooth_wave), is_sawtooth_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_square_wave), is_square_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_src), is_src_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_table_lookup), is_table_lookup_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_triangle_wave), is_triangle_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_pole), is_two_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_zero), is_two_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_wave_train), is_wave_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ssb_am), is_ssb_am_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_tap), is_tap_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_dot_product), dot_product_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_fft), mus_fft_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_polar), rectangular_to_polar_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_polar_to_rectangular), polar_to_rectangular_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_magnitudes), rectangular_to_magnitudes_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_t_sum), chebyshev_t_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_u_sum), chebyshev_u_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_tu_sum), chebyshev_tu_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_mus_data), mus_data_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_reset), mus_reset_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_scaler), mus_scaler_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_phase), mus_phase_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_frequency), mus_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_offset), mus_offset_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_width), mus_width_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_increment), mus_increment_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_rf);
-
- s7_if_set_function(s7_name_to_value(sc, S_mus_length), mus_length_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_order), mus_order_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_location), mus_location_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channel), mus_channel_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channels), mus_channels_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_hop), mus_hop_if);
- #endif /* gmp */
- }
- #endif /*s7 */
-
-
- Xen_wrap_no_args(g_mus_srate_w, g_mus_srate)
- Xen_wrap_1_arg(g_mus_set_srate_w, g_mus_set_srate)
- Xen_wrap_no_args(g_mus_float_equal_fudge_factor_w, g_mus_float_equal_fudge_factor)
- Xen_wrap_1_arg(g_mus_set_float_equal_fudge_factor_w, g_mus_set_float_equal_fudge_factor)
- Xen_wrap_no_args(g_mus_array_print_length_w, g_mus_array_print_length)
- Xen_wrap_1_arg(g_mus_set_array_print_length_w, g_mus_set_array_print_length)
- Xen_wrap_1_arg(g_radians_to_hz_w, g_radians_to_hz)
- Xen_wrap_1_arg(g_hz_to_radians_w, g_hz_to_radians)
- Xen_wrap_1_arg(g_radians_to_degrees_w, g_radians_to_degrees)
- Xen_wrap_1_arg(g_degrees_to_radians_w, g_degrees_to_radians)
- Xen_wrap_1_arg(g_db_to_linear_w, g_db_to_linear)
- Xen_wrap_1_arg(g_linear_to_db_w, g_linear_to_db)
- Xen_wrap_1_arg(g_even_weight_w, g_even_weight)
- Xen_wrap_1_arg(g_odd_weight_w, g_odd_weight)
- Xen_wrap_2_args(g_even_multiple_w, g_even_multiple)
- Xen_wrap_2_args(g_odd_multiple_w, g_odd_multiple)
- Xen_wrap_1_arg(g_seconds_to_samples_w, g_seconds_to_samples)
- Xen_wrap_1_arg(g_samples_to_seconds_w, g_samples_to_seconds)
- Xen_wrap_2_args(g_ring_modulate_w, g_ring_modulate)
- Xen_wrap_3_args(g_amplitude_modulate_w, g_amplitude_modulate)
- Xen_wrap_2_optional_args(g_contrast_enhancement_w, g_contrast_enhancement)
- Xen_wrap_3_optional_args(g_dot_product_w, g_dot_product)
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
- Xen_wrap_2_args(g_edot_product_w, g_edot_product)
- #endif
- Xen_wrap_2_args(g_polynomial_w, g_polynomial)
- Xen_wrap_4_optional_args(g_make_fft_window_w, g_make_fft_window)
- Xen_wrap_4_optional_args(g_mus_fft_w, g_mus_fft)
- Xen_wrap_4_optional_args(g_spectrum_w, g_spectrum)
- Xen_wrap_1_arg(g_autocorrelate_w, g_autocorrelate)
- Xen_wrap_2_args(g_correlate_w, g_correlate)
- Xen_wrap_3_optional_args(g_convolution_w, g_convolution)
- Xen_wrap_2_args(g_rectangular_to_polar_w, g_rectangular_to_polar)
- Xen_wrap_2_args(g_rectangular_to_magnitudes_w, g_rectangular_to_magnitudes)
- Xen_wrap_2_args(g_polar_to_rectangular_w, g_polar_to_rectangular)
- Xen_wrap_3_optional_args(g_array_interp_w, g_array_interp)
- Xen_wrap_5_optional_args(g_mus_interpolate_w, g_mus_interpolate)
- Xen_wrap_1_arg(g_mus_describe_w, g_mus_describe)
- Xen_wrap_1_arg(g_mus_name_w, g_mus_name)
- Xen_wrap_3_optional_args(g_mus_run_w, g_mus_run)
- Xen_wrap_1_arg(g_mus_phase_w, g_mus_phase)
- Xen_wrap_2_args(g_mus_set_phase_w, g_mus_set_phase)
- Xen_wrap_1_arg(g_mus_width_w, g_mus_width)
- Xen_wrap_2_args(g_mus_set_width_w, g_mus_set_width)
- Xen_wrap_1_arg(g_mus_scaler_w, g_mus_scaler)
- Xen_wrap_2_args(g_mus_set_scaler_w, g_mus_set_scaler)
- Xen_wrap_1_arg(g_mus_feedforward_w, g_mus_feedforward)
- Xen_wrap_2_args(g_mus_set_feedforward_w, g_mus_set_feedforward)
- Xen_wrap_1_arg(g_mus_reset_w, g_mus_reset)
- Xen_wrap_1_arg(g_mus_copy_w, g_mus_copy)
- Xen_wrap_1_arg(g_mus_offset_w, g_mus_offset)
- Xen_wrap_2_args(g_mus_set_offset_w, g_mus_set_offset)
- Xen_wrap_1_arg(g_mus_frequency_w, g_mus_frequency)
- Xen_wrap_2_args(g_mus_set_frequency_w, g_mus_set_frequency)
- Xen_wrap_1_arg(g_mus_length_w, g_mus_length)
- Xen_wrap_1_arg(g_mus_file_name_w, g_mus_file_name)
- Xen_wrap_2_args(g_mus_set_length_w, g_mus_set_length)
- Xen_wrap_1_arg(g_mus_type_w, g_mus_type)
- Xen_wrap_1_arg(g_mus_order_w, g_mus_order)
- Xen_wrap_1_arg(g_mus_data_w, g_mus_data)
- Xen_wrap_2_args(g_mus_set_data_w, g_mus_set_data)
- Xen_wrap_1_arg(g_is_oscil_w, g_is_oscil)
- Xen_wrap_3_optional_args(g_oscil_w, g_oscil)
- Xen_wrap_1_arg(g_is_oscil_bank_w, g_is_oscil_bank)
- Xen_wrap_1_arg(g_oscil_bank_w, g_oscil_bank)
- Xen_wrap_any_args(g_mus_apply_w, g_mus_apply)
- Xen_wrap_any_args(g_make_delay_w, g_make_delay)
- Xen_wrap_any_args(g_make_comb_w, g_make_comb)
- Xen_wrap_any_args(g_make_filtered_comb_w, g_make_filtered_comb)
- Xen_wrap_any_args(g_make_notch_w, g_make_notch)
- Xen_wrap_any_args(g_make_all_pass_w, g_make_all_pass)
- Xen_wrap_any_args(g_make_moving_average_w, g_make_moving_average)
- Xen_wrap_any_args(g_make_moving_max_w, g_make_moving_max)
- Xen_wrap_any_args(g_make_moving_norm_w, g_make_moving_norm)
- Xen_wrap_3_optional_args(g_delay_w, g_delay)
- Xen_wrap_2_optional_args(g_delay_tick_w, g_delay_tick)
- Xen_wrap_2_optional_args(g_tap_w, g_tap)
- Xen_wrap_3_optional_args(g_notch_w, g_notch)
- Xen_wrap_3_optional_args(g_comb_w, g_comb)
- Xen_wrap_3_optional_args(g_filtered_comb_w, g_filtered_comb)
- Xen_wrap_3_optional_args(g_all_pass_w, g_all_pass)
- Xen_wrap_2_optional_args(g_moving_average_w, g_moving_average)
- Xen_wrap_2_optional_args(g_moving_max_w, g_moving_max)
- Xen_wrap_2_optional_args(g_moving_norm_w, g_moving_norm)
- Xen_wrap_1_arg(g_is_tap_w, g_is_tap)
- Xen_wrap_1_arg(g_is_delay_w, g_is_delay)
- Xen_wrap_1_arg(g_is_notch_w, g_is_notch)
- Xen_wrap_1_arg(g_is_comb_w, g_is_comb)
- Xen_wrap_1_arg(g_is_filtered_comb_w, g_is_filtered_comb)
- Xen_wrap_1_arg(g_is_all_pass_w, g_is_all_pass)
- Xen_wrap_1_arg(g_is_moving_average_w, g_is_moving_average)
- Xen_wrap_1_arg(g_is_moving_max_w, g_is_moving_max)
- Xen_wrap_1_arg(g_is_moving_norm_w, g_is_moving_norm)
-
- Xen_wrap_2_optional_args(g_ncos_w, g_ncos)
- Xen_wrap_1_arg(g_is_ncos_w, g_is_ncos)
- Xen_wrap_2_optional_args(g_nsin_w, g_nsin)
- Xen_wrap_1_arg(g_is_nsin_w, g_is_nsin)
-
- Xen_wrap_any_args(g_make_rand_w, g_make_rand)
- Xen_wrap_any_args(g_make_rand_interp_w, g_make_rand_interp)
- Xen_wrap_2_optional_args(g_rand_w, g_rand)
- Xen_wrap_2_optional_args(g_rand_interp_w, g_rand_interp)
- Xen_wrap_1_arg(g_is_rand_w, g_is_rand)
- Xen_wrap_1_arg(g_is_rand_interp_w, g_is_rand_interp)
- Xen_wrap_1_arg(g_mus_random_w, g_mus_random)
- Xen_wrap_no_args(g_mus_rand_seed_w, g_mus_rand_seed)
- Xen_wrap_1_arg(g_mus_set_rand_seed_w, g_mus_set_rand_seed)
- Xen_wrap_1_arg(g_is_table_lookup_w, g_is_table_lookup)
- Xen_wrap_any_args(g_make_table_lookup_w, g_make_table_lookup)
- Xen_wrap_2_optional_args(g_table_lookup_w, g_table_lookup)
- Xen_wrap_3_optional_args(g_partials_to_wave_w, g_partials_to_wave)
- Xen_wrap_3_optional_args(g_phase_partials_to_wave_w, g_phase_partials_to_wave)
- Xen_wrap_6_optional_args(g_make_sawtooth_wave_w, g_make_sawtooth_wave)
- Xen_wrap_2_optional_args(g_sawtooth_wave_w, g_sawtooth_wave)
- Xen_wrap_1_arg(g_is_sawtooth_wave_w, g_is_sawtooth_wave)
- Xen_wrap_6_optional_args(g_make_triangle_wave_w, g_make_triangle_wave)
- Xen_wrap_2_optional_args(g_triangle_wave_w, g_triangle_wave)
- Xen_wrap_1_arg(g_is_triangle_wave_w, g_is_triangle_wave)
- Xen_wrap_6_optional_args(g_make_square_wave_w, g_make_square_wave)
- Xen_wrap_2_optional_args(g_square_wave_w, g_square_wave)
- Xen_wrap_1_arg(g_is_square_wave_w, g_is_square_wave)
- Xen_wrap_6_optional_args(g_make_pulse_train_w, g_make_pulse_train)
- Xen_wrap_2_optional_args(g_pulse_train_w, g_pulse_train)
- Xen_wrap_1_arg(g_is_pulse_train_w, g_is_pulse_train)
-
- Xen_wrap_3_args(g_make_pulsed_env_w, g_make_pulsed_env)
- Xen_wrap_2_optional_args(g_pulsed_env_w, g_pulsed_env)
- Xen_wrap_1_arg(g_is_pulsed_env_w, g_is_pulsed_env)
-
- Xen_wrap_3_optional_args(g_asymmetric_fm_w, g_asymmetric_fm)
- Xen_wrap_1_arg(g_is_asymmetric_fm_w, g_is_asymmetric_fm)
- Xen_wrap_4_optional_args(g_make_one_zero_w, g_make_one_zero)
- Xen_wrap_2_optional_args(g_one_zero_w, g_one_zero)
- Xen_wrap_1_arg(g_is_one_zero_w, g_is_one_zero)
- Xen_wrap_4_optional_args(g_make_one_pole_w, g_make_one_pole)
- Xen_wrap_2_optional_args(g_one_pole_w, g_one_pole)
- Xen_wrap_1_arg(g_is_one_pole_w, g_is_one_pole)
- Xen_wrap_6_optional_args(g_make_two_zero_w, g_make_two_zero)
- Xen_wrap_2_optional_args(g_two_zero_w, g_two_zero)
- Xen_wrap_1_arg(g_is_two_zero_w, g_is_two_zero)
- Xen_wrap_6_optional_args(g_make_two_pole_w, g_make_two_pole)
- Xen_wrap_2_optional_args(g_two_pole_w, g_two_pole)
- Xen_wrap_1_arg(g_is_two_pole_w, g_is_two_pole)
-
- Xen_wrap_1_arg(g_is_formant_w, g_is_formant)
- Xen_wrap_4_optional_args(g_make_formant_w, g_make_formant)
- Xen_wrap_3_optional_args(g_formant_w, g_formant)
-
- Xen_wrap_2_optional_args(g_formant_bank_w, g_formant_bank)
- Xen_wrap_1_arg(g_is_formant_bank_w, g_is_formant_bank)
- Xen_wrap_2_optional_args(g_make_formant_bank_w, g_make_formant_bank)
-
- Xen_wrap_1_arg(g_is_firmant_w, g_is_firmant)
- Xen_wrap_4_optional_args(g_make_firmant_w, g_make_firmant)
- Xen_wrap_3_optional_args(g_firmant_w, g_firmant)
-
- Xen_wrap_1_arg(g_is_one_pole_all_pass_w, g_is_one_pole_all_pass)
- Xen_wrap_2_args(g_make_one_pole_all_pass_w, g_make_one_pole_all_pass)
- Xen_wrap_2_optional_args(g_one_pole_all_pass_w, g_one_pole_all_pass)
-
- Xen_wrap_2_args(g_set_formant_frequency_w, g_set_formant_frequency)
- Xen_wrap_3_args(g_set_formant_radius_and_frequency_w, g_set_formant_radius_and_frequency)
-
- Xen_wrap_5_args(g_frample_to_frample_w, g_frample_to_frample)
-
- Xen_wrap_any_args(g_make_wave_train_w, g_make_wave_train)
- Xen_wrap_2_optional_args(g_wave_train_w, g_wave_train)
- Xen_wrap_1_arg(g_is_wave_train_w, g_is_wave_train)
- Xen_wrap_any_args(g_make_polyshape_w, g_make_polyshape)
- Xen_wrap_3_optional_args(g_polyshape_w, g_polyshape)
- Xen_wrap_1_arg(g_is_polyshape_w, g_is_polyshape)
- Xen_wrap_2_optional_args(g_partials_to_polynomial_w, g_partials_to_polynomial)
- Xen_wrap_1_arg(g_normalize_partials_w, g_normalize_partials)
- Xen_wrap_2_args(g_chebyshev_t_sum_w, g_chebyshev_t_sum)
- Xen_wrap_2_args(g_chebyshev_u_sum_w, g_chebyshev_u_sum)
- Xen_wrap_3_args(g_chebyshev_tu_sum_w, g_chebyshev_tu_sum)
- Xen_wrap_any_args(g_make_polywave_w, g_make_polywave)
- Xen_wrap_2_optional_args(g_polywave_w, g_polywave)
- Xen_wrap_1_arg(g_is_polywave_w, g_is_polywave)
-
- Xen_wrap_any_args(g_make_nrxysin_w, g_make_nrxysin)
- Xen_wrap_2_optional_args(g_nrxysin_w, g_nrxysin)
- Xen_wrap_1_arg(g_is_nrxysin_w, g_is_nrxysin)
- Xen_wrap_any_args(g_make_nrxycos_w, g_make_nrxycos)
- Xen_wrap_2_optional_args(g_nrxycos_w, g_nrxycos)
- Xen_wrap_1_arg(g_is_nrxycos_w, g_is_nrxycos)
-
- Xen_wrap_any_args(g_make_rxyksin_w, g_make_rxyksin)
- Xen_wrap_2_optional_args(g_rxyksin_w, g_rxyksin)
- Xen_wrap_1_arg(g_is_rxyksin_w, g_is_rxyksin)
- Xen_wrap_any_args(g_make_rxykcos_w, g_make_rxykcos)
- Xen_wrap_2_optional_args(g_rxykcos_w, g_rxykcos)
- Xen_wrap_1_arg(g_is_rxykcos_w, g_is_rxykcos)
-
- Xen_wrap_6_optional_args(g_make_filter_w, g_make_filter)
- Xen_wrap_2_optional_args(g_filter_w, g_filter)
- Xen_wrap_1_arg(g_is_filter_w, g_is_filter)
- Xen_wrap_4_optional_args(g_make_fir_filter_w, g_make_fir_filter)
- Xen_wrap_2_args(g_make_fir_coeffs_w, g_make_fir_coeffs)
- Xen_wrap_2_optional_args(g_fir_filter_w, g_fir_filter)
- Xen_wrap_1_arg(g_is_fir_filter_w, g_is_fir_filter)
- Xen_wrap_4_optional_args(g_make_iir_filter_w, g_make_iir_filter)
- Xen_wrap_2_optional_args(g_iir_filter_w, g_iir_filter)
- Xen_wrap_1_arg(g_is_iir_filter_w, g_is_iir_filter)
- Xen_wrap_1_arg(g_mus_xcoeffs_w, g_mus_xcoeffs)
- Xen_wrap_1_arg(g_mus_ycoeffs_w, g_mus_ycoeffs)
- Xen_wrap_2_args(g_mus_xcoeff_w, g_mus_xcoeff)
- Xen_wrap_3_args(g_mus_set_xcoeff_w, g_mus_set_xcoeff)
- Xen_wrap_2_args(g_mus_ycoeff_w, g_mus_ycoeff)
- Xen_wrap_3_args(g_mus_set_ycoeff_w, g_mus_set_ycoeff)
- Xen_wrap_1_arg(g_is_env_w, g_is_env)
- Xen_wrap_1_arg(g_env_w, g_env)
- Xen_wrap_any_args(g_make_env_w, g_make_env)
- Xen_wrap_2_args(g_env_interp_w, g_env_interp)
- Xen_wrap_3_optional_args(g_envelope_interp_w, g_envelope_interp)
- Xen_wrap_2_args(g_env_any_w, g_env_any)
- Xen_wrap_1_arg(g_is_file_to_sample_w, g_is_file_to_sample)
- Xen_wrap_2_optional_args(g_make_file_to_sample_w, g_make_file_to_sample)
- Xen_wrap_3_optional_args(g_file_to_sample_w, g_file_to_sample)
- Xen_wrap_1_arg(g_is_sample_to_file_w, g_is_sample_to_file)
- Xen_wrap_5_optional_args(g_make_sample_to_file_w, g_make_sample_to_file)
- Xen_wrap_1_arg(g_continue_sample_to_file_w, g_continue_sample_to_file)
- Xen_wrap_4_args(g_sample_to_file_w, g_sample_to_file)
- Xen_wrap_2_args(g_sample_to_file_add_w, g_sample_to_file_add)
-
- Xen_wrap_1_arg(g_is_file_to_frample_w, g_is_file_to_frample)
- Xen_wrap_2_optional_args(g_make_file_to_frample_w, g_make_file_to_frample)
- Xen_wrap_3_optional_args(g_file_to_frample_w, g_file_to_frample)
- Xen_wrap_1_arg(g_continue_frample_to_file_w, g_continue_frample_to_file)
- Xen_wrap_1_arg(g_is_frample_to_file_w, g_is_frample_to_file)
- Xen_wrap_3_args(g_frample_to_file_w, g_frample_to_file)
- Xen_wrap_5_optional_args(g_make_frample_to_file_w, g_make_frample_to_file)
-
-
- Xen_wrap_1_arg(g_is_mus_input_w, g_is_mus_input)
- Xen_wrap_1_arg(g_is_mus_output_w, g_is_mus_output)
- Xen_wrap_3_args(g_in_any_w, g_in_any)
- Xen_wrap_2_args(g_ina_w, g_ina)
- Xen_wrap_2_args(g_inb_w, g_inb)
- Xen_wrap_4_optional_args(g_out_any_w, g_out_any)
- Xen_wrap_3_optional_args(g_outa_w, g_outa)
- Xen_wrap_3_optional_args(g_outb_w, g_outb)
- Xen_wrap_3_optional_args(g_outc_w, g_outc)
- Xen_wrap_3_optional_args(g_outd_w, g_outd)
- Xen_wrap_1_arg(g_mus_close_w, g_mus_close)
- Xen_wrap_no_args(g_mus_file_buffer_size_w, g_mus_file_buffer_size)
- Xen_wrap_1_arg(g_mus_set_file_buffer_size_w, g_mus_set_file_buffer_size)
- Xen_wrap_1_arg(g_is_readin_w, g_is_readin)
- Xen_wrap_1_arg(g_readin_w, g_readin)
- Xen_wrap_any_args(g_make_readin_w, g_make_readin)
- Xen_wrap_1_arg(g_mus_channel_w, g_mus_channel)
- Xen_wrap_1_arg(g_mus_interp_type_w, g_mus_interp_type)
- Xen_wrap_1_arg(g_mus_location_w, g_mus_location)
- Xen_wrap_2_args(g_mus_set_location_w, g_mus_set_location)
- Xen_wrap_1_arg(g_mus_increment_w, g_mus_increment)
- Xen_wrap_2_args(g_mus_set_increment_w, g_mus_set_increment)
- Xen_wrap_1_arg(g_mus_feedback_w, g_mus_feedback)
- Xen_wrap_2_args(g_mus_set_feedback_w, g_mus_set_feedback)
- Xen_wrap_1_arg(g_is_locsig_w, g_is_locsig)
- Xen_wrap_3_args(g_locsig_w, g_locsig)
- Xen_wrap_any_args(g_make_locsig_w, g_make_locsig)
- Xen_wrap_3_args(g_move_locsig_w, g_move_locsig)
- Xen_wrap_no_args(g_locsig_type_w, g_locsig_type)
- Xen_wrap_1_arg(g_set_locsig_type_w, g_set_locsig_type)
- Xen_wrap_1_arg(g_mus_channels_w, g_mus_channels)
- Xen_wrap_2_args(g_locsig_ref_w, g_locsig_ref)
- Xen_wrap_2_args(g_locsig_reverb_ref_w, g_locsig_reverb_ref)
- Xen_wrap_3_args(g_locsig_set_w, g_locsig_set)
- Xen_wrap_3_args(g_locsig_reverb_set_w, g_locsig_reverb_set)
- Xen_wrap_1_arg(g_is_move_sound_w, g_is_move_sound)
- Xen_wrap_3_args(g_move_sound_w, g_move_sound)
- Xen_wrap_3_optional_args(g_make_move_sound_w, g_make_move_sound)
- Xen_wrap_no_args(g_mus_clear_sincs_w, g_mus_clear_sincs)
- Xen_wrap_1_arg(g_is_src_w, g_is_src)
- Xen_wrap_3_optional_args(g_src_w, g_src)
- Xen_wrap_6_optional_args(g_make_src_w, g_make_src)
- Xen_wrap_1_arg(g_is_granulate_w, g_is_granulate)
- Xen_wrap_3_optional_args(g_granulate_w, g_granulate)
- Xen_wrap_any_args(g_make_granulate_w, g_make_granulate)
- Xen_wrap_1_arg(g_mus_ramp_w, g_mus_ramp)
- Xen_wrap_2_args(g_mus_set_ramp_w, g_mus_set_ramp)
- Xen_wrap_1_arg(g_is_convolve_w, g_is_convolve)
- Xen_wrap_2_optional_args(g_convolve_w, g_convolve)
- Xen_wrap_any_args(g_make_convolve_w, g_make_convolve)
- Xen_wrap_4_optional_args(g_convolve_files_w, g_convolve_files)
- Xen_wrap_1_arg(g_is_phase_vocoder_w, g_is_phase_vocoder)
- Xen_wrap_5_optional_args(g_phase_vocoder_w, g_phase_vocoder)
- Xen_wrap_any_args(g_make_phase_vocoder_w, g_make_phase_vocoder)
- Xen_wrap_1_arg(g_phase_vocoder_amp_increments_w, g_phase_vocoder_amp_increments)
- Xen_wrap_1_arg(g_phase_vocoder_amps_w, g_phase_vocoder_amps)
- Xen_wrap_1_arg(g_phase_vocoder_freqs_w, g_phase_vocoder_freqs)
- Xen_wrap_1_arg(g_phase_vocoder_phases_w, g_phase_vocoder_phases)
- Xen_wrap_1_arg(g_phase_vocoder_phase_increments_w, g_phase_vocoder_phase_increments)
- Xen_wrap_1_arg(g_mus_hop_w, g_mus_hop)
- Xen_wrap_2_args(g_mus_set_hop_w, g_mus_set_hop)
- Xen_wrap_4_optional_args(g_make_ssb_am_w, g_make_ssb_am)
- Xen_wrap_3_optional_args(g_ssb_am_w, g_ssb_am)
- Xen_wrap_1_arg(g_is_ssb_am_w, g_is_ssb_am)
- Xen_wrap_no_args(g_clm_table_size_w, g_clm_table_size)
- Xen_wrap_1_arg(g_set_clm_table_size_w, g_set_clm_table_size)
- Xen_wrap_no_args(g_clm_default_frequency_w, g_clm_default_frequency)
- Xen_wrap_1_arg(g_set_clm_default_frequency_w, g_set_clm_default_frequency)
- Xen_wrap_1_arg(g_is_mus_generator_w, g_is_mus_generator)
- Xen_wrap_1_arg(g_mus_frandom_w, g_mus_frandom)
- Xen_wrap_1_arg(g_mus_irandom_w, g_mus_irandom)
- Xen_wrap_4_optional_args(g_make_oscil_w, g_make_oscil)
- Xen_wrap_4_optional_args(g_make_ncos_w, g_make_ncos)
- Xen_wrap_4_optional_args(g_make_oscil_bank_w, g_make_oscil_bank)
- Xen_wrap_4_optional_args(g_make_nsin_w, g_make_nsin)
- Xen_wrap_8_optional_args(g_make_asymmetric_fm_w, g_make_asymmetric_fm)
- Xen_wrap_any_args(g_mus_file_mix_w, g_mus_file_mix)
- Xen_wrap_any_args(g_mus_file_mix_with_envs_w, g_mus_file_mix_with_envs)
- Xen_wrap_2_optional_args(g_comb_bank_w, g_comb_bank)
- Xen_wrap_1_arg(g_is_comb_bank_w, g_is_comb_bank)
- Xen_wrap_1_arg(g_make_comb_bank_w, g_make_comb_bank)
- Xen_wrap_2_optional_args(g_filtered_comb_bank_w, g_filtered_comb_bank)
- Xen_wrap_1_arg(g_is_filtered_comb_bank_w, g_is_filtered_comb_bank)
- Xen_wrap_1_arg(g_make_filtered_comb_bank_w, g_make_filtered_comb_bank)
- Xen_wrap_2_optional_args(g_all_pass_bank_w, g_all_pass_bank)
- Xen_wrap_1_arg(g_is_all_pass_bank_w, g_is_all_pass_bank)
- Xen_wrap_1_arg(g_make_all_pass_bank_w, g_make_all_pass_bank)
- Xen_wrap_1_arg(g_pink_noise_w, g_pink_noise)
- Xen_wrap_3_args(g_out_bank_w, g_out_bank)
-
- #if HAVE_SCHEME
- Xen_wrap_2_args(g_piano_noise_w, g_piano_noise)
- Xen_wrap_6_args(g_singer_filter_w, g_singer_filter)
- Xen_wrap_5_args(g_singer_nose_filter_w, g_singer_nose_filter)
- #endif
-
- #if HAVE_SCHEME
- static s7_pointer acc_clm_srate(s7_scheme *sc, s7_pointer args) {return(g_mus_set_srate(s7_cadr(args)));}
- static s7_pointer acc_clm_default_frequency(s7_scheme *sc, s7_pointer args) {return(g_set_clm_default_frequency(s7_cadr(args)));}
- static s7_pointer acc_clm_table_size(s7_scheme *sc, s7_pointer args) {return(g_set_clm_table_size(s7_cadr(args)));}
- static s7_pointer acc_mus_file_buffer_size(s7_scheme *sc, s7_pointer args) {return(g_mus_set_file_buffer_size(s7_cadr(args)));}
- static s7_pointer acc_mus_float_equal_fudge_factor(s7_scheme *sc, s7_pointer args) {return(g_mus_set_float_equal_fudge_factor(s7_cadr(args)));}
- static s7_pointer acc_mus_array_print_length(s7_scheme *sc, s7_pointer args) {return(g_mus_set_array_print_length(s7_cadr(args)));}
- #endif
-
- #if HAVE_SCHEME
- static char *mus_generator_to_readable_string(s7_scheme *sc, void *obj)
- {
- char *str;
- str = (char *)malloc(64 * sizeof(char));
- snprintf(str, 64, "#<%s>", mus_name(((mus_xen *)obj)->gen));
- return(str);
- /* we need a new function to fill this role */
- /* s7_error(sc, s7_make_symbol(sc, "io-error"), s7_list(sc, 1, s7_make_string(sc, "can't write a clm generator readably"))); */
- /* return(NULL); */
- }
- #endif
-
- static void mus_xen_init(void)
- {
- #if HAVE_SCHEME
- s7_pointer s, i, p, t, r, c, f, v, b, d, j;
-
- s7_pointer pl_rcr, pl_bt, pl_ir, pl_cc, pl_ccic, pl_ccrr, pl_fc, pl_fcif, pl_cs, pl_ff, pl_tt, pl_fffifi, pl_ffftii, pl_fffi,
- pl_fti, pl_fif, pl_fiir, pl_fttb, pl_ic, pl_rciir, pl_rcir, pl_ririt, pl_rcrr, pl_rirt, pl_riirfff, pl_rirfff, pl_rrpr,
- pl_sc, pl_sssrs, pl_tc, pl_ici, pl_i, pl_fcf, pl_dcr, pl_dr, pl_dffi, pl_dfri, pl_dirfir, pl_dc, pl_dci, pl_dcir, pl_dv,
- pl_dvir, pl_drf, pl_drc, pl_diit, pl_dit, pl_dct, pl_d, pl_djr, pl_it, pl_iti;
- #endif
-
- mus_initialize();
- current_connect_func = Xen_false;
-
- #if HAVE_SCHEME
- mus_xen_tag = s7_new_type_x(s7, "<generator>", print_mus_xen, free_mus_xen, s7_equalp_mus_xen, mark_mus_xen,
- mus_xen_apply, NULL, s7_mus_length, s7_mus_copy, NULL, NULL);
- as_needed_arglist = Xen_list_1(Xen_integer_zero);
- Xen_GC_protect(as_needed_arglist);
- s7_set_object_print_readably(mus_xen_tag, mus_generator_to_readable_string);
-
- s = s7_make_symbol(s7, "string?");
- i = s7_make_symbol(s7, "integer?");
- p = s7_make_symbol(s7, "pair?");
- t = s7_t(s7);
- r = s7_make_symbol(s7, "real?");
- c = s7_t(s7); /* s7_make_symbol(s7, "c-object?"): this should be mus-generator which should match against oscil? etc -- maybe someday... */
- f = s7_make_symbol(s7, "float-vector?");
- j = s7_make_symbol(s7, "int-vector?");
- v = s7_make_symbol(s7, "vector?");
- b = s7_make_symbol(s7, "boolean?");
- d = s7_make_symbol(s7, "float?");
-
- pl_bt = s7_make_signature(s7, 2, b, t);
- pl_rcr = s7_make_signature(s7, 3, r, c, r);
-
- pl_d = s7_make_signature(s7, 1, d);
- pl_dcr = s7_make_circular_signature(s7, 2, 3, d, c, r);
- pl_djr = s7_make_circular_signature(s7, 2, 3, d, j, r);
- pl_dct = s7_make_signature(s7, 3, d, c, t);
- pl_dci = s7_make_circular_signature(s7, 2, 3, d, c, i);
- pl_dcir = s7_make_signature(s7, 4, d, c, i, r);
- pl_dr = s7_make_circular_signature(s7, 1, 2, d, r);
- pl_dffi = s7_make_signature(s7, 4, d, f, f, i);
- pl_dfri = s7_make_signature(s7, 4, d, f, r, i);
- pl_dirfir = s7_make_signature(s7, 6, d, i, r, f, i, r);
- pl_dc = s7_make_signature(s7, 2, d, c);
- pl_dv = s7_make_signature(s7, 2, d, v);
- pl_dvir = s7_make_signature(s7, 4, d, v, i, r);
- pl_drf = s7_make_circular_signature(s7, 2, 3, d, r, f);
- pl_drc = s7_make_signature(s7, 3, d, r, c);
- pl_diit = s7_make_signature(s7, 4, d, i, i, t);
- pl_dit = s7_make_signature(s7, 3, d, i, t);
-
- pl_ir = s7_make_signature(s7, 2, i, r);
- pl_i = s7_make_circular_signature(s7, 0, 1, i);
- pl_cc = s7_make_circular_signature(s7, 1, 2, c, c);
- pl_ici = s7_make_signature(s7, 3, i, c, i);
- pl_iti = s7_make_signature(s7, 3, i, t, i);
- pl_ccic = s7_make_signature(s7, 4, c, c, i, c);
- pl_ccrr = s7_make_signature(s7, 4, c, c, r, r);
- pl_fc = s7_make_signature(s7, 2, s7_make_signature(s7, 2, f, b), c);
- pl_cs = s7_make_signature(s7, 2, c, s);
- pl_ff = s7_make_circular_signature(s7, 1, 2, f, f);
- pl_tt = s7_make_signature(s7, 2, t, t);
- pl_fcf = s7_make_signature(s7, 3, f, c, f);
- pl_fffifi = s7_make_signature(s7, 6, f, f, f, i, f, i);
- pl_ffftii = s7_make_signature(s7, 6, f, f, f, t, i, i);
- pl_fffi = s7_make_circular_signature(s7, 3, 4, f, f, f, i);
- pl_fti = s7_make_signature(s7, 3, f, t, i);
- pl_fif = s7_make_signature(s7, 3, f, i, f);
- pl_fiir = s7_make_circular_signature(s7, 3, 4, f, i, i, r);
- pl_fttb = s7_make_signature(s7, 4, f, t, t, b);
- pl_ic = s7_make_signature(s7, 2, i, c);
- pl_it = s7_make_signature(s7, 2, i, t);
- pl_rciir = s7_make_signature(s7, 5, r, c, i, i, r);
- pl_rcir = s7_make_signature(s7, 4, r, c, i, r);
- pl_ririt = s7_make_signature(s7,5, r, i, r, i, t);
- pl_rcrr = s7_make_signature(s7, 4, r, c, r, r);
- pl_rirt = s7_make_signature(s7, 4, r, i, r, t);
- pl_riirfff = s7_make_signature(s7, 7, r, i, i, r, f, f, f);
- pl_rirfff = s7_make_signature(s7, 6, r, i, r, f, f, f);
- pl_rrpr = s7_make_signature(s7, 4, r, r, p, r);
- pl_sc = s7_make_signature(s7, 2, s, c);
- pl_sssrs = s7_make_signature(s7, 5, s, s, s, r, s);
- pl_tc = s7_make_signature(s7, 2, t, c);
- pl_fcif = s7_make_signature(s7, 4, f, c, i, f);
- #else
- mus_xen_tag = Xen_make_object_type("Mus", sizeof(mus_xen));
- #endif
-
- xen_one = C_int_to_Xen_integer(1);
- Xen_GC_protect(xen_one);
- xen_minus_one = C_int_to_Xen_integer(-1);
- Xen_GC_protect(xen_minus_one);
-
- #if HAVE_FORTH
- fth_set_object_inspect(mus_xen_tag, print_mus_xen);
- fth_set_object_equal(mus_xen_tag, equalp_mus_xen);
- fth_set_object_mark(mus_xen_tag, mark_mus_xen);
- fth_set_object_free(mus_xen_tag, free_mus_xen);
- fth_set_object_apply(mus_xen_tag, Xen_procedure_cast mus_xen_apply, 0, 2, 0);
- #endif
-
- #if HAVE_RUBY
- rb_define_method(mus_xen_tag, "to_s", Xen_procedure_cast mus_xen_to_s, 0);
- rb_define_method(mus_xen_tag, "eql?", Xen_procedure_cast equalp_mus_xen, 1);
- rb_define_method(mus_xen_tag, "frequency", Xen_procedure_cast g_mus_frequency, 0);
- rb_define_method(mus_xen_tag, "frequency=", Xen_procedure_cast g_mus_set_frequency, 1);
- rb_define_method(mus_xen_tag, "phase", Xen_procedure_cast g_mus_phase, 0);
- rb_define_method(mus_xen_tag, "phase=", Xen_procedure_cast g_mus_set_phase, 1);
- rb_define_method(mus_xen_tag, "scaler", Xen_procedure_cast g_mus_scaler, 0);
- rb_define_method(mus_xen_tag, "scaler=", Xen_procedure_cast g_mus_set_scaler, 1);
- rb_define_method(mus_xen_tag, "width", Xen_procedure_cast g_mus_width, 0);
- rb_define_method(mus_xen_tag, "width=", Xen_procedure_cast g_mus_set_width, 1);
- rb_define_method(mus_xen_tag, "offset", Xen_procedure_cast g_mus_offset, 0);
- rb_define_method(mus_xen_tag, "offset=", Xen_procedure_cast g_mus_set_offset, 1);
- rb_define_method(mus_xen_tag, "reset", Xen_procedure_cast g_mus_reset, 0);
- /* rb_define_method(mus_xen_tag, "copy", Xen_procedure_cast g_mus_copy, 0); */
- rb_define_method(mus_xen_tag, "length", Xen_procedure_cast g_mus_length, 0);
- rb_define_method(mus_xen_tag, "length=", Xen_procedure_cast g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "data", Xen_procedure_cast g_mus_data, 0);
- rb_define_method(mus_xen_tag, "data=", Xen_procedure_cast g_mus_set_data, 1);
- rb_define_method(mus_xen_tag, "feedforward", Xen_procedure_cast g_mus_feedforward, 0);
- rb_define_method(mus_xen_tag, "feedforward=", Xen_procedure_cast g_mus_set_feedforward, 1);
- rb_define_method(mus_xen_tag, "feedback", Xen_procedure_cast g_mus_feedback, 0);
- rb_define_method(mus_xen_tag, "feedback=", Xen_procedure_cast g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "order", Xen_procedure_cast g_mus_order, 0);
- rb_define_method(mus_xen_tag, "type", Xen_procedure_cast g_mus_type, 0);
- rb_define_method(mus_xen_tag, "order=", Xen_procedure_cast g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "call", Xen_procedure_cast mus_xen_apply, 2);
- rb_define_method(mus_xen_tag, "location", Xen_procedure_cast g_mus_location, 0);
- rb_define_method(mus_xen_tag, "location=", Xen_procedure_cast g_mus_set_location, 1);
- rb_define_method(mus_xen_tag, "increment", Xen_procedure_cast g_mus_increment, 0);
- rb_define_method(mus_xen_tag, "increment=", Xen_procedure_cast g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "channels", Xen_procedure_cast g_mus_channels, 0);
- rb_define_method(mus_xen_tag, "channel", Xen_procedure_cast g_mus_channel, 0);
- rb_define_method(mus_xen_tag, "interp_type", Xen_procedure_cast g_mus_interp_type, 0);
- rb_define_method(mus_xen_tag, "xcoeffs", Xen_procedure_cast g_mus_xcoeffs, 0);
- rb_define_method(mus_xen_tag, "ycoeffs", Xen_procedure_cast g_mus_ycoeffs, 0);
- rb_define_method(mus_xen_tag, "xcoeff", Xen_procedure_cast g_mus_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff", Xen_procedure_cast g_mus_ycoeff, 1);
- /*
- rb_define_method(mus_xen_tag, "xcoeff=", Xen_procedure_cast g_mus_set_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff=", Xen_procedure_cast g_mus_set_ycoeff, 1);
- */
- rb_define_method(mus_xen_tag, "ramp", Xen_procedure_cast g_mus_ramp, 0);
- rb_define_method(mus_xen_tag, "ramp=", Xen_procedure_cast g_mus_set_ramp, 1);
- rb_define_method(mus_xen_tag, "hop", Xen_procedure_cast g_mus_hop, 0);
- rb_define_method(mus_xen_tag, "hop=", Xen_procedure_cast g_mus_set_hop, 1);
- rb_define_method(mus_xen_tag, "name", Xen_procedure_cast g_mus_name, 0);
- rb_define_method(mus_xen_tag, "file_name", Xen_procedure_cast g_mus_file_name, 0);
- #endif
-
- init_keywords();
-
- Xen_define_typed_dilambda(S_mus_srate, g_mus_srate_w, H_mus_srate,
- S_set S_mus_srate, g_mus_set_srate_w, 0, 0, 1, 0, pl_d, pl_dr);
- Xen_define_typed_dilambda(S_mus_float_equal_fudge_factor, g_mus_float_equal_fudge_factor_w, H_mus_float_equal_fudge_factor,
- S_set S_mus_float_equal_fudge_factor, g_mus_set_float_equal_fudge_factor_w, 0, 0, 1, 0, pl_d, pl_dr);
- Xen_define_typed_dilambda(S_mus_array_print_length, g_mus_array_print_length_w, H_mus_array_print_length,
- S_set S_mus_array_print_length, g_mus_set_array_print_length_w, 0, 0, 1, 0, pl_i, pl_i);
- Xen_define_typed_dilambda(S_clm_table_size, g_clm_table_size_w, H_clm_table_size,
- S_set S_clm_table_size, g_set_clm_table_size_w, 0, 0, 1, 0, pl_i, pl_i);
- Xen_define_typed_dilambda(S_clm_default_frequency, g_clm_default_frequency_w, H_clm_default_frequency,
- S_set S_clm_default_frequency, g_set_clm_default_frequency_w, 0, 0, 1, 0, pl_d, pl_dr);
-
- #if HAVE_SCHEME
- clm_srate_symbol = s7_define_variable(s7, "*clm-srate*", s7_make_real(s7, MUS_DEFAULT_SAMPLING_RATE));
- s7_symbol_set_access(s7, clm_srate_symbol, s7_make_function(s7, "[acc-clm-srate]", acc_clm_srate, 2, 0, false, "accessor"));
-
- clm_default_frequency_symbol = s7_define_variable(s7, "*" S_clm_default_frequency "*", s7_make_real(s7, MUS_CLM_DEFAULT_FREQUENCY));
- s7_symbol_set_documentation(s7, clm_default_frequency_symbol, "*clm-default-frequency*: the default frequency for most generators (0.0)");
- s7_symbol_set_access(s7, clm_default_frequency_symbol, s7_make_function(s7, "[acc-clm-default-frequency]", acc_clm_default_frequency, 2, 0, false, "accessor"));
-
- clm_table_size_symbol = s7_define_variable(s7, "*" S_clm_table_size "*", s7_make_integer(s7, MUS_CLM_DEFAULT_TABLE_SIZE));
- s7_symbol_set_documentation(s7, clm_table_size_symbol, "*clm-table-size*: the default table size for most generators (512)");
- s7_symbol_set_access(s7, clm_table_size_symbol, s7_make_function(s7, "[acc-clm-table-size]", acc_clm_table_size, 2, 0, false, "accessor"));
-
- mus_file_buffer_size_symbol = s7_define_variable(s7, "*clm-file-buffer-size*", s7_make_integer(s7, MUS_DEFAULT_FILE_BUFFER_SIZE));
- s7_symbol_set_access(s7, mus_file_buffer_size_symbol, s7_make_function(s7, "[acc-mus-file-buffer-size]", acc_mus_file_buffer_size, 2, 0, false, "accessor"));
-
- mus_float_equal_fudge_factor_symbol = s7_define_variable(s7, "*" S_mus_float_equal_fudge_factor "*", s7_make_real(s7, 0.0000001)); /* clm.c */
- s7_symbol_set_documentation(s7, mus_float_equal_fudge_factor_symbol, "*mus-float-equal-fudge-factor*: floating point equality fudge factor");
- s7_symbol_set_access(s7, mus_float_equal_fudge_factor_symbol, s7_make_function(s7, "[acc-mus-float-equal-fudge-factor]", acc_mus_float_equal_fudge_factor, 2, 0, false, "accessor"));
-
- mus_array_print_length_symbol = s7_define_variable(s7, "*" S_mus_array_print_length "*", s7_make_integer(s7, MUS_DEFAULT_ARRAY_PRINT_LENGTH));
- s7_symbol_set_documentation(s7, mus_array_print_length_symbol, "*mus-array-print-length*: current clm array print length (default is 8).");
- s7_symbol_set_access(s7, mus_array_print_length_symbol, s7_make_function(s7, "[acc-mus-array-print-length]", acc_mus_array_print_length, 2, 0, false, "accessor"));
- #endif
-
- Xen_define_typed_procedure(S_radians_to_hz, g_radians_to_hz_w, 1, 0, 0, H_radians_to_hz, pl_dr);
- Xen_define_typed_procedure(S_hz_to_radians, g_hz_to_radians_w, 1, 0, 0, H_hz_to_radians, pl_dr);
- Xen_define_typed_procedure(S_radians_to_degrees, g_radians_to_degrees_w, 1, 0, 0, H_radians_to_degrees, pl_dr);
- Xen_define_typed_procedure(S_degrees_to_radians, g_degrees_to_radians_w, 1, 0, 0, H_degrees_to_radians, pl_dr);
- Xen_define_typed_procedure(S_db_to_linear, g_db_to_linear_w, 1, 0, 0, H_db_to_linear, pl_dr);
- Xen_define_typed_procedure(S_linear_to_db, g_linear_to_db_w, 1, 0, 0, H_linear_to_db, pl_dr);
- Xen_define_typed_procedure(S_even_weight, g_even_weight_w, 1, 0, 0, H_even_weight, pl_dr);
- Xen_define_typed_procedure(S_odd_weight, g_odd_weight_w, 1, 0, 0, H_odd_weight, pl_dr);
- Xen_define_typed_procedure(S_even_multiple, g_even_multiple_w, 2, 0, 0, H_even_multiple, pl_dr);
- Xen_define_typed_procedure(S_odd_multiple, g_odd_multiple_w, 2, 0, 0, H_odd_multiple, pl_dr);
- Xen_define_typed_procedure(S_seconds_to_samples, g_seconds_to_samples_w, 1, 0, 0, H_seconds_to_samples, pl_ir);
- Xen_define_typed_procedure(S_samples_to_seconds, g_samples_to_seconds_w, 1, 0, 0, H_samples_to_seconds, pl_dr);
- Xen_define_typed_procedure(S_ring_modulate, g_ring_modulate_w, 2, 0, 0, H_ring_modulate, pl_dr);
- Xen_define_typed_procedure(S_amplitude_modulate, g_amplitude_modulate_w, 3, 0, 0, H_amplitude_modulate, pl_dr);
- Xen_define_typed_procedure(S_contrast_enhancement, g_contrast_enhancement_w, 1, 1, 0, H_contrast_enhancement, pl_dr);
- Xen_define_typed_procedure(S_dot_product, g_dot_product_w, 2, 1, 0, H_dot_product, pl_dffi);
- #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
- Xen_define_typed_procedure(S_edot_product, g_edot_product_w, 2, 0, 0, H_edot_product, NULL);
- #endif
- Xen_define_typed_procedure(S_polynomial, g_polynomial_w, 2, 0, 0, H_polynomial, pl_dfri);
- Xen_define_typed_procedure(S_make_fft_window, g_make_fft_window_w, 2, 2, 0, H_make_fft_window, pl_fiir);
- Xen_define_typed_procedure(S_mus_fft, g_mus_fft_w, 2, 2, 0, H_mus_fft, pl_fffi);
- Xen_define_typed_procedure(S_spectrum, g_spectrum_w, 3, 1, 0, H_mus_spectrum, pl_ffftii);
- Xen_define_typed_procedure(S_autocorrelate, g_autocorrelate_w, 1, 0, 0, H_autocorrelate, pl_ff);
- Xen_define_typed_procedure(S_correlate, g_correlate_w, 2, 0, 0, H_correlate, pl_ff);
- Xen_define_typed_procedure(S_convolution, g_convolution_w, 2, 1, 0, H_mus_convolution, pl_fffi);
- Xen_define_typed_procedure(S_rectangular_to_polar, g_rectangular_to_polar_w, 2, 0, 0, H_rectangular_to_polar, pl_ff);
- Xen_define_typed_procedure(S_rectangular_to_magnitudes, g_rectangular_to_magnitudes_w, 2, 0, 0, H_rectangular_to_magnitudes, pl_ff);
- Xen_define_typed_procedure(S_polar_to_rectangular, g_polar_to_rectangular_w, 2, 0, 0, H_polar_to_rectangular, pl_ff);
- Xen_define_typed_procedure(S_array_interp, g_array_interp_w, 2, 1, 0, H_array_interp, pl_dfri);
- Xen_define_typed_procedure(S_mus_interpolate, g_mus_interpolate_w, 3, 2, 0, H_mus_interpolate, pl_dirfir);
- Xen_define_typed_procedure(S_mus_frandom, g_mus_frandom_w, 1, 0, 0, "random reals", pl_dr);
- Xen_define_typed_procedure(S_mus_irandom, g_mus_irandom_w, 1, 0, 0, "random integers", pl_i);
-
- Xen_define_constant(S_rectangular_window, MUS_RECTANGULAR_WINDOW, "The un-window, so to speak");
- Xen_define_constant(S_hann_window, MUS_HANN_WINDOW, "A simple raised cosine window");
- Xen_define_constant(S_welch_window, MUS_WELCH_WINDOW, "A triangular window squared");
- Xen_define_constant(S_parzen_window, MUS_PARZEN_WINDOW, "A triangular window");
- Xen_define_constant(S_bartlett_window, MUS_BARTLETT_WINDOW, "A triangular window");
- Xen_define_constant(S_bartlett_hann_window, MUS_BARTLETT_HANN_WINDOW, "A combination of the bartlett and hann windows");
- Xen_define_constant(S_bohman_window, MUS_BOHMAN_WINDOW, "A weighted cosine window");
- Xen_define_constant(S_flat_top_window, MUS_FLAT_TOP_WINDOW, "A sum of cosines window");
- Xen_define_constant(S_hamming_window, MUS_HAMMING_WINDOW, "A raised cosine");
- Xen_define_constant(S_blackman2_window, MUS_BLACKMAN2_WINDOW, "second order cosine window");
- Xen_define_constant(S_blackman3_window, MUS_BLACKMAN3_WINDOW, "third order cosine window");
- Xen_define_constant(S_blackman4_window, MUS_BLACKMAN4_WINDOW, "4th order cosine window");
- Xen_define_constant(S_blackman5_window, MUS_BLACKMAN5_WINDOW, "5th order cosine window");
- Xen_define_constant(S_blackman6_window, MUS_BLACKMAN6_WINDOW, "6th order cosine window");
- Xen_define_constant(S_blackman7_window, MUS_BLACKMAN7_WINDOW, "7th order cosine window");
- Xen_define_constant(S_blackman8_window, MUS_BLACKMAN8_WINDOW, "8th order cosine window");
- Xen_define_constant(S_blackman9_window, MUS_BLACKMAN9_WINDOW, "9th order cosine window");
- Xen_define_constant(S_blackman10_window, MUS_BLACKMAN10_WINDOW, "10th order cosine window");
- Xen_define_constant(S_exponential_window, MUS_EXPONENTIAL_WINDOW, "An inverted triangle from exp");
- Xen_define_constant(S_riemann_window, MUS_RIEMANN_WINDOW, "sinc-based window");
- Xen_define_constant(S_kaiser_window, MUS_KAISER_WINDOW, "Bessel I0 based window");
- Xen_define_constant(S_cauchy_window, MUS_CAUCHY_WINDOW, "window based on 1/(1+sqr(angle)");
- Xen_define_constant(S_poisson_window, MUS_POISSON_WINDOW, "window based on exp(-angle)");
- Xen_define_constant(S_gaussian_window, MUS_GAUSSIAN_WINDOW, "window based on exp(-sqr(angle))");
- Xen_define_constant(S_tukey_window, MUS_TUKEY_WINDOW, "window based on truncated cosine");
- Xen_define_constant(S_dolph_chebyshev_window, MUS_DOLPH_CHEBYSHEV_WINDOW, "window from inverse fft (using Chebyshev Tn)");
- Xen_define_constant(S_connes_window, MUS_CONNES_WINDOW, "triangle window squared twice");
- Xen_define_constant(S_hann_poisson_window, MUS_HANN_POISSON_WINDOW, "poisson window * hann window");
- Xen_define_constant(S_samaraki_window, MUS_SAMARAKI_WINDOW, "window from inverse fft (using Chebyshev Un)");
- Xen_define_constant(S_ultraspherical_window, MUS_ULTRASPHERICAL_WINDOW, "window from inverse fft (using Ultraspherical Cn)");
- Xen_define_constant(S_rv2_window, MUS_RV2_WINDOW, "Rife-Vincent second order window (Hann extension)");
- Xen_define_constant(S_rv3_window, MUS_RV3_WINDOW, "Rife-Vincent third order window (Hann extension)");
- Xen_define_constant(S_rv4_window, MUS_RV4_WINDOW, "Rife-Vincent 4th order window (Hann extension)");
- Xen_define_constant(S_mlt_sine_window, MUS_MLT_SINE_WINDOW, "modulated lapped transform sine window");
- Xen_define_constant(S_papoulis_window, MUS_PAPOULIS_WINDOW, "papoulise window");
- Xen_define_constant(S_dpss_window, MUS_DPSS_WINDOW, "proplate spheroidal (slepian) window");
- Xen_define_constant(S_sinc_window, MUS_SINC_WINDOW, "sinc (Lanczos) window");
-
- Xen_define_constant(S_mus_interp_linear, MUS_INTERP_LINEAR, "locsig/delay linear interpolation");
- Xen_define_constant(S_mus_interp_sinusoidal, MUS_INTERP_SINUSOIDAL, "locsig sinusoidal interpolation");
- Xen_define_constant(S_mus_interp_all_pass, MUS_INTERP_ALL_PASS, "delay interpolation");
- Xen_define_constant(S_mus_interp_lagrange, MUS_INTERP_LAGRANGE, "second order lagrange interpolation");
- Xen_define_constant(S_mus_interp_hermite, MUS_INTERP_HERMITE, "third order hermite interpolation");
- Xen_define_constant(S_mus_interp_none, MUS_INTERP_NONE, "no interpolation -- step func");
- Xen_define_constant(S_mus_interp_bezier, MUS_INTERP_BEZIER, "bezier interpolation");
-
- Xen_define_constant(S_mus_chebyshev_first_kind, MUS_CHEBYSHEV_FIRST_KIND, "Chebyshev polynomial of first kind, for " S_partials_to_polynomial);
- Xen_define_constant(S_mus_chebyshev_second_kind, MUS_CHEBYSHEV_SECOND_KIND, "Chebyshev polynomial of second kind, for " S_partials_to_polynomial);
- Xen_define_constant(S_mus_chebyshev_both_kinds, MUS_CHEBYSHEV_BOTH_KINDS, "use both Chebyshev polynomials in polywave");
-
- Xen_define_typed_procedure(S_mus_describe, g_mus_describe_w, 1, 0, 0, H_mus_describe, pl_sc);
- Xen_define_typed_procedure(S_mus_file_name, g_mus_file_name_w, 1, 0, 0, H_mus_file_name, pl_sc);
- Xen_define_typed_procedure(S_mus_reset, g_mus_reset_w, 1, 0, 0, H_mus_reset, pl_tc);
- Xen_define_typed_procedure(S_mus_copy, g_mus_copy_w, 1, 0, 0, H_mus_copy, pl_cc);
- Xen_define_typed_procedure(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run, pl_dcr);
-
- Xen_define_typed_procedure(S_mus_name, g_mus_name_w, 1, 0, 0, H_mus_name, pl_sc);
- Xen_define_typed_dilambda(S_mus_phase, g_mus_phase_w, H_mus_phase, S_set S_mus_phase, g_mus_set_phase_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_scaler, g_mus_scaler_w, H_mus_scaler, S_set S_mus_scaler, g_mus_set_scaler_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_width, g_mus_width_w, H_mus_width, S_set S_mus_width, g_mus_set_width_w, 1, 0, 2, 0, pl_ic, pl_ici);
- Xen_define_typed_dilambda(S_mus_frequency, g_mus_frequency_w, H_mus_frequency, S_set S_mus_frequency, g_mus_set_frequency_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_length, g_mus_length_w, H_mus_length, S_set S_mus_length, g_mus_set_length_w, 1, 0, 2, 0, pl_it, pl_iti);
- Xen_define_typed_dilambda(S_mus_data, g_mus_data_w, H_mus_data, S_set S_mus_data, g_mus_set_data_w, 1, 0, 2, 0, pl_fc, pl_fcf);
- Xen_define_typed_dilambda(S_mus_xcoeff, g_mus_xcoeff_w, H_mus_xcoeff, S_set S_mus_xcoeff, g_mus_set_xcoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_mus_ycoeff, g_mus_ycoeff_w, H_mus_ycoeff, S_set S_mus_ycoeff, g_mus_set_ycoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_mus_offset, g_mus_offset_w, H_mus_offset, S_set S_mus_offset, g_mus_set_offset_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_mus_xcoeffs, g_mus_xcoeffs_w, 1, 0, 0, H_mus_xcoeffs, pl_fc);
- Xen_define_typed_procedure(S_mus_ycoeffs, g_mus_ycoeffs_w, 1, 0, 0, H_mus_ycoeffs, pl_fc);
- Xen_define_typed_procedure(S_is_oscil, g_is_oscil_w, 1, 0, 0, H_is_oscil, pl_bt);
- Xen_define_typed_procedure(S_oscil, g_oscil_w, 1, 2, 0, H_oscil, Q_oscil);
- Xen_define_typed_procedure(S_is_oscil_bank, g_is_oscil_bank_w, 1, 0, 0, H_is_oscil_bank, pl_bt);
- Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank, pl_dc);
-
- Xen_define_typed_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply, pl_dcr);
-
- Xen_define_typed_procedure(S_make_delay, g_make_delay_w, 0, 0, 1, H_make_delay,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_delay), t));
- Xen_define_typed_procedure(S_make_comb, g_make_comb_w, 0, 0, 1, H_make_comb,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_comb), t));
- Xen_define_typed_procedure(S_make_filtered_comb, g_make_filtered_comb_w, 0, 0, 1, H_make_filtered_comb,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filtered_comb), t));
- Xen_define_typed_procedure(S_make_notch, g_make_notch_w, 0, 0, 1, H_make_notch,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_notch), t));
- Xen_define_typed_procedure(S_make_all_pass, g_make_all_pass_w, 0, 0, 1, H_make_all_pass,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_all_pass), t));
- Xen_define_typed_procedure(S_make_moving_average, g_make_moving_average_w, 0, 0, 1, H_make_moving_average,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_average), t));
- Xen_define_typed_procedure(S_make_moving_max, g_make_moving_max_w, 0, 0, 1, H_make_moving_max,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_max), t));
- Xen_define_typed_procedure(S_make_moving_norm, g_make_moving_norm_w, 0, 0, 1, H_make_moving_norm,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_moving_norm), t));
- Xen_define_typed_procedure(S_delay, g_delay_w, 1, 2, 0, H_delay,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_delay_tick, g_delay_tick_w, 1, 1, 0, H_delay_tick,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_tap, g_tap_w, 1, 1, 0, H_tap,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
- Xen_define_typed_procedure(S_notch, g_notch_w, 1, 2, 0, H_notch,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_notch), r));
- Xen_define_typed_procedure(S_comb, g_comb_w, 1, 2, 0, H_comb,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_comb), r));
- Xen_define_typed_procedure(S_filtered_comb, g_filtered_comb_w, 1, 2, 0, H_filtered_comb,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filtered_comb), r));
- Xen_define_typed_procedure(S_all_pass, g_all_pass_w, 1, 2, 0, H_all_pass,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_all_pass), r));
- Xen_define_typed_procedure(S_moving_average, g_moving_average_w, 1, 1, 0, H_moving_average,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_average), r));
- Xen_define_typed_procedure(S_moving_max, g_moving_max_w, 1, 1, 0, H_moving_max,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_max), r));
- Xen_define_typed_procedure(S_moving_norm, g_moving_norm_w, 1, 1, 0, H_moving_norm,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_moving_norm), r));
- Xen_define_typed_procedure(S_is_tap, g_is_tap_w, 1, 0, 0, H_is_tap, pl_bt);
- Xen_define_typed_procedure(S_is_delay, g_is_delay_w, 1, 0, 0, H_is_delay, pl_bt);
- Xen_define_typed_procedure(S_is_notch, g_is_notch_w, 1, 0, 0, H_is_notch, pl_bt);
- Xen_define_typed_procedure(S_is_comb, g_is_comb_w, 1, 0, 0, H_is_comb, pl_bt);
- Xen_define_typed_procedure(S_is_filtered_comb, g_is_filtered_comb_w, 1, 0, 0, H_is_filtered_comb, pl_bt);
- Xen_define_typed_procedure(S_is_all_pass, g_is_all_pass_w, 1, 0, 0, H_is_all_pass, pl_bt);
- Xen_define_typed_procedure(S_is_moving_average, g_is_moving_average_w, 1, 0, 0, H_is_moving_average, pl_bt);
- Xen_define_typed_procedure(S_is_moving_max, g_is_moving_max_w, 1, 0, 0, H_is_moving_max, pl_bt);
- Xen_define_typed_procedure(S_is_moving_norm, g_is_moving_norm_w, 1, 0, 0, H_is_moving_norm, pl_bt);
-
- Xen_define_typed_procedure(S_comb_bank, g_comb_bank_w, 1, 1, 0, H_comb_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_comb_bank), r));
- Xen_define_typed_procedure(S_is_comb_bank, g_is_comb_bank_w, 1, 0, 0, H_is_comb_bank, pl_bt);
- Xen_define_typed_procedure(S_make_comb_bank, g_make_comb_bank_w, 1, 0, 0, H_make_comb_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_comb_bank), t));
-
- Xen_define_typed_procedure(S_filtered_comb_bank, g_filtered_comb_bank_w, 1, 1, 0, H_filtered_comb_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filtered_comb_bank), r));
- Xen_define_typed_procedure(S_is_filtered_comb_bank, g_is_filtered_comb_bank_w, 1, 0, 0, H_is_filtered_comb_bank, pl_bt);
- Xen_define_typed_procedure(S_make_filtered_comb_bank, g_make_filtered_comb_bank_w, 1, 0, 0, H_make_filtered_comb_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filtered_comb_bank), t));
-
- Xen_define_typed_procedure(S_all_pass_bank, g_all_pass_bank_w, 1, 1, 0, H_all_pass_bank,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_all_pass_bank), r));
- Xen_define_typed_procedure(S_is_all_pass_bank, g_is_all_pass_bank_w, 1, 0, 0, H_is_all_pass_bank, pl_bt);
- Xen_define_typed_procedure(S_make_all_pass_bank, g_make_all_pass_bank_w, 1, 0, 0, H_make_all_pass_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_all_pass_bank), t));
-
- Xen_define_typed_procedure(S_pink_noise, g_pink_noise_w, 1, 0, 0, H_pink_noise, pl_dv);
-
- Xen_define_typed_procedure(S_out_bank, g_out_bank_w, 3, 0, 0, H_out_bank, pl_dvir);
-
- Xen_define_typed_dilambda(S_mus_feedback, g_mus_feedback_w, H_mus_feedback,
- S_set S_mus_feedback, g_mus_set_feedback_w, 1, 0, 2, 0, pl_dc, pl_dcr);
- Xen_define_typed_dilambda(S_mus_feedforward, g_mus_feedforward_w, H_mus_feedforward,
- S_set S_mus_feedforward, g_mus_set_feedforward_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_make_rand, g_make_rand_w, 0, 0, 1, H_make_rand,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rand), t));
- Xen_define_typed_procedure(S_make_rand_interp, g_make_rand_interp_w, 0, 0, 1, H_make_rand_interp,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rand_interp), t));
- #if HAVE_RUBY
- rb_define_alias(rb_mKernel, "kernel_rand", "rand");
- #endif
- Xen_define_typed_procedure(S_rand, g_rand_w, 1, 1, 0, H_rand,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rand), r));
- Xen_define_typed_procedure(S_rand_interp, g_rand_interp_w, 1, 1, 0, H_rand_interp,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rand_interp), r));
- Xen_define_typed_procedure(S_is_rand, g_is_rand_w, 1, 0, 0, H_is_rand, pl_bt);
- Xen_define_typed_procedure(S_is_rand_interp, g_is_rand_interp_w, 1, 0, 0, H_is_rand_interp, pl_bt);
- Xen_define_typed_procedure(S_mus_random, g_mus_random_w, 1, 0, 0, H_mus_random, pl_dr);
-
- Xen_define_typed_dilambda(S_mus_rand_seed, g_mus_rand_seed_w, H_mus_rand_seed,
- S_set S_mus_rand_seed, g_mus_set_rand_seed_w, 0, 0, 1, 0, pl_i, pl_i);
-
- Xen_define_typed_procedure(S_ncos, g_ncos_w, 1, 1, 0, H_ncos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_ncos), r));
- Xen_define_typed_procedure(S_is_ncos, g_is_ncos_w, 1, 0, 0, H_is_ncos, pl_bt);
- Xen_define_typed_procedure(S_nsin, g_nsin_w, 1, 1, 0, H_nsin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nsin), r));
- Xen_define_typed_procedure(S_is_nsin, g_is_nsin_w, 1, 0, 0, H_is_nsin, pl_bt);
-
- Xen_define_typed_procedure(S_is_table_lookup, g_is_table_lookup_w, 1, 0, 0, H_is_table_lookup, pl_bt);
- Xen_define_typed_procedure(S_make_table_lookup, g_make_table_lookup_w, 0, 0, 1, H_make_table_lookup,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_table_lookup), t));
- Xen_define_typed_procedure(S_table_lookup, g_table_lookup_w, 1, 1, 0, H_table_lookup,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_table_lookup), r));
- Xen_define_typed_procedure(S_partials_to_wave, g_partials_to_wave_w, 1, 2, 0, H_partials_to_wave, pl_fttb);
- Xen_define_typed_procedure(S_phase_partials_to_wave, g_phase_partials_to_wave_w, 1, 2, 0, H_phase_partials_to_wave, pl_fttb);
-
-
- Xen_define_typed_procedure(S_make_sawtooth_wave, g_make_sawtooth_wave_w, 0, 6, 0, H_make_sawtooth_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_sawtooth_wave), t));
- Xen_define_typed_procedure(S_sawtooth_wave, g_sawtooth_wave_w, 1, 1, 0, H_sawtooth_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_sawtooth_wave), r));
- Xen_define_typed_procedure(S_is_sawtooth_wave, g_is_sawtooth_wave_w, 1, 0, 0, H_is_sawtooth_wave, pl_bt);
- Xen_define_typed_procedure(S_make_triangle_wave, g_make_triangle_wave_w, 0, 6, 0, H_make_triangle_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_triangle_wave), t));
- Xen_define_typed_procedure(S_triangle_wave, g_triangle_wave_w, 1, 1, 0, H_triangle_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_triangle_wave), r));
- Xen_define_typed_procedure(S_is_triangle_wave, g_is_triangle_wave_w, 1, 0, 0, H_is_triangle_wave, pl_bt);
- Xen_define_typed_procedure(S_make_square_wave, g_make_square_wave_w, 0, 6, 0, H_make_square_wave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_square_wave), t));
- Xen_define_typed_procedure(S_square_wave, g_square_wave_w, 1, 1, 0, H_square_wave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_square_wave), r));
- Xen_define_typed_procedure(S_is_square_wave, g_is_square_wave_w, 1, 0, 0, H_is_square_wave, pl_bt);
- Xen_define_typed_procedure(S_make_pulse_train, g_make_pulse_train_w, 0, 6, 0, H_make_pulse_train,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_pulse_train), t));
- Xen_define_typed_procedure(S_pulse_train, g_pulse_train_w, 1, 1, 0, H_pulse_train,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_pulse_train), r));
- Xen_define_typed_procedure(S_is_pulse_train, g_is_pulse_train_w, 1, 0, 0, H_is_pulse_train, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_pulsed_env, g_make_pulsed_env_w, 3, 0, 0, H_make_pulsed_env,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_pulsed_env), t));
- Xen_define_typed_procedure(S_pulsed_env, g_pulsed_env_w, 1, 1, 0, H_pulsed_env,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_pulsed_env), r));
- Xen_define_typed_procedure(S_is_pulsed_env, g_is_pulsed_env_w, 1, 0, 0, H_is_pulsed_env, pl_bt);
-
-
- Xen_define_typed_procedure(S_asymmetric_fm, g_asymmetric_fm_w, 1, 2, 0, H_asymmetric_fm,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_asymmetric_fm), r));
- Xen_define_typed_procedure(S_is_asymmetric_fm, g_is_asymmetric_fm_w, 1, 0, 0, H_is_asymmetric_fm, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_one_zero, g_make_one_zero_w, 0, 4, 0, H_make_one_zero,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_zero), t));
- Xen_define_typed_procedure(S_one_zero, g_one_zero_w, 1, 1, 0, H_one_zero,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_zero), r));
- Xen_define_typed_procedure(S_is_one_zero, g_is_one_zero_w, 1, 0, 0, H_is_one_zero, pl_bt);
- Xen_define_typed_procedure(S_make_one_pole, g_make_one_pole_w, 0, 4, 0, H_make_one_pole,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_pole), t));
- Xen_define_typed_procedure(S_one_pole, g_one_pole_w, 1, 1, 0, H_one_pole,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_pole), r));
- Xen_define_typed_procedure(S_is_one_pole, g_is_one_pole_w, 1, 0, 0, H_is_one_pole, pl_bt);
- Xen_define_typed_procedure(S_make_two_zero, g_make_two_zero_w, 0, 6, 0, H_make_two_zero,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_two_zero), t));
- Xen_define_typed_procedure(S_two_zero, g_two_zero_w, 1, 1, 0, H_two_zero,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_two_zero), r));
- Xen_define_typed_procedure(S_is_two_zero, g_is_two_zero_w, 1, 0, 0, H_is_two_zero, pl_bt);
- Xen_define_typed_procedure(S_make_two_pole, g_make_two_pole_w, 0, 6, 0, H_make_two_pole,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_two_pole), t));
- Xen_define_typed_procedure(S_two_pole, g_two_pole_w, 1, 1, 0, H_two_pole,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_two_pole), r));
- Xen_define_typed_procedure(S_is_two_pole, g_is_two_pole_w, 1, 0, 0, H_is_two_pole, pl_bt);
-
- Xen_define_typed_procedure(S_make_wave_train, g_make_wave_train_w, 0, 0, 1, H_make_wave_train,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_wave_train), t));
- Xen_define_typed_procedure(S_wave_train, g_wave_train_w, 1, 1, 0, H_wave_train,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_wave_train), r));
- Xen_define_typed_procedure(S_is_wave_train, g_is_wave_train_w, 1, 0, 0, H_is_wave_train, pl_bt);
-
- Xen_define_typed_procedure(S_is_formant, g_is_formant_w, 1, 0, 0, H_is_formant, pl_bt);
- Xen_define_typed_procedure(S_make_formant, g_make_formant_w, 0, 4, 0, H_make_formant,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_formant), t));
- Xen_define_typed_procedure(S_formant, g_formant_w, 1, 2, 0, H_formant,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_formant), r));
-
- Xen_define_typed_procedure(S_formant_bank, g_formant_bank_w, 1, 1, 0, H_formant_bank,
- s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_formant_bank), s7_make_signature(s7, 2, r, f)));
- Xen_define_typed_procedure(S_is_formant_bank, g_is_formant_bank_w, 1, 0, 0, H_is_formant_bank, pl_bt);
- Xen_define_typed_procedure(S_make_formant_bank, g_make_formant_bank_w, 1, 1, 0, H_make_formant_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_formant_bank), t));
-
- Xen_define_typed_procedure(S_is_firmant, g_is_firmant_w, 1, 0, 0, H_is_firmant, pl_bt);
- Xen_define_typed_procedure(S_make_firmant, g_make_firmant_w, 0, 4, 0, H_make_firmant,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_firmant), t));
- Xen_define_typed_procedure(S_firmant, g_firmant_w, 1, 2, 0, H_firmant,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_firmant), r));
-
- Xen_define_typed_procedure(S_is_one_pole_all_pass, g_is_one_pole_all_pass_w, 1, 0, 0, H_is_one_pole_all_pass, pl_bt);
- Xen_define_typed_procedure(S_make_one_pole_all_pass, g_make_one_pole_all_pass_w, 2, 0, 0, H_make_one_pole_all_pass,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_one_pole_all_pass), t));
- Xen_define_typed_procedure(S_one_pole_all_pass, g_one_pole_all_pass_w, 1, 1, 0, H_one_pole_all_pass,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_pole_all_pass), r));
-
- Xen_define_typed_procedure(S_mus_set_formant_frequency, g_set_formant_frequency_w, 2, 0, 0, H_mus_set_formant_frequency, pl_rcr);
- Xen_define_typed_procedure(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency, pl_rcrr);
-
-
- Xen_define_typed_procedure(S_make_polyshape, g_make_polyshape_w, 0, 0, 1, H_make_polyshape,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_polyshape), t));
- Xen_define_typed_procedure(S_polyshape, g_polyshape_w, 1, 2, 0, H_polyshape,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_polyshape), r));
- Xen_define_typed_procedure(S_is_polyshape, g_is_polyshape_w, 1, 0, 0, H_is_polyshape, pl_bt);
- Xen_define_typed_procedure(S_partials_to_polynomial, g_partials_to_polynomial_w, 1, 1, 0, H_partials_to_polynomial, pl_fti);
- Xen_define_typed_procedure(S_normalize_partials, g_normalize_partials_w, 1, 0, 0, H_normalize_partials, pl_tt);
- Xen_define_typed_procedure(S_mus_chebyshev_t_sum, g_chebyshev_t_sum_w, 2, 0, 0, H_chebyshev_t_sum, pl_drf);
- Xen_define_typed_procedure(S_mus_chebyshev_u_sum, g_chebyshev_u_sum_w, 2, 0, 0, H_chebyshev_u_sum, pl_drf);
- Xen_define_typed_procedure(S_mus_chebyshev_tu_sum, g_chebyshev_tu_sum_w, 3, 0, 0, H_chebyshev_tu_sum, pl_drf);
- Xen_define_typed_procedure(S_make_polywave, g_make_polywave_w, 0, 0, 1, H_make_polywave,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_polywave), t));
- Xen_define_typed_procedure(S_polywave, g_polywave_w, 1, 1, 0, H_polywave,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_polywave), r));
- Xen_define_typed_procedure(S_is_polywave, g_is_polywave_w, 1, 0, 0, H_is_polywave, pl_bt);
-
- Xen_define_typed_procedure(S_make_nrxysin, g_make_nrxysin_w, 0, 0, 1, H_make_nrxysin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nrxysin), t));
- Xen_define_typed_procedure(S_nrxysin, g_nrxysin_w, 1, 1, 0, H_nrxysin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nrxysin), r));
- Xen_define_typed_procedure(S_is_nrxysin, g_is_nrxysin_w, 1, 0, 0, H_is_nrxysin, pl_bt);
- Xen_define_typed_procedure(S_make_nrxycos, g_make_nrxycos_w, 0, 0, 1, H_make_nrxycos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nrxycos), t));
- Xen_define_typed_procedure(S_nrxycos, g_nrxycos_w, 1, 1, 0, H_nrxycos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_nrxycos), r));
- Xen_define_typed_procedure(S_is_nrxycos, g_is_nrxycos_w, 1, 0, 0, H_is_nrxycos, pl_bt);
-
- Xen_define_typed_procedure(S_make_rxyksin, g_make_rxyksin_w, 0, 0, 1, H_make_rxyksin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rxyksin), t));
- Xen_define_typed_procedure(S_rxyksin, g_rxyksin_w, 1, 1, 0, H_rxyksin,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rxyksin), r));
- Xen_define_typed_procedure(S_is_rxyksin, g_is_rxyksin_w, 1, 0, 0, H_is_rxyksin, pl_bt);
- Xen_define_typed_procedure(S_make_rxykcos, g_make_rxykcos_w, 0, 0, 1, H_make_rxykcos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_rxykcos), t));
- Xen_define_typed_procedure(S_rxykcos, g_rxykcos_w, 1, 1, 0, H_rxykcos,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_rxykcos), r));
- Xen_define_typed_procedure(S_is_rxykcos, g_is_rxykcos_w, 1, 0, 0, H_is_rxykcos, pl_bt);
-
-
- Xen_define_typed_procedure(S_make_filter, g_make_filter_w, 0, 6, 0, H_make_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_filter), t));
- Xen_define_typed_procedure(S_filter, g_filter_w, 1, 1, 0, H_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_filter), r));
- Xen_define_typed_procedure(S_is_filter, g_is_filter_w, 1, 0, 0, H_is_filter, pl_bt);
- Xen_define_typed_procedure(S_make_fir_coeffs, g_make_fir_coeffs_w, 2, 0, 0, H_make_fir_coeffs, pl_fif);
- Xen_define_typed_procedure(S_make_fir_filter, g_make_fir_filter_w, 0, 4, 0, H_make_fir_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_fir_filter), t));
- Xen_define_typed_procedure(S_fir_filter, g_fir_filter_w, 1, 1, 0, H_fir_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_fir_filter), r));
- Xen_define_typed_procedure(S_is_fir_filter, g_is_fir_filter_w, 1, 0, 0, H_is_fir_filter, pl_bt);
- Xen_define_typed_procedure(S_make_iir_filter, g_make_iir_filter_w, 0, 4, 0, H_make_iir_filter,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_iir_filter), t));
- Xen_define_typed_procedure(S_iir_filter, g_iir_filter_w, 1, 1, 0, H_iir_filter,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_iir_filter), r));
- Xen_define_typed_procedure(S_is_iir_filter, g_is_iir_filter_w, 1, 0, 0, H_is_iir_filter, pl_bt);
- Xen_define_typed_procedure(S_mus_order, g_mus_order_w, 1, 0, 0, H_mus_order, pl_ic);
- Xen_define_typed_procedure(S_mus_type, g_mus_type_w, 1, 0, 0, H_mus_type, pl_ic);
-
-
- Xen_define_typed_procedure(S_is_env, g_is_env_w, 1, 0, 0, H_is_env, pl_bt);
- Xen_define_typed_procedure(S_env, g_env_w, 1, 0, 0, H_env,
- s7_make_signature(s7, 2, d, s7_make_symbol(s7, S_is_env)));
- Xen_define_typed_procedure(S_make_env, g_make_env_w, 0, 0, 1, H_make_env,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_env), t));
- Xen_define_typed_procedure(S_env_interp, g_env_interp_w, 2, 0, 0, H_env_interp, pl_drc);
- Xen_define_typed_procedure(S_envelope_interp, g_envelope_interp_w, 2, 1, 0, H_envelope_interp, pl_rrpr);
- Xen_define_typed_procedure(S_env_any, g_env_any_w, 2, 0, 0, H_env_any, pl_dct);
-
- Xen_define_typed_procedure(S_is_locsig, g_is_locsig_w, 1, 0, 0, H_is_locsig, pl_bt);
- Xen_define_typed_procedure(S_locsig, g_locsig_w, 3, 0, 0, H_locsig,
- s7_make_circular_signature(s7, 2, 3, r, s7_make_symbol(s7, S_is_locsig), r));
- Xen_define_typed_procedure(S_make_locsig, g_make_locsig_w, 0, 0, 1, H_make_locsig,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_locsig), t));
- Xen_define_typed_procedure(S_move_locsig, g_move_locsig_w, 3, 0, 0, H_move_locsig, pl_ccrr);
- Xen_define_typed_procedure(S_mus_channels, g_mus_channels_w, 1, 0, 0, H_mus_channels, pl_it);
-
- #if HAVE_RUBY
- Xen_define_procedure(S_locsig_ref, g_locsig_ref_w, 2, 0, 0, H_locsig_ref);
- Xen_define_procedure(S_locsig_reverb_ref, g_locsig_reverb_ref_w, 2, 0, 0, H_locsig_reverb_ref);
- #endif
-
- Xen_define_typed_procedure(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set, pl_rcir);
-
- #if HAVE_SCHEME || HAVE_FORTH
- Xen_define_typed_dilambda(S_locsig_ref, g_locsig_ref_w, H_locsig_ref,
- S_set S_locsig_ref, g_locsig_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- Xen_define_typed_dilambda(S_locsig_reverb_ref, g_locsig_reverb_ref_w, H_locsig_reverb_ref,
- S_locsig_reverb_set, g_locsig_reverb_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
- #endif
-
- Xen_define_typed_procedure(S_locsig_reverb_set, g_locsig_reverb_set_w, 3, 0, 0, H_locsig_reverb_set, pl_rcir);
- Xen_define_typed_dilambda(S_locsig_type, g_locsig_type_w, H_locsig_type,
- S_set S_locsig_type, g_set_locsig_type_w, 0, 0, 1, 0, pl_i, pl_i);
-
- Xen_define_typed_procedure(S_is_move_sound, g_is_move_sound_w, 1, 0, 0, H_is_move_sound, pl_bt);
- Xen_define_typed_procedure(S_move_sound, g_move_sound_w, 3, 0, 0, H_move_sound,
- s7_make_circular_signature(s7, 2, 3, r, s7_make_symbol(s7, S_is_move_sound), r));
- Xen_define_typed_procedure(S_make_move_sound, g_make_move_sound_w, 1, 2, 0, H_make_move_sound,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_move_sound), t));
-
- Xen_define_typed_procedure(S_is_file_to_sample, g_is_file_to_sample_w, 1, 0, 0, H_is_file_to_sample, pl_bt);
- Xen_define_typed_procedure(S_make_file_to_sample, g_make_file_to_sample_w, 1, 1, 0, H_make_file_to_sample,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_file_to_sample), t));
- Xen_define_typed_procedure(S_file_to_sample, g_file_to_sample_w, 2, 1, 0, H_file_to_sample,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_file_to_sample), i));
- Xen_define_typed_procedure(S_is_sample_to_file, g_is_sample_to_file_w, 1, 0, 0, H_is_sample_to_file, pl_bt);
- Xen_define_typed_procedure(S_make_sample_to_file, g_make_sample_to_file_w, 1, 4, 0, H_make_sample_to_file,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_sample_to_file), t));
- Xen_define_typed_procedure(S_continue_sample_to_file, g_continue_sample_to_file_w, 1, 0, 0, H_continue_sample_to_file, pl_cs);
- Xen_define_typed_procedure(S_sample_to_file, g_sample_to_file_w, 4, 0, 0, H_sample_to_file, pl_rciir);
- Xen_define_typed_procedure(S_sample_to_file_add, g_sample_to_file_add_w, 2, 0, 0, H_sample_to_file_add, pl_cc);
-
- Xen_define_typed_procedure(S_is_file_to_frample, g_is_file_to_frample_w, 1, 0, 0, H_is_file_to_frample, pl_bt);
- Xen_define_typed_procedure(S_make_file_to_frample, g_make_file_to_frample_w, 1, 1, 0, H_make_file_to_frample,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_file_to_frample), t));
- Xen_define_typed_procedure(S_file_to_frample, g_file_to_frample_w, 2, 1, 0, H_file_to_frample, pl_ccic);
- Xen_define_typed_procedure(S_continue_frample_to_file, g_continue_frample_to_file_w, 1, 0, 0, H_continue_frample_to_file, pl_cs);
- Xen_define_typed_procedure(S_is_frample_to_file, g_is_frample_to_file_w, 1, 0, 0, H_is_frample_to_file, pl_bt);
- Xen_define_typed_procedure(S_frample_to_file, g_frample_to_file_w, 3, 0, 0, H_frample_to_file, pl_fcif);
- Xen_define_typed_procedure(S_make_frample_to_file, g_make_frample_to_file_w, 1, 4, 0, H_make_frample_to_file,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_frample_to_file), t));
-
- Xen_define_typed_procedure(S_is_mus_input, g_is_mus_input_w, 1, 0, 0, H_is_mus_input, pl_bt);
- Xen_define_typed_procedure(S_is_mus_output, g_is_mus_output_w, 1, 0, 0, H_is_mus_output, pl_bt);
- Xen_define_typed_procedure(S_in_any, g_in_any_w, 3, 0, 0, H_in_any, pl_diit);
- Xen_define_typed_procedure(S_ina, g_ina_w, 2, 0, 0, H_ina, pl_dit);
- Xen_define_typed_procedure(S_inb, g_inb_w, 2, 0, 0, H_inb, pl_dit);
- Xen_define_typed_procedure(S_out_any, g_out_any_w, 3, 1, 0, H_out_any, pl_ririt);
- Xen_define_typed_procedure(S_outa, g_outa_w, 2, 1, 0, H_outa, pl_rirt);
- Xen_define_typed_procedure(S_outb, g_outb_w, 2, 1, 0, H_outb, pl_rirt);
- Xen_define_typed_procedure(S_outc, g_outc_w, 2, 1, 0, H_outc, pl_rirt);
- Xen_define_typed_procedure(S_outd, g_outd_w, 2, 1, 0, H_outd, pl_rirt);
- Xen_define_typed_procedure(S_mus_close, g_mus_close_w, 1, 0, 0, H_mus_close, pl_tc);
-
- Xen_define_typed_dilambda(S_mus_file_buffer_size, g_mus_file_buffer_size_w, H_mus_file_buffer_size,
- S_set S_mus_file_buffer_size, g_mus_set_file_buffer_size_w, 0, 0, 1, 0, pl_i, pl_i);
-
-
- Xen_define_typed_procedure(S_is_readin, g_is_readin_w, 1, 0, 0, H_is_readin, pl_bt);
- Xen_define_typed_procedure(S_readin, g_readin_w, 1, 0, 0, H_readin,
- s7_make_signature(s7, 2, d, s7_make_symbol(s7, S_is_readin)));
- Xen_define_typed_procedure(S_make_readin, g_make_readin_w, 0, 0, 1, H_make_readin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_readin), t));
- Xen_define_typed_procedure(S_mus_channel, g_mus_channel_w, 1, 0, 0, H_mus_channel, pl_ic);
- Xen_define_typed_procedure(S_mus_interp_type, g_mus_interp_type_w, 1, 0, 0, H_mus_interp_type, pl_ic);
-
- Xen_define_typed_dilambda(S_mus_location, g_mus_location_w, H_mus_location,
- S_set S_mus_location, g_mus_set_location_w, 1, 0, 2, 0, pl_ic, pl_ici);
- Xen_define_typed_dilambda(S_mus_increment, g_mus_increment_w, H_mus_increment,
- S_set S_mus_increment, g_mus_set_increment_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_is_granulate, g_is_granulate_w, 1, 0, 0, H_is_granulate, pl_bt);
- Xen_define_typed_procedure(S_granulate, g_granulate_w, 1, 2, 0, H_granulate,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_granulate), t));
- Xen_define_typed_procedure(S_make_granulate, g_make_granulate_w, 0, 0, 1, H_make_granulate,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_granulate), t));
-
- Xen_define_typed_dilambda(S_mus_ramp, g_mus_ramp_w, H_mus_ramp,
- S_set S_mus_ramp, g_mus_set_ramp_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
-
- Xen_define_typed_procedure(S_clear_sincs, g_mus_clear_sincs_w, 0, 0, 0, "clears out any sinc tables", NULL);
- Xen_define_typed_procedure(S_is_src, g_is_src_w, 1, 0, 0, H_is_src, pl_bt);
- Xen_define_typed_procedure(S_src, g_src_w, 1, 2, 0, H_src,
- s7_make_signature(s7, 4, d, s7_make_symbol(s7, S_is_src), r, t));
- Xen_define_typed_procedure(S_make_src, g_make_src_w, 0, 6, 0, H_make_src,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_src), t));
-
-
- Xen_define_typed_procedure(S_is_convolve, g_is_convolve_w, 1, 0, 0, H_is_convolve, pl_bt);
- Xen_define_typed_procedure(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen,
- s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_convolve), t));
- Xen_define_typed_procedure(S_make_convolve, g_make_convolve_w, 0, 0, 1, H_make_convolve,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_convolve), t));
- Xen_define_typed_procedure(S_convolve_files, g_convolve_files_w, 2, 2, 0, H_convolve_files, pl_sssrs);
-
- Xen_define_typed_procedure(S_is_phase_vocoder, g_is_phase_vocoder_w, 1, 0, 0, H_is_phase_vocoder, pl_bt);
- Xen_define_typed_procedure(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_phase_vocoder), t));
- Xen_define_typed_procedure(S_make_phase_vocoder, g_make_phase_vocoder_w, 0, 0, 1, H_make_phase_vocoder,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_phase_vocoder), t));
- Xen_define_typed_procedure(S_phase_vocoder_amp_increments, g_phase_vocoder_amp_increments_w, 1, 0, 0, H_phase_vocoder_amp_increments, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_amps, g_phase_vocoder_amps_w, 1, 0, 0, H_phase_vocoder_amps, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_freqs, g_phase_vocoder_freqs_w, 1, 0, 0, H_phase_vocoder_freqs, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_phases, g_phase_vocoder_phases_w, 1, 0, 0, H_phase_vocoder_phases, pl_fc);
- Xen_define_typed_procedure(S_phase_vocoder_phase_increments, g_phase_vocoder_phase_increments_w, 1, 0, 0, H_phase_vocoder_phase_increments, pl_fc);
-
- Xen_define_typed_dilambda(S_mus_hop, g_mus_hop_w, H_mus_hop,
- S_set S_mus_hop, g_mus_set_hop_w, 1, 0, 2, 0, pl_dc, pl_dcr);
-
- Xen_define_typed_procedure(S_make_ssb_am, g_make_ssb_am_w, 0, 4, 0, H_make_ssb_am,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_ssb_am), t));
- Xen_define_typed_procedure(S_ssb_am, g_ssb_am_w, 1, 2, 0, H_ssb_am,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_ssb_am), r));
- Xen_define_typed_procedure(S_is_ssb_am, g_is_ssb_am_w, 1, 0, 0, H_is_ssb_am, pl_bt);
-
- Xen_define_typed_procedure(S_is_mus_generator, g_is_mus_generator_w, 1, 0, 0, H_is_mus_generator, pl_bt);
-
- Xen_define_variable(S_output, clm_output, Xen_false);
- Xen_define_variable(S_reverb, clm_reverb, Xen_false);
-
- #if HAVE_SCHEME
- {
- s7_pointer clm_output_accessor, clm_reverb_accessor;
- /* these are globals in s7, so they aren't going to move */
- clm_output_slot = s7_slot(s7, clm_output);
- clm_reverb_slot = s7_slot(s7, clm_reverb);
- out_any_2 = out_any_2_to_mus_xen;
- /* these can't be safe functions */
- clm_output_accessor = s7_make_function(s7, "(set " S_output ")", g_clm_output_set, 2, 0, false, "called if " S_output " is set");
- s7_symbol_set_access(s7, s7_make_symbol(s7, S_output), clm_output_accessor);
-
- clm_reverb_accessor = s7_make_function(s7, "(set " S_reverb ")", g_clm_reverb_set, 2, 0, false, "called if " S_reverb " is set");
- s7_symbol_set_access(s7, s7_make_symbol(s7, S_reverb), clm_reverb_accessor);
- }
- #endif
-
- #if HAVE_SCHEME && (!_MSC_VER)
- Xen_define_typed_procedure(S_get_internal_real_time, g_get_internal_real_time_w, 0, 0, 0, H_get_internal_real_time, NULL);
- Xen_define_constant(S_internal_time_units_per_second, 1, "units used by " S_get_internal_real_time);
- #endif
-
- #if HAVE_SCHEME
- Xen_define_typed_procedure(S_piano_noise, g_piano_noise_w, 2, 0, 0, H_piano_noise, pl_djr);
- Xen_define_typed_procedure(S_singer_filter, g_singer_filter_w, 6, 0, 0, H_singer_filter, pl_riirfff);
- Xen_define_typed_procedure(S_singer_nose_filter, g_singer_nose_filter_w, 5, 0, 0, H_singer_nose_filter, pl_rirfff);
- #endif
-
- Xen_define_typed_procedure(S_make_oscil, g_make_oscil_w, 0, 4, 0, H_make_oscil,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_oscil), t));
- Xen_define_typed_procedure(S_make_ncos, g_make_ncos_w, 0, 4, 0, H_make_ncos,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_ncos), t));
- Xen_define_typed_procedure(S_make_oscil_bank, g_make_oscil_bank_w, 2, 2, 0, H_make_oscil_bank,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_oscil_bank), t));
- Xen_define_typed_procedure(S_make_nsin, g_make_nsin_w, 0, 4, 0, H_make_nsin,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_nsin), t));
- Xen_define_typed_procedure(S_make_asymmetric_fm, g_make_asymmetric_fm_w, 0, 8, 0, H_make_asymmetric_fm,
- s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_asymmetric_fm), t));
-
- Xen_define_typed_procedure(S_mus_file_mix, g_mus_file_mix_w, 0, 0, 1, H_mus_file_mix, NULL);
- Xen_define_typed_procedure(S_mus_file_mix_with_envs, g_mus_file_mix_with_envs_w, 0, 0, 1, H_mus_file_mix_with_envs, NULL); /* actually 8 2 0 I think */
- Xen_define_typed_procedure(S_frample_to_frample, g_frample_to_frample_w, 5, 0, 0, H_frample_to_frample, pl_fffifi);
-
- #if HAVE_SCHEME
- init_choosers(s7);
- #endif
-
-
- /* -------- clm-print (see also snd-xen.c) -------- */
- #if (!USE_SND)
-
- #if HAVE_FORTH
- Xen_eval_C_string("<'> fth-print alias clm-print ( fmt args -- )");
- #endif
-
- #if HAVE_RUBY
- Xen_eval_C_string("def clm_print(str, *args)\n\
- $stdout.print format(str, *args)\n\
- end");
- #endif
- #endif
-
- Xen_provide_feature("clm");
- {
- char *clm_version;
- clm_version = mus_format("clm%d", MUS_VERSION);
- Xen_provide_feature(clm_version);
- free(clm_version);
- }
-
- #if HAVE_SCHEME && (!_MSC_VER)
- {
- struct timezone z0;
- gettimeofday(&overall_start_time, &z0);
- }
- #endif
- }
-
-
- void Init_sndlib(void)
- {
- mus_sndlib_xen_initialize();
- mus_vct_init();
- mus_xen_init();
-
- #if HAVE_SCHEME
- if (sizeof(mus_float_t) != sizeof(s7_double))
- fprintf(stderr, "in s7-clm, s7_double must match mus_float_t. Currently s7_double has %d bytes, but mus_float_t has %d\n",
- (int)sizeof(s7_double),
- (int)sizeof(mus_float_t));
- #endif
- }
-
- #if HAVE_SCHEME
- void s7_init_sndlib(s7_scheme *sc)
- {
- s7_xen_initialize(sc);
- Init_sndlib();
- }
- #endif
|