/* ntk.c */

#include <assert.h>
#include <math.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>

/* TODO:
 * - Slave interpreter for expression evaluation?
 * - Mixer. */

typedef signed short sample_t;      /* Sample type.          */
#define SAMPRATE 22050              /* Samples per second.   */
#define CHANNELS 1                  /* Simultaneous samples. */
#define SAMPBYTE sizeof(sample_t)   /* Bytes per sample.     */
#define SAMPBITS (SAMPBYTE * 8)     /* Bits per sample.      */
#define SAMPAMPL ((1LL << (SAMPBITS - 1)) - 1) /* Amplitude. */

typedef struct ntk_client_data {
    Tcl_Obj* context_dict ;

    Tcl_Obj* start_key    ; Tcl_Obj* phase_key    ; Tcl_Obj* duration_key ;
    Tcl_Obj* position_key ; Tcl_Obj* waveform_key ; Tcl_Obj* amplitude_key;
    Tcl_Obj* ampl_envl_key; Tcl_Obj* frequency_key; Tcl_Obj* freq_envl_key;
} ntk_client_data_t;

static int ntk_func(ClientData, Tcl_Interp*, Tcl_Value*, Tcl_Value*);
static int ntk_gen_cmd(ClientData, Tcl_Interp*, int, Tcl_Obj* const[]);
static int ntk_ctx_cmd(ClientData, Tcl_Interp*, int, Tcl_Obj* const[]);
static int ntk_mix_cmd(ClientData, Tcl_Interp*, int, Tcl_Obj* const[]);
static void ntk_gen_cleanup(ClientData);

static int ntk_func(ClientData value, Tcl_Interp* interp, Tcl_Value* args,
        Tcl_Value* result)
{
    if (value != NULL) {
        result->type = TCL_DOUBLE;
        result->doubleValue = *(double*)value;
        return TCL_OK;
    } else {
        Tcl_SetResult(interp, "functino must be used inside an expression "
                "evaluated by ::ntk::gen", TCL_STATIC);
        return TCL_ERROR;
    }
}

/* Usage:
 *
 * gen num_samps dict_var
 *
 * This command generates and returns $num_samps samples.  $dict_var is the
 * name of a dict variable in the caller's stack frame containing the following
 * keys:
 *
 * - start       - phase       - duration   - generator   - position
 * - waveform    - amplitude   - ampl_envl  - frequency   - freq_envl
 *
 * Each sample is ($waveform * $amplitude * $ampl_envl).  The instantaneous
 * frequency is ($frequency * $freq_envl).  $position counts from 0 to
 * $duration. */
