#include "PerlOISMouseListener.h"

// class implementing OIS::MouseListener interface,
// but using Perl callbacks

PerlOISMouseListener::PerlOISMouseListener() : mPerlObj((SV *)NULL)
{
}

PerlOISMouseListener::~PerlOISMouseListener()
{
    if (mPerlObj != (SV *)NULL && SvREFCNT(mPerlObj)) {
        SvREFCNT_dec(mPerlObj);
    }
    mCanMap.clear();
}

bool PerlOISMouseListener::mouseMoved(const OIS::MouseEvent &evt)
{
    // no "int" arg for mouseMoved, so passing 0
    return callPerlCallback("mouseMoved", evt, 0);
}

bool PerlOISMouseListener::mousePressed(const OIS::MouseEvent &evt, OIS::MouseButtonID id)
{
    return callPerlCallback("mousePressed", evt, id);
}

bool PerlOISMouseListener::mouseReleased(const OIS::MouseEvent &evt, OIS::MouseButtonID id)
{
    return callPerlCallback("mouseReleased", evt, id);
}

void PerlOISMouseListener::setPerlObject(SV *pobj)
{
    if (pobj != (SV *)NULL && sv_isobject(pobj)) {
        // copy the SV *
        if (mPerlObj == (SV *)NULL) {
            // first time, create new SV *
            mPerlObj = newSVsv(pobj);
        } else {
            // just overwrite existing SV *
            SvSetSV(mPerlObj, pobj);
        }
    } else {
        croak("Argument wasn't an object, so MouseListener wasn't set.\n");
    }

    setCans();
}

void PerlOISMouseListener::setCans()
{
    mCanMap["mouseMoved"] = perlCallbackCan("mouseMoved");
    mCanMap["mousePressed"] = perlCallbackCan("mousePressed");
    mCanMap["mouseReleased"] = perlCallbackCan("mouseReleased");
}

// check whether the Perl object has a callback method implemented
// (is there a perl API method or something easier than this?)
bool PerlOISMouseListener::perlCallbackCan(string const &cbmeth)
{
    int count;
    SV *methret;
    bool can;

    dSP;

    ENTER;
    SAVETMPS;

    // call `can' to see if they implemented the callback
    PUSHMARK(SP);
    XPUSHs(mPerlObj);
    XPUSHs(sv_2mortal(newSVpv(cbmeth.c_str(), 0)));
    PUTBACK;

    count = call_method("can", G_SCALAR);
    SPAGAIN;
    if (count != 1) {
        croak("can (%s) didn't return a single value?", cbmeth.c_str());
    }

    methret = POPs;
    PUTBACK;

    can = SvTRUE(methret);

    FREETMPS;
    LEAVE;

    return can;
}

bool PerlOISMouseListener::callPerlCallback(string const &cbmeth, const OIS::MouseEvent &evt, int buttonID)
{
    int count;
    SV *methret;
    bool retval = true;   // default to returning true

    if (! (mCanMap[cbmeth] == true)) {
        // method not implemented, just return true
        return retval;
    }

    if (mPerlObj != (SV *)NULL) {
        // see `perldoc perlcall`
        dSP;

        ENTER;
        SAVETMPS;

        SV *mouseevt = sv_newmortal();
        TMOIS_OUT(mouseevt, &evt, MouseEvent);  // put C++ object into Perl

        PUSHMARK(SP);
        XPUSHs(mPerlObj);
        XPUSHs(mouseevt);
        XPUSHs(sv_2mortal(newSViv(buttonID)));
        PUTBACK;

        count = call_method(cbmeth.c_str(), G_SCALAR);
        SPAGAIN;
        if (count != 1) {
            croak("Callbacks must return a single (boolean) value");
        }

        methret = POPs;
        PUTBACK;

        retval = SvTRUE(methret) ? true : false;

        FREETMPS;
        LEAVE;
    }

    return retval;
}