view release on metacpan or  search on metacpan

XS/XS.xs  view on Meta::CPAN

/*
 * Audio::LADSPA perl modules for interfacing with LADSPA plugins
 * Copyright (C) 2003  Joost Diepenmaat.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 * See the COPYING file for more information.
 */

/*
    This module contains a lot of references to functions
    and structures in ladspa.h - if you're interested in
    the ladspa C api, take a look in there. It will
    probably help in understanding parts of the code here.
*/


#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "../ladspa.h"
#include "../ppport.h"
#include "../Buffer/Buffer.h"
#include "Plugin.h"
#include <limits.h>

/*
    this is function is trying to get at the plugin descriptor
    regardless of whether the self SV is a package name or a
    blessed object, so that we can handle class method calls
    where appropriate

    TODO: fix it so this will also work when called from an
    inherited object or class.
    
    This needs to be done in quite a few places, because perl 
    doesn't have property inheritance, and the most obvious 
    place for storing class-wide properties (such as the plugin
    descriptor in this case) is as a package variable, which
    doesn't get inherited.

    This, by the way, is one of the reasons most of the
    public API for these extensions uses methods instead of
    documented ('public') properties; they get inherited just
    fine.
*/

LADSPA_Descriptor* my_descriptor(SV* self) {
    SV* descriptor_store = NULL;
    SV* package;
    if (sv_isobject(self) && sv_derived_from(self,"Audio::LADSPA::Plugin::XS")) {
	HV* stash = SvSTASH(SvRV(self));
	package = newSVpv(HvNAME(stash),0);
	sv_2mortal(package);
    }
    else if (SvPOK(self) && SvCUR(self) > 0) {
	package = self;
    }
    else {
	croak("not a valid Audio::LADSPA::Plugin::XS");
    }
    
    descriptor_store = get_sv(form("%_::_ladspa_descriptor",package),0);
    if (descriptor_store && SvIOK(descriptor_store) && SvREADONLY(descriptor_store)) {
	return INT2PTR(LADSPA_Descriptor* ,SvIVX(descriptor_store));
    }
    croak("No valid descriptor in %_",package);
}


/*
    Instantiate a plugin and return pointer to Audio_LADSPA_Plugin struct as a blessed
    scalar ref
*/

SV* new_with_uid(SV* package, unsigned long sample_rate, SV* uid) {
    Audio_LADSPA_Plugin plugin = NULL;
    SV* self;
    SV* ref;
    LADSPA_Descriptor* descriptor = my_descriptor(package);
    LADSPA_Handle* handle = descriptor->instantiate(descriptor,sample_rate);
    if (handle == NULL)