static int ntk_gen_cmd(ClientData client_data, Tcl_Interp* interp,
        int objc, Tcl_Obj* const objv[])
{
    ntk_client_data_t* data = client_data;   

    int       code    ; /* Return code.                     */
    Tcl_Obj * result  ; /* Return value, as a Tcl object.   */
    char    * bytes   ; /* Return value, as a byte array.   */
    sample_t* samples ; /* Return value, as a sample array. */
    int sample_count  ; /* Number of samples to generate.   */
    int sample_index  ; /* Index of current sample.         */

    char   * dict_name; /* Name of the dict variable.       */
    Tcl_Obj* dict     ; /* The dict itself.                 */
    Tcl_Obj* dict_val ; /* Temp. object read from the dict. */

    Tcl_Obj* wave_expr; double            wave_inst;    /* Waveform.  */
    Tcl_Obj* ampl_expr; double ampl_base, ampl_inst;    /* Amplitude. */
    Tcl_Obj* freq_expr; double freq_base, freq_inst;    /* Frequency. */

    double dur        ; /* Duration in seconds.             */
    double pos        ; /* Current position (0 through 1).  */
    double time       ; /* Current time in seconds.         */
    double phase      ; /* Phase (0 through 2*pi).          */
    double dpos       ; /* Per-sample adjustment to pos.    */
    int    ipos       ; /* Current position in samples.     */

    int i;              /* Everpresent iterator variable.   */

    /* Mapping from dict keys to local variables. */
    struct {
        Tcl_Obj* key;   /* String object used as the key.   */
        void   * val;   /* Local variable to store value.   */
        enum {
            NTK_TCL_OBJ,/* Tcl_Obj*                         */
            NTK_DOUBLE ,/* double                           */
            NTK_INT     /* int                              */
        } type;         /* Variable type indicated by val.  */
    } dict_map[] = {
        {data->start_key    , &time     , NTK_DOUBLE },
        {data->phase_key    , &phase    , NTK_DOUBLE },
        {data->duration_key , &dur      , NTK_DOUBLE },
        {data->position_key , &ipos     , NTK_INT    },
        {data->waveform_key , &wave_expr, NTK_TCL_OBJ},
        {data->amplitude_key, &ampl_base, NTK_DOUBLE },
        {data->ampl_envl_key, &ampl_expr, NTK_TCL_OBJ},
        {data->frequency_key, &freq_base, NTK_DOUBLE },
        {data->freq_envl_key, &freq_expr, NTK_TCL_OBJ}
    };

    /* Ensure the proper number of arguments. */
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "num_samps dict_var");
        return TCL_ERROR;
    }

    /* Get the number of samples to be generated. */
    if (Tcl_GetIntFromObj(interp, objv[1], &sample_count) == TCL_ERROR) {
        return TCL_ERROR;
    }

    /* Get the dictionary. */
    dict_name = Tcl_GetString(objv[2]);
    dict = Tcl_GetVar2Ex(interp, dict_name, NULL, TCL_LEAVE_ERR_MSG);
    if (dict == NULL) {
        return TCL_ERROR;
    }

    /* Load the contents of the dictionary into local variables. */
    for (i = 0; i < sizeof(dict_map) / sizeof(*dict_map); ++i) {
        /* Get the value from the dictionary. */
        if (Tcl_DictObjGet(interp, dict, dict_map[i].key, &dict_val) ==
                TCL_ERROR) {
            return TCL_ERROR;
        } else if (dict_val == NULL) {
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "key \"", Tcl_GetString(dict_map[i].key),
                    "\" not known in dictionary", (char*)NULL);
            return TCL_ERROR;
        }

        /* Convert to the proper type and store in a local variable. */
        switch (dict_map[i].type) {
        case NTK_TCL_OBJ:
            *(Tcl_Obj**)dict_map[i].val = dict_val;
            break;
        case NTK_DOUBLE:
            if (Tcl_GetDoubleFromObj(interp, dict_val, dict_map[i].val) ==
                    TCL_ERROR) {
                return TCL_ERROR;
            }
            break;
        case NTK_INT:
            if (Tcl_GetIntFromObj(interp, dict_val, dict_map[i].val) ==
                    TCL_ERROR) {
                return TCL_ERROR;
            }
        }
    }

    /* Silently trim sample_count to range.  (Is this a good idea?) */
    if (sample_count < 0) {
        sample_count = 0;
    } else if (sample_count + ipos > dur * SAMPRATE) {
        sample_count = dur * SAMPRATE - ipos;
    }

    /* Adjust for already-produced samples. */
    time += ipos / SAMPRATE;
    dpos  = 1.0 / (dur * SAMPRATE);
    pos   = ipos * dpos;

    /* Get the output buffer. */
    result  = Tcl_NewObj();
    Tcl_IncrRefCount(result);
    bytes   = Tcl_SetByteArrayLength(result, sample_count * SAMPBYTE);
    samples = (sample_t*)bytes;
    
    /* Link the extra math functions to local variables. */
    Tcl_CreateMathFunc(interp, "dur"  , 0, NULL, ntk_func, &dur  );
    Tcl_CreateMathFunc(interp, "pos"  , 0, NULL, ntk_func, &pos  );
    Tcl_CreateMathFunc(interp, "time" , 0, NULL, ntk_func, &time );
    Tcl_CreateMathFunc(interp, "phase", 0, NULL, ntk_func, &phase);
    data->context_dict = dict; 

    /* Calculate each sample.  This is where the actual work happens. */
    for (sample_index = 0; sample_index < sample_count; ++sample_index) {
        /* Calculate instantaneous values. */
        if (Tcl_ExprDoubleObj(interp, wave_expr, &wave_inst) == TCL_ERROR ||
            Tcl_ExprDoubleObj(interp, ampl_expr, &ampl_inst) == TCL_ERROR ||
            Tcl_ExprDoubleObj(interp, freq_expr, &freq_inst) == TCL_ERROR) {
            /* Error in expression. */
            code = TCL_ERROR;
            goto done;
        }

        /* Calculate this sample. */
        samples[sample_index] = wave_inst * ampl_inst * ampl_base * SAMPAMPL;

        /* Calculate and apply this frequency. */
        phase += freq_inst * freq_base * 2 * M_PI / SAMPRATE;
        while (phase > 2 * M_PI) {
            phase -= 2 * M_PI;
        }

        /* Next! */
        pos  += dpos;
        time += 1.0 / SAMPRATE;
    }

    /* Store some stuff back to the dict. */
    if (Tcl_DictObjPut(interp, dict, data->phase_key,
                Tcl_NewDoubleObj(phase)) == TCL_ERROR ||
            Tcl_DictObjPut(interp, dict, data->position_key,
                Tcl_NewIntObj(ipos + sample_count)) == TCL_ERROR ||
            Tcl_SetVar2Ex(interp, dict_name, NULL, dict,
                TCL_LEAVE_ERR_MSG) == NULL) {
        code = TCL_ERROR;
        goto done;
    }

    /* Yahoo. */
    code = TCL_OK;
    Tcl_SetObjResult(interp, result);
    Tcl_DecrRefCount(result);
    goto done;

done:
    /* Link the extra math functions to zero. */
    Tcl_CreateMathFunc(interp, "dur"  , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "pos"  , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "time" , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "phase", 0, NULL, ntk_func, NULL);
    data->context_dict = NULL; 
    return code;
}

/* Usage:
 *
 * ctx variable ?value?
 *
 * Gets or sets a variable in the note context dict. */
static int ntk_ctx_cmd(ClientData client_data, Tcl_Interp* interp,
        int objc, Tcl_Obj* const objv[])
{
    ntk_client_data_t* data = client_data;
    Tcl_Obj* dict = data->context_dict;
    Tcl_Obj* result;

    if (dict == NULL) {
        Tcl_SetResult(interp, "::ntk::ctx must be called from inside a"
                " expression evaluated by ::ntk::gen", TCL_STATIC);
        return TCL_ERROR;
    }

    switch (objc) {
    case 2:
        if (Tcl_DictObjGet(interp, dict, objv[1], &result) == TCL_ERROR) {
            return TCL_ERROR;
        }
        if (result == NULL) {
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "key \"", Tcl_GetString(objv[1]),
                    "\" not known in dictionary", (char*)NULL);
            return TCL_ERROR;
        }
        break;
    case 3:
        result = objv[2];
        if (Tcl_DictObjPut(interp, dict, objv[1], result) == TCL_ERROR) {
            return TCL_ERROR;
        }
        break;
    default:
        Tcl_WrongNumArgs(interp, 1, objv, "variable ?value?");
        return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/* Usage:
 *
 * mix offset sample_data ?offset sample_data ...?
 *
 * Return an unweighted mix of one or more audio buffers. */
static int ntk_mix_cmd(ClientData dummy, Tcl_Interp* interp,
        int objc, Tcl_Obj* const objv[])
{
    int i;

    int length;
    int offset;
    int sample_count;
    int sample_index;

    Tcl_Obj * result  ; /* Return value, as a Tcl object.   */
    sample_t* dest    ; /* Return value, as a sample array. */
    sample_t* source  ;

    /* We need an even, nonzero number of arguments. */
    if (objc == 1 || objc % 2 != 1) {
        Tcl_WrongNumArgs(interp, 1, objv,
                "offset1 samples1 ?offset2 samples2 ...?");
        return TCL_ERROR;
    }

    /* Determine the length of the output buffer. */
    sample_count = 0;
    for (i = 1; i < objc; i += 2) {
        if (Tcl_GetIntFromObj(interp, objv[i], &offset) == TCL_ERROR) {
            return TCL_ERROR;
        }

        if (offset < 0) {
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "expected nonnegative integer but got \"",
                    Tcl_GetString(objv[i]), "\"", (char*)NULL);
            return TCL_ERROR;
        }

        Tcl_GetByteArrayFromObj(objv[i + 1], &length);
        length /= SAMPBYTE;
        if (offset + length > sample_count) {
            sample_count = offset + length;
        }
    }

    /* Get the output buffer. */
    result = Tcl_GetObjResult(interp);
    dest   = (sample_t*)Tcl_SetByteArrayLength(result, sample_count * SAMPBYTE);
    memset(dest, 0, sample_count * SAMPBYTE);

    /* Mix it up. */
    for (i = 1; i < objc; i += 2) {
        source = (sample_t*)Tcl_GetByteArrayFromObj(objv[i + 1], &length);
        length /= SAMPBYTE;
        Tcl_GetIntFromObj(interp, objv[i], &offset);

        for (sample_index = 0; sample_index < length; ++sample_index) {
            dest[sample_index + offset] += source[sample_index];
        }
    }

    return TCL_OK;
}

/* Handler for deletion of the gen command. */
static void ntk_gen_cleanup(ClientData client_data)
{
    ntk_client_data_t* data = client_data;
    Tcl_DecrRefCount(data->start_key    );
    Tcl_DecrRefCount(data->phase_key    );
    Tcl_DecrRefCount(data->duration_key );
    Tcl_DecrRefCount(data->position_key );
    Tcl_DecrRefCount(data->waveform_key );
    Tcl_DecrRefCount(data->amplitude_key);
    Tcl_DecrRefCount(data->ampl_envl_key);
    Tcl_DecrRefCount(data->frequency_key);
    Tcl_DecrRefCount(data->freq_envl_key);
    Tcl_Free(client_data);
}

/* This function is called upon loading the ntk module. */
int Ntk_Init(Tcl_Interp* interp)
{
    ntk_client_data_t data, *data_p;

    /* Disable ntk::ctx for the time being. */
    data.context_dict = NULL;

    /* Pregenerate some Tcl_Obj's to be used as dict keys. */
#define MAKE_KEY_OBJ(str)                           \
do {                                                \
    data.str##_key = Tcl_NewStringObj(#str, -1);    \
    Tcl_IncrRefCount(data.str##_key);               \
} while (0)
    MAKE_KEY_OBJ(start    ); MAKE_KEY_OBJ(phase    ); MAKE_KEY_OBJ(duration );
    MAKE_KEY_OBJ(position ); MAKE_KEY_OBJ(waveform ); MAKE_KEY_OBJ(amplitude);
    MAKE_KEY_OBJ(ampl_envl); MAKE_KEY_OBJ(frequency); MAKE_KEY_OBJ(freq_envl);
#undef MAKE_KEY_OBJ

    /* Create additional math functions.  Make them return zero since they only
     * make sense when called within gen. */
    Tcl_CreateMathFunc(interp, "dur"  , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "pos"  , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "time" , 0, NULL, ntk_func, NULL);
    Tcl_CreateMathFunc(interp, "phase", 0, NULL, ntk_func, NULL);

    /* Make a copy of the client data on the heap. */
    data_p = (ntk_client_data_t*)Tcl_Alloc(sizeof(data));
    memcpy(data_p, &data, sizeof(data));

    /* Now make the actual command.
     * XXX: What happens if you delete ntk::gen but not ntk::ctx? */
    Tcl_CreateObjCommand(interp, "::ntk::gen", ntk_gen_cmd, data_p,
            ntk_gen_cleanup);
    Tcl_CreateObjCommand(interp, "::ntk::ctx", ntk_ctx_cmd, data_p, NULL);
    Tcl_CreateObjCommand(interp, "::ntk::mix", ntk_mix_cmd, NULL, NULL);

    /* Done. */
    return TCL_OK;
}

/* vim: set ts=4 sts=4 sw=4 tw=80 et: